59 lines
2.1 KiB
Haskell
59 lines
2.1 KiB
Haskell
module Datalog.DigestedQuery where
|
|
|
|
import Data.Text (Text)
|
|
import Datalog.DatalogDB (Constant, DatalogDBException (..))
|
|
import Datalog.DatalogParser
|
|
import Control.Exception (throw)
|
|
import Data.List (nub, elemIndex)
|
|
|
|
data DigestedQuery = DigestedQuery {
|
|
allBoundVariables :: [Text],
|
|
numSoughtVariables :: Int,
|
|
conditions :: [DigestedQueryCondition]
|
|
} deriving (Show, Eq, Ord)
|
|
|
|
data DigestedQueryCondition = DigestedQueryCondition {
|
|
__relation :: Text,
|
|
_entries :: [DigestedQueryEntry]
|
|
} deriving (Show, Eq, Ord)
|
|
|
|
data DigestedQueryEntry =
|
|
DigestedQueryEntryConstant Constant |
|
|
DigestedQueryEntryVariable Int
|
|
deriving (Show, Eq, Ord)
|
|
|
|
digestQuery :: Text -> DigestedQuery
|
|
digestQuery queryText =
|
|
case parseDatalog queryText of
|
|
Right (Query variables literals) -> digestQuerySub variables literals
|
|
Right statement0 -> throw $ NonQueryException "cannot digest non-query" statement0
|
|
Left ex -> throw ex
|
|
|
|
digestQuerySub :: [Text] -> [Literal] -> DigestedQuery
|
|
digestQuerySub variables literals =
|
|
DigestedQuery {
|
|
allBoundVariables = allBoundVariables,
|
|
numSoughtVariables =
|
|
length $ if null variables then allBoundVariables else variables,
|
|
conditions = extractCondition <$> literals
|
|
} where
|
|
allBoundVariables = nub $ variables ++ extractedVariables
|
|
extractedVariables :: [Text] =
|
|
nub $ concatMap extractVariablesSub literals
|
|
extractVariablesSub :: Literal -> [Text]
|
|
extractVariablesSub lit =
|
|
concatMap extractVariablesSubSub (arguments lit)
|
|
extractVariablesSubSub :: Term -> [Text]
|
|
extractVariablesSubSub (Var name) = [name]
|
|
extractVariablesSubSub _ = []
|
|
extractCondition :: Literal -> DigestedQueryCondition
|
|
extractCondition lit = DigestedQueryCondition {
|
|
__relation = predName lit,
|
|
_entries = extractEntry <$> arguments lit
|
|
}
|
|
extractEntry :: Term -> DigestedQueryEntry
|
|
extractEntry (Var varName) = case elemIndex varName allBoundVariables of
|
|
Just index -> DigestedQueryEntryVariable index
|
|
Nothing -> throw $ VariableLookupException varName allBoundVariables
|
|
extractEntry constant = DigestedQueryEntryConstant constant
|
|
|