pyrites/haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# HLINT ignore "Use const" #-}
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
{-# HLINT ignore "Avoid lambda" #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ImportQualifiedPost #-}

module Test.Datalog.NaiveDatabaseSpec where

import Test.Hspec
import Datalog.NaiveDatabase
import qualified Datalog.NaiveDatabase as NaiveDatabase
import Data.Set qualified as Set
import Datalog.DatalogParser
import qualified Data.Map as Map

spec :: Spec
spec = do
  describe "NaiveDatabase operations" $ do
    it "..." $ do
      1 `shouldBe` (1 :: Int)
    it "can ingest facts into relations & a universe" $ do
      let db = NaiveDatabase.withFacts 
            [ "parent(\"alice\", \"bob\")."
            , "parent(\"bob\", \"carol\")." ]
      constants db `shouldBe` 
        (Set.fromList $ Sym <$> ["alice", "bob", "carol"])
      relations db `shouldBe`
        Map.fromList [
          ("parent",  
            Relation "parent" 2 (Set.fromList (map (Sym <$>) [["alice", "bob"], ["bob", "carol"]])) [] )
        ]
    it "can ingest facts and rules" $ do
      let db = NaiveDatabase.withFactsAndRules 
            [ "parent(\"alice\", \"bob\")."
            , "parent(\"bob\", \"carol\")." ]
            [ "ancestor(X,Y) :- parent(X,Y)."
            , "ancestor(X,Y) :- parent(X,Z), ancestor(Z,Y)." ]
      constants db `shouldBe` 
        (Set.fromList $ Sym <$> ["alice", "bob", "carol"])
      let parentRelation = Relation {
          _name = "parent",
          _arity = 2, 
          _tuples = Set.fromList $
            map (Sym <$>) [["alice", "bob"], ["bob", "carol"]], 
          _rules = []
        }
      let ancestorRule = RelationRule {
          headVariables = [ "X", "Y", "Z" ], 
          bodyElements = [
              RuleBodyElement {
                _subRelationName = "parent",
                _ruleElements = [
                  RuleElementVariable "X", RuleElementVariable "Z"
                ]
              },
              RuleBodyElement {
                _subRelationName = "ancestor",
                _ruleElements = [
                  RuleElementVariable "Z",RuleElementVariable "Y"
                ]
              }
            ]
          }
      let ancestorRelation = Relation {
          _arity = 2, 
          _name = "ancestor",
          _tuples = Set.empty,
          _rules = [ ancestorRule ]
        }
      relations db `shouldBe`
        Map.fromList [
          ("ancestor", ancestorRelation),
          ("parent", parentRelation )
        ]

    it "can do basic queries" $ do
      let db = NaiveDatabase.withFacts 
            [ "parent(\"alice\", \"bob\")."
            , "parent(\"bob\", \"carol\")." ]
      query db "?- parent(alice,X)." `shouldBe` "#NYI" -- ideally, 'bob'