fdilke/pyrites
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

simplified language features and tests

Browse Source
This commit is contained in:
Felix Dilke 2026-01-30 16:07:23 +00:00
parent 3003a92807
commit 05b6aefabe
10 changed files with 41 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
haskell-experiments/haskell-experiments.cabal
View File

@ -77,12 +77,14 @@ test-suite haskell-exps-test
main-is: Main.hs
-- Test dependencies.
build-depends: base, containers, megaparsec, hspec, langfeatures
build-depends: base, containers, megaparsec, hspec, langfeatures, text
other-modules: Test.OlogsSpec,
Test.SimpleParserSpec,
Test.ArithmeticParserSpec,
Test.Datalog.DatalogParserSpec,
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

BIN
haskell-experiments/notes/InMemoryDB_classes.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 101 KiB

2
haskell-experiments/src/ArithmeticParser.hs
View File

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

1
haskell-experiments/src/Datalog/DatalogDB.hs
View File

@ -1,6 +1,5 @@
{-# HLINT ignore "Redundant flip" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

2
haskell-experiments/src/Datalog/DatalogParser.hs
View File

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

2
haskell-experiments/src/Datalog/InMemoryDB.hs
View File

@ -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

1
haskell-experiments/src/Datalog/Rules.hs
View File

@ -1,6 +1,5 @@
{-# HLINT ignore "Redundant flip" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

1
haskell-experiments/test/Test/ArithmeticParserSpec.hs
View File

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

1
haskell-experiments/test/Test/Datalog/DatalogParserSpec.hs
View File

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

83
haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs
View File

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