diff --git a/haskell-experiments/haskell-experiments.cabal b/haskell-experiments/haskell-experiments.cabal index 9d70208..854c070 100644 --- a/haskell-experiments/haskell-experiments.cabal +++ b/haskell-experiments/haskell-experiments.cabal @@ -55,34 +55,36 @@ common warnings ghc-options: -Wall test-suite haskell-exps-test - -- Import common warning flags. - import: warnings + -- Import common warning flags. + import: warnings - -- Base language which the package is written in. - default-language: Haskell2010 + -- Base language which the package is written in. + default-language: Haskell2010 - -- Modules included in this executable, other than Main. - -- other-modules: + -- Modules included in this executable, other than Main. + -- other-modules: - -- LANGUAGE extensions used by modules in this package. - -- other-extensions: + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: - -- The interface type and version of the test suite. - type: exitcode-stdio-1.0 + -- The interface type and version of the test suite. + type: exitcode-stdio-1.0 - -- Directories containing source files. - hs-source-dirs: test + -- Directories containing source files. + hs-source-dirs: test - -- The entrypoint to the test suite. - main-is: Main.hs + -- The entrypoint to the test suite. + main-is: Main.hs - -- Test dependencies. - build-depends: base, containers, megaparsec, hspec, langfeatures - other-modules: Test.OlogsSpec, - Test.SimpleParserSpec, - Test.ArithmeticParserSpec, - Test.Datalog.DatalogParserSpec, - Test.Datalog.InMemoryDBSpec + -- Test dependencies. + build-depends: base, containers, megaparsec, hspec, langfeatures, text + other-modules: Test.OlogsSpec, + Test.SimpleParserSpec, + Test.ArithmeticParserSpec, + Test.Datalog.DatalogParserSpec, + Test.Datalog.InMemoryDBSpec + default-extensions: + OverloadedStrings library langfeatures default-language: Haskell2010 @@ -104,4 +106,6 @@ executable haskell-experiments build-depends: base, containers main-is: Main.hs hs-source-dirs: src + default-extensions: + OverloadedStrings diff --git a/haskell-experiments/notes/InMemoryDB_classes.png b/haskell-experiments/notes/InMemoryDB_classes.png new file mode 100644 index 0000000..23582b0 Binary files /dev/null and b/haskell-experiments/notes/InMemoryDB_classes.png differ diff --git a/haskell-experiments/src/ArithmeticParser.hs b/haskell-experiments/src/ArithmeticParser.hs index 5f32bd5..65b1fb1 100644 --- a/haskell-experiments/src/ArithmeticParser.hs +++ b/haskell-experiments/src/ArithmeticParser.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module ArithmeticParser where import Text.Megaparsec diff --git a/haskell-experiments/src/Datalog/DatalogDB.hs b/haskell-experiments/src/Datalog/DatalogDB.hs index acadbac..ef10aea 100644 --- a/haskell-experiments/src/Datalog/DatalogDB.hs +++ b/haskell-experiments/src/Datalog/DatalogDB.hs @@ -1,6 +1,5 @@ {-# HLINT ignore "Redundant flip" #-} {-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} diff --git a/haskell-experiments/src/Datalog/DatalogParser.hs b/haskell-experiments/src/Datalog/DatalogParser.hs index cedcc05..25b0329 100644 --- a/haskell-experiments/src/Datalog/DatalogParser.hs +++ b/haskell-experiments/src/Datalog/DatalogParser.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Datalog.DatalogParser where import Data.Void diff --git a/haskell-experiments/src/Datalog/InMemoryDB.hs b/haskell-experiments/src/Datalog/InMemoryDB.hs index 0d85d89..9964e9b 100644 --- a/haskell-experiments/src/Datalog/InMemoryDB.hs +++ b/haskell-experiments/src/Datalog/InMemoryDB.hs @@ -1,6 +1,5 @@ {-# HLINT ignore "Redundant flip" #-} {-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# LANGUAGE InstanceSigs #-} @@ -23,7 +22,6 @@ data InMemoryDB = InMemoryDB , constants :: Set Constant } deriving (Show, Eq) - instance DatalogDB InMemoryDB where emptyDB :: InMemoryDB emptyDB = InMemoryDB diff --git a/haskell-experiments/src/Datalog/Rules.hs b/haskell-experiments/src/Datalog/Rules.hs index c8651bd..10ffff7 100644 --- a/haskell-experiments/src/Datalog/Rules.hs +++ b/haskell-experiments/src/Datalog/Rules.hs @@ -1,6 +1,5 @@ {-# HLINT ignore "Redundant flip" #-} {-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} diff --git a/haskell-experiments/test/Test/ArithmeticParserSpec.hs b/haskell-experiments/test/Test/ArithmeticParserSpec.hs index 7f92728..7be2df8 100644 --- a/haskell-experiments/test/Test/ArithmeticParserSpec.hs +++ b/haskell-experiments/test/Test/ArithmeticParserSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedRecordDot #-} {-# HLINT ignore "Use const" #-} diff --git a/haskell-experiments/test/Test/Datalog/DatalogParserSpec.hs b/haskell-experiments/test/Test/Datalog/DatalogParserSpec.hs index 25f9bc6..7d14ff0 100644 --- a/haskell-experiments/test/Test/Datalog/DatalogParserSpec.hs +++ b/haskell-experiments/test/Test/Datalog/DatalogParserSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedRecordDot #-} {-# HLINT ignore "Use const" #-} diff --git a/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs b/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs index c928b08..92e5f87 100644 --- a/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs +++ b/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} {-# HLINT ignore "Use const" #-} {-# HLINT ignore "Unused LANGUAGE pragma" #-} {-# HLINT ignore "Avoid lambda" #-} @@ -21,6 +20,7 @@ import Datalog.InMemoryDB import Datalog.InMemoryDB qualified as InMemoryDB import Test.Hspec import Datalog.DatalogDB +import Data.Text spec :: Spec spec = do @@ -55,36 +55,20 @@ spec = do , _arity = 2 , _tuples = Set.fromList $ - map (Sym <$>) [["alice", "bob"], ["bob", "carol"]] + Sym <<$>> [["alice", "bob"], ["bob", "carol"]] , _rules = [] } ancestorRule = RelationRule { headVariables = ["X", "Y", "Z"] , bodyElements = - [ RuleBodyElement - { _subRelationId = "parent" - , _ruleElements = - [ RuleElementVariable 0 - , RuleElementVariable 2 - ] - } - , RuleBodyElement - { _subRelationId = "ancestor" - , _ruleElements = - [ RuleElementVariable 2 - , RuleElementVariable 1 - ] - } + [ ruleBody "parent" [0, 2] + , ruleBody "ancestor" [2, 1] ] } ancestorRule2 = RelationRule { headVariables = ["X", "Y"] , bodyElements = - [ RuleBodyElement - { _subRelationId = "parent" - , _ruleElements = [RuleElementVariable 0, RuleElementVariable 1] - } - ] + [ ruleBody "parent" [0, 1] ] } ancestorRelation = Relation @@ -149,30 +133,6 @@ spec = do constants db `shouldBe` Set.empty - it "can ingest facts and rules with duplicate head entries" do - let db = - InMemoryDB.withFactsAndRules - [] - ["equivalent(Q,Q) :- ."] - rule1 = - RelationRule - { headVariables = ["Q"] - , bodyElements = [] - } - - equivalentRelation = - Relation - { _arity = 2 - , _name = "equivalent" - , _tuples = Set.empty - , _rules = [rule1] - } - relations db - `shouldBe` Map.singleton "equivalent" equivalentRelation - - constants db - `shouldBe` Set.empty - it "can ingest a theory of equivalence relations" do let db = InMemoryDB.withFactsAndRules @@ -190,33 +150,14 @@ spec = do RelationRule { headVariables = ["R", "Q"] , bodyElements = - [ RuleBodyElement - { _subRelationId = "equivalent" - , _ruleElements = - [ RuleElementVariable 1 - , RuleElementVariable 0 - ] - } - ] + [ ruleBody "equivalent" [1, 0] ] } rule3 = RelationRule { headVariables = ["Q", "S", "R"] , bodyElements = - [ RuleBodyElement - { _subRelationId = "equivalent" - , _ruleElements = - [ RuleElementVariable 0 - , RuleElementVariable 2 - ] - } - , RuleBodyElement - { _subRelationId = "equivalent" - , _ruleElements = - [ RuleElementVariable 2 - , RuleElementVariable 1 - ] - } + [ ruleBody "equivalent" [0, 2] + , ruleBody "equivalent" [2, 1] ] } equivalentRelation = @@ -249,3 +190,11 @@ spec = do -- (<<<$>>>) :: (Functor f1, Functor f2, Functor f3) => f1 (a -> b) -> f1 (f2 (f3 a) -> f2 (f3 b)) (<<<$>>>) :: (Functor f1, Functor f2, Functor f3) => (a -> b) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 b)) (<<<$>>>) = fmap fmap fmap fmap fmap fmap fmap fmap + +ruleBody :: Text -> [Int] -> RuleBodyElement +ruleBody subRelationId indices = + RuleBodyElement + { _subRelationId = subRelationId + , _ruleElements = + RuleElementVariable <$> indices + } \ No newline at end of file