using typeclass APIs

haskell-experiments/src/Datalog/NaiveDatabase.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE BlockArguments #-}
 
 module Datalog.NaiveDatabase where
 
@@ -37,8 +38,33 @@ instance DatalogDB NaiveDatabase where
   lookupRelation db relationName =
     Map.lookup relationName $ relations db
 
-  -- insertRelation :: NaiveDatabase -> Text -> Relation -> NaiveDatabase
-  -- insertRelation = _
+  insertRelation :: NaiveDatabase -> Relation -> NaiveDatabase
+  insertRelation db relation =
+    db {
+      relations = Map.insert (_name relation) relation (relations db)
+    }
+
+lookupRelation00 :: DatalogDB db => 
+  Text -> db -> Int -> (Relation -> Relation) -> db
+lookupRelation00 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 
+    }
+    
 
 lookupRelation0 :: DatalogDB db => Text -> db -> Int -> Set [Constant] -> Relation
 lookupRelation0 relationName db newArity tuples =

haskell-experiments/src/Datalog/Rules.hs

@@ -50,4 +50,4 @@ type RelationId = Text
 class DatalogDB db where
   emptyDB :: db
   lookupRelation :: db -> Text -> Maybe Relation
-  -- insertRelation :: db -> Text -> Relation -> db
+  insertRelation :: db -> Relation -> db