commented out some experimental lookupdate methods that the world isn't quite ready for

haskell-experiments/src/Datalog/DatalogDB.hs

@@ -71,16 +71,6 @@ lookupRelationArity relationName db newArity tuples =
            in relation { _tuples = newTuples }
         else throw $ BadArityException relationName newArity
 
-lookupRelationArity0 :: DatalogDB db => Text -> db -> Int -> (Relation -> Relation) -> db
-lookupRelationArity0 relationName db newArity update =
-  insertRelation db (update newRelation) 
-    where
-    newRelation = case lookupRelation db relationName of
-      Nothing -> Relation relationName newArity Set.empty []
-      Just relation ->
-        if _arity relation == newArity then relation
-        else throw $ BadArityException relationName newArity
-
 addFact :: (DatalogDB db) => Literal -> db -> db
 addFact (Literal neg relationName terms) db =
   insertRelation (addConstants db extraConstants) newRelation
@@ -89,22 +79,34 @@ addFact (Literal neg relationName terms) db =
   newRelation = lookupRelationArity relationName db newArity (Set.singleton terms)
   extraConstants = Set.fromList terms
 
-lookupRelation00 :: DatalogDB db => 
+-- the world isn't quite ready for these, as the 'update relation' pattern doesn't fir - maybe use a lens?
-  Text -> db -> Int -> (Relation -> Relation) -> db
+-- lookupRelation00 :: DatalogDB db => 
-lookupRelation00 relationName db newArity update =
+--   Text -> db -> Int -> (Relation -> Relation) -> db
-  insertRelation db (update newRelation) 
+-- lookupRelation00 relationName db newArity update =
-    where
+--   insertRelation db (update newRelation) 
-    newRelation = case lookupRelation db relationName of
+--     where
-      Nothing -> Relation relationName newArity Set.empty []
+--     newRelation = case lookupRelation db relationName of
-      Just relation ->
+--       Nothing -> Relation relationName newArity Set.empty []
-        if _arity relation == newArity then
+--       Just relation ->
-            relation
+--         if _arity relation == newArity then
-          else throw $ BadArityException relationName newArity
+--             relation
+--           else throw $ BadArityException relationName newArity
+
+-- lookupRelation000 :: DatalogDB db => 
+--   Text -> db -> Int -> Set [Constant] -> (Relation -> Relation) -> db
+-- lookupRelation000 relationName db newArity tuples update =
+--   lookupRelation00 relationName db newArity \relation ->
+--     update relation { 
+--       _tuples = Set.union tuples $ _tuples relation 
+--     }
+
+-- lookupRelationArity0 :: DatalogDB db => Text -> db -> Int -> (Relation -> Relation) -> db
+-- lookupRelationArity0 relationName db newArity update =
+--   insertRelation db (update newRelation) 
+--     where
+--     newRelation = case lookupRelation db relationName of
+--       Nothing -> Relation relationName newArity Set.empty []
+--       Just relation ->
+--         if _arity relation == newArity then relation
+--         else throw $ BadArityException relationName newArity
 
-lookupRelation000 :: DatalogDB db => 
-  Text -> db -> Int -> Set [Constant] -> (Relation -> Relation) -> db
-lookupRelation000 relationName db newArity tuples update =
-  lookupRelation00 relationName db newArity \relation ->
-    update relation { 
-      _tuples = Set.union tuples $ _tuples relation 
-    }

haskell-experiments/src/Datalog/Rules.hs

@@ -89,7 +89,7 @@ digestBody (Literal neg subRelationName subTerms) context =
   context { 
     _variableNames = variableNames
     , _bodyConstraints = newConstraint : constraints
-    , _db = insertRelation (addConstants db constants') subRelation
+    , _db = insertRelation (addConstants db (Set.fromList extraConstants)) subRelation
     }
  where
   db = _db context
@@ -100,7 +100,6 @@ digestBody (Literal neg subRelationName subTerms) context =
     constantFromTerm :: Term -> Maybe Constant
     constantFromTerm (Var _) = Nothing
     constantFromTerm constant = Just constant
-  constants' = Set.fromList extraConstants
   constraints = _bodyConstraints context
   newConstraint = BodyConstraint subRelation subRuleElements where
     subRuleElements = toRuleElement <$> subTerms