From 73aec57151bdadb89db35f6cef71241c6fdec39a Mon Sep 17 00:00:00 2001
From: Felix Dilke <felix.dilke@obsidian.systems>
Date: Wed, 21 Jan 2026 17:11:13 +0000
Subject: [PATCH] initial 'naive DB' API implementation

---
 .../src/Datalog/NaiveDatabase.hs              | 48 ++++++++++++++++++-
 .../test/Test/Datalog/NaiveDatabaseSpec.hs    |  6 +++
 2 files changed, 52 insertions(+), 2 deletions(-)

diff --git a/haskell-experiments/src/Datalog/NaiveDatabase.hs b/haskell-experiments/src/Datalog/NaiveDatabase.hs
index 6b16444..cd6b7e5 100644
--- a/haskell-experiments/src/Datalog/NaiveDatabase.hs
+++ b/haskell-experiments/src/Datalog/NaiveDatabase.hs
@@ -3,16 +3,60 @@
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 {-# HLINT ignore "Redundant flip" #-}
+{-# LANGUAGE ImportQualifiedPost #-}
 module Datalog.NaiveDatabase where
 
 import Data.Map (Map)
 import Data.Set (Set)
+import Data.Set qualified as Set
+import Data.Text (Text)
+import qualified Data.Text as T
+import Datalog.DatalogParser
+import qualified Data.Map as Map
+import Text.Megaparsec (ParseErrorBundle)
+import Data.Void
+import Control.Exception (Exception)
+import Control.Exception.Base
 
 data Value =
   ValueInt Int |
   ValueSymbol String
 
 data NaiveDatabase = NaiveDatabase {
-  relations :: Map String Int,
+  relations :: Map Text Int,
   values :: Set Value 
-}
\ No newline at end of file
+}
+
+emptyDB :: NaiveDatabase
+emptyDB = NaiveDatabase {
+  relations = Map.empty,
+  values = Set.empty
+}
+
+withFacts :: [Text] -> NaiveDatabase
+withFacts facts =
+  foldl addFact emptyDB (extractFact <$> facts) where
+    extractFact:: Text -> Literal
+    extractFact factText =
+      case (parseDatalog factText) of
+        Right (Fact fact) -> fact
+        Right otherStatement -> throw $ NonFactException factText otherStatement
+        Left ex -> throw $ CannotParseStatementException factText ex
+    addFact :: NaiveDatabase -> Literal -> NaiveDatabase
+    addFact db lit =
+      db
+
+query :: NaiveDatabase -> Text -> Text
+query db qText =
+  case (parseDatalog qText) of
+    Right (Query texts literals) -> "#NYI"
+    Right otherStatement -> throw $ NonQueryException qText otherStatement
+    Left ex -> throw $ CannotParseStatementException qText ex
+
+data NaiveDatabaseException
+  = CannotParseStatementException Text (ParseErrorBundle Text Void) |
+    NonFactException Text Statement |
+    NonQueryException Text Statement
+  deriving (Show)
+
+instance Exception NaiveDatabaseException
\ No newline at end of file
diff --git a/haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs b/haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs
index 0d1279b..5155982 100644
--- a/haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs
+++ b/haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs
@@ -13,6 +13,7 @@ module Test.Datalog.NaiveDatabaseSpec where
 
 import Test.Hspec
 import Datalog.NaiveDatabase
+import qualified Datalog.NaiveDatabase as NaiveDatabase
 
 -- checkParse :: String -> Expr -> Expectation
 -- checkParse text expectedExpr = 
@@ -28,3 +29,8 @@ spec = do
   describe "dummy test" $ do
     it "..." $ do
       1 `shouldBe` (1 :: Int)
+    it "can accept facts and do basic queries" $ do
+      let twig = [ "xx", "yy "]
+      let pig = [ "parent(\"alice\", \"bob\").", "parent(\"bob\", \"carol\")." ]
+      let db = NaiveDatabase.withFacts [ "parent(\"alice\", \"bob\").", "parent(\"bob\", \"carol\")." ]
+      query  db"?- parent(alice,X)." `shouldBe` "#NYI" -- ideally, 'bob'