fdilke/pyrites
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

further delinting

Browse Source
This commit is contained in:
Felix Dilke 2026-02-11 18:11:00 +00:00
parent d17b33567d
commit 7364f393bd
4 changed files with 10 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
haskell-experiments/src/Datalog/DigestedQuery.hs
View File

@ -1,17 +1,9 @@
module Datalog.DigestedQuery where module Datalog.DigestedQuery where
import Data.Void
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import Datalog.DatalogDB (Constant, DatalogDBException (..))
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import Control.Monad (void)
import Data.Functor (($>))
import Datalog.DatalogDB (Relation, Constant, DatalogDBException (..))
import Datalog.DatalogParser import Datalog.DatalogParser
import Control.Exception (throw) import Control.Exception (throw)
import GHC.TypeError (ErrorMessage(Text))
import Data.List (nub, elemIndex) import Data.List (nub, elemIndex)
data DigestedQuery = DigestedQuery { data DigestedQuery = DigestedQuery {
@ -42,22 +34,22 @@ digestQuerySub variables literals =
DigestedQuery { DigestedQuery {
allBoundVariables = allBoundVariables, allBoundVariables = allBoundVariables,
numSoughtVariables = numSoughtVariables =
if (null variables) then (length allBoundVariables) else (length variables), length $ if null variables then allBoundVariables else variables,
conditions = extractCondition <$> literals conditions = extractCondition <$> literals
} where } where
allBoundVariables = nub $ variables ++ extractedVariables allBoundVariables = nub $ variables ++ extractedVariables
extractedVariables :: [Text] = extractedVariables :: [Text] =
nub $ concatMap extractVariablesSub literals nub $ concatMap extractVariablesSub literals
extractVariablesSub :: Literal -> [Text] extractVariablesSub :: Literal -> [Text]
extractVariablesSub literal = extractVariablesSub lit =
concatMap extractVariablesSubSub (arguments literal) concatMap extractVariablesSubSub (arguments lit)
extractVariablesSubSub :: Term -> [Text] extractVariablesSubSub :: Term -> [Text]
extractVariablesSubSub (Var name) = [name] extractVariablesSubSub (Var name) = [name]
extractVariablesSubSub _ = [] extractVariablesSubSub _ = []
extractCondition :: Literal -> DigestedQueryCondition extractCondition :: Literal -> DigestedQueryCondition
extractCondition literal = DigestedQueryCondition { extractCondition lit = DigestedQueryCondition {
__relation = predName literal, __relation = predName lit,
_entries = extractEntry <$> (arguments literal) _entries = extractEntry <$> arguments lit
} }
extractEntry :: Term -> DigestedQueryEntry extractEntry :: Term -> DigestedQueryEntry
extractEntry (Var varName) = case elemIndex varName allBoundVariables of extractEntry (Var varName) = case elemIndex varName allBoundVariables of

7
haskell-experiments/src/Datalog/NaiveQE.hs
View File

@ -6,7 +6,6 @@
{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ImportQualifiedPost #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE DatatypeContexts #-}
module Datalog.NaiveQE where module Datalog.NaiveQE where
import Datalog.QueryEngine import Datalog.QueryEngine
@ -22,10 +21,8 @@ import Control.Monad(guard)
import Data.Set (Set) import Data.Set (Set)
import Data.Set qualified as Set import Data.Set qualified as Set
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import Data.List (nub)
import qualified Data.List.NonEmpty as List
data (DatalogDB db) => NaiveQE db = NaiveQE data NaiveQE db = NaiveQE
{ {
db :: db, db :: db,
herbrand :: Map Text Relation herbrand :: Map Text Relation
@ -76,7 +73,7 @@ computeHerbrand db =
else newFacts else newFacts
where where
(facts, wasChanged) = newFacts (facts, wasChanged) = newFacts
latestRelation = facts Map.! (_name relation) latestRelation = facts Map.! _name relation
knownTuples :: Set [Constant] = _tuples latestRelation knownTuples :: Set [Constant] = _tuples latestRelation
extraTuples = do extraTuples = do
varmap <- allMaps headVars (Set.toList $ allConstants db) varmap <- allMaps headVars (Set.toList $ allConstants db)

3
haskell-experiments/src/Datalog/Rules.hs
View File

@ -2,7 +2,6 @@
{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# LANGUAGE DatatypeContexts #-}
module Datalog.Rules where module Datalog.Rules where
@ -61,7 +60,7 @@ addRule (ruleHead, body) db =
, bodyElements = toRuleBodyElement <$> _bodyConstraints context' , bodyElements = toRuleBodyElement <$> _bodyConstraints context'
} }
data (DatalogDB db) => RuleContext db = RuleContext data RuleContext db = RuleContext
{ __relation :: Relation { __relation :: Relation
, _variableNames :: [Text] , _variableNames :: [Text]
, _headEntries :: [RuleElement] , _headEntries :: [RuleElement]

1
haskell-experiments/src/Utility/Utility.hs
View File

@ -2,7 +2,6 @@
{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# LANGUAGE DatatypeContexts #-}
module Utility.Utility where module Utility.Utility where