simplified language features and tests

haskell-experiments/haskell-experiments.cabal

@@ -55,34 +55,36 @@ common warnings
     ghc-options: -Wall
 
 test-suite haskell-exps-test
-    -- Import common warning flags.
+  -- Import common warning flags.
-    import:           warnings
+  import:           warnings
 
-    -- Base language which the package is written in.
+  -- Base language which the package is written in.
-    default-language: Haskell2010
+  default-language: Haskell2010
 
-    -- Modules included in this executable, other than Main.
+  -- Modules included in this executable, other than Main.
-    -- other-modules:
+  -- other-modules:
 
-    -- LANGUAGE extensions used by modules in this package.
+  -- LANGUAGE extensions used by modules in this package.
-    -- other-extensions:
+  -- other-extensions:
 
-    -- The interface type and version of the test suite.
+  -- The interface type and version of the test suite.
-    type:             exitcode-stdio-1.0
+  type:             exitcode-stdio-1.0
 
-    -- Directories containing source files.
+  -- Directories containing source files.
-    hs-source-dirs:   test
+  hs-source-dirs:   test
 
-    -- The entrypoint to the test suite.
+  -- The entrypoint to the test suite.
-    main-is:          Main.hs
+  main-is:          Main.hs
 
-    -- Test dependencies.
+  -- Test dependencies.
-    build-depends:    base, containers, megaparsec, hspec, langfeatures
+  build-depends:    base, containers, megaparsec, hspec, langfeatures, text
-    other-modules:    Test.OlogsSpec,
+  other-modules:    Test.OlogsSpec,
-      Test.SimpleParserSpec,
+    Test.SimpleParserSpec,
-      Test.ArithmeticParserSpec,
+    Test.ArithmeticParserSpec,
-      Test.Datalog.DatalogParserSpec,
+    Test.Datalog.DatalogParserSpec,
-      Test.Datalog.InMemoryDBSpec
+    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 
 

haskell-experiments/src/ArithmeticParser.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module ArithmeticParser where
 
 import Text.Megaparsec

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 #-}
 

haskell-experiments/src/Datalog/DatalogParser.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module Datalog.DatalogParser where
 
 import Data.Void

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

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 #-}
 

haskell-experiments/test/Test/ArithmeticParserSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# HLINT ignore "Use const" #-}

haskell-experiments/test/Test/Datalog/DatalogParserSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# HLINT ignore "Use const" #-}

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
+                  [ ruleBody "parent"   [0, 2]
-                      { _subRelationId = "parent"
+                  , ruleBody "ancestor" [2, 1]
-                      , _ruleElements =
-                          [ RuleElementVariable 0
-                          , RuleElementVariable 2
-                          ]
-                      }
-                  , RuleBodyElement
-                      { _subRelationId = "ancestor"
-                      , _ruleElements =
-                          [ RuleElementVariable 2
-                          , RuleElementVariable 1
-                          ]
-                      }
                   ]
               }
           ancestorRule2 = RelationRule
               { headVariables = ["X", "Y"]
               , bodyElements =
-                  [ RuleBodyElement
+                  [ ruleBody "parent" [0, 1] ]
-                      { _subRelationId = "parent"
-                      , _ruleElements = [RuleElementVariable 0, RuleElementVariable 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
+                  [ ruleBody "equivalent" [1, 0] ]
-                      { _subRelationId = "equivalent"
-                      , _ruleElements =
-                          [ RuleElementVariable 1
-                          , RuleElementVariable 0
-                          ]
-                      }
-                  ]
               }
           rule3 =
             RelationRule
               { headVariables = ["Q", "S", "R"]
               , bodyElements =
-                  [ RuleBodyElement
+                  [ ruleBody "equivalent" [0, 2]
-                      { _subRelationId = "equivalent"
+                  , ruleBody "equivalent" [2, 1]
-                      , _ruleElements =
-                          [ RuleElementVariable 0
-                          , RuleElementVariable 2
-                          ]
-                      }
-                  , RuleBodyElement
-                      { _subRelationId = "equivalent"
-                      , _ruleElements =
-                          [ RuleElementVariable 2
-                          , RuleElementVariable 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
+    }