souffle-haskell-3.4.0: tests/Test/Language/Souffle/CompiledSpec.hs
{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, DeriveGeneric #-}
module Test.Language.Souffle.CompiledSpec
( module Test.Language.Souffle.CompiledSpec
) where
import Test.Hspec
import GHC.Generics
import Data.Maybe
import qualified Data.Array as A
import qualified Data.Vector as V
import qualified Language.Souffle.Compiled as Souffle
data Path = Path
data Edge = Edge String String
deriving stock (Eq, Show, Generic)
data Reachable = Reachable String String
deriving stock (Eq, Show, Generic)
instance Souffle.Program Path where
type ProgramFacts Path = '[Edge, Reachable]
programName = const "path"
instance Souffle.Fact Edge where
type FactDirection Edge = 'Souffle.InputOutput
factName = const "edge"
instance Souffle.Fact Reachable where
type FactDirection Reachable = 'Souffle.Output
factName = const "reachable"
instance Souffle.Marshal Edge
instance Souffle.Marshal Reachable
data BadPath = BadPath
instance Souffle.Program BadPath where
type ProgramFacts BadPath = [Edge, Reachable]
programName = const "bad_path"
spec :: Spec
spec = describe "Souffle API" $ parallel $ do
describe "init" $ parallel $ do
it "returns nothing in case it cannot load a souffle program" $ do
prog <- Souffle.runSouffle BadPath pure
isJust prog `shouldBe` False
it "returns just the program in case it can load a souffle program" $ do
prog <- Souffle.runSouffle Path pure
isJust prog `shouldBe` True
describe "getFacts" $ parallel $ do
it "doesn't crash if used as last action (lists)" $ do
edges <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
Souffle.getFacts prog
edges `shouldBe` [Edge "b" "c", Edge "a" "b"]
it "doesn't crash if used as last action (vectors)" $ do
edges <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
Souffle.getFacts prog
edges `shouldBe` V.fromList [Edge "a" "b", Edge "b" "c"]
it "doesn't crash if used as last action (arrays)" $ do
edges <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
Souffle.getFacts prog
edges `shouldBe` A.listArray (0 :: Int, 1) [Edge "a" "b", Edge "b" "c"]
it "can retrieve facts as a list" $ do
(edges, reachables) <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
es <- Souffle.getFacts prog
rs <- Souffle.getFacts prog
pure (es , rs)
edges `shouldBe` [Edge "b" "c", Edge "a" "b"]
reachables `shouldBe` [Reachable "b" "c", Reachable "a" "c", Reachable "a" "b"]
it "can retrieve facts as a vector" $ do
(edges, reachables) <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
es <- Souffle.getFacts prog
rs <- Souffle.getFacts prog
pure (es , rs)
edges `shouldBe` V.fromList [Edge "a" "b", Edge "b" "c"]
reachables `shouldBe` V.fromList [Reachable "a" "b", Reachable "a" "c", Reachable "b" "c"]
it "can retrieve facts as an array" $ do
(edges, reachables) <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
es <- Souffle.getFacts prog
rs <- Souffle.getFacts prog
pure (es , rs)
edges `shouldBe` A.listArray (0 :: Int, 1) [Edge "a" "b", Edge "b" "c"]
reachables `shouldBe` A.listArray (0 :: Int, 2) [Reachable "a" "b", Reachable "a" "c", Reachable "b" "c"]
it "returns no facts in case program hasn't run yet" $ do
edges <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.getFacts prog
edges `shouldBe` ([] :: [Edge])
describe "addFact" $ parallel $
it "adds a fact" $ do
(edgesBefore, edgesAfter) <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
es1 <- Souffle.getFacts prog
Souffle.addFact prog $ Edge "e" "f"
Souffle.run prog
es2 <- Souffle.getFacts prog
pure (es1, es2)
edgesBefore `shouldBe` [Edge "b" "c", Edge "a" "b"]
edgesAfter `shouldBe` [Edge "e" "f", Edge "b" "c", Edge "a" "b"]
describe "addFacts" $ parallel $
it "can add multiple facts at once" $ do
(edgesBefore, edgesAfter) <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
es1 <- Souffle.getFacts prog
Souffle.addFacts prog [Edge "e" "f", Edge "f" "g"]
Souffle.run prog
es2 <- Souffle.getFacts prog
pure (es1, es2)
edgesBefore `shouldBe` [Edge "b" "c", Edge "a" "b"]
edgesAfter `shouldBe` [Edge "f" "g", Edge "e" "f", Edge "b" "c", Edge "a" "b"]
describe "run" $ parallel $ do
it "is OK to run a program multiple times" $ do
edges <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
Souffle.run prog
Souffle.getFacts prog
edges `shouldBe` [Edge "b" "c", Edge "a" "b"]
it "discovers new facts after running with new facts" $ do
(reachablesBefore, reachablesAfter) <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
rs1 <- Souffle.getFacts prog
Souffle.addFacts prog [Edge "e" "f", Edge "f" "g"]
Souffle.run prog
rs2 <- Souffle.getFacts prog
pure (rs1, rs2)
reachablesBefore `shouldBe` [Reachable "b" "c", Reachable "a" "c", Reachable "a" "b"]
reachablesAfter `shouldBe` [ Reachable "f" "g", Reachable "e" "g", Reachable "e" "f"
, Reachable "b" "c",Reachable "a" "c", Reachable "a" "b" ]
describe "configuring number of cores" $ parallel $
it "is possible to configure number of cores" $ do
results <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
numCpus1 <- Souffle.getNumThreads prog
Souffle.setNumThreads prog 4
numCpus2 <- Souffle.getNumThreads prog
Souffle.setNumThreads prog 2
numCpus3 <- Souffle.getNumThreads prog
pure (numCpus1, numCpus2, numCpus3)
results `shouldBe` (1, 4, 2)
describe "findFact" $ parallel $ do
it "returns Nothing in case no matching fact was found" $ do
(edge, reachable) <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
e <- Souffle.findFact prog $ Edge "c" "d"
r <- Souffle.findFact prog $ Reachable "d" "e"
pure (e, r)
edge `shouldBe` Nothing
reachable `shouldBe` Nothing
it "returns Just the fact in case matching fact was found" $ do
(edge, reachable) <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.run prog
e <- Souffle.findFact prog $ Edge "a" "b"
r <- Souffle.findFact prog $ Reachable "a" "c"
pure (e, r)
edge `shouldBe` Just (Edge "a" "b")
reachable `shouldBe` Just (Reachable "a" "c")
it "can handle unicode characters" $ do
let fact = Edge "∀∀" "bla"
fact2 = Edge "∃∃" "bla"
fact3 = Edge "℀℀" "bla"
results <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
Souffle.addFact prog fact
Souffle.run prog
(,,) <$> Souffle.findFact prog fact
<*> Souffle.findFact prog fact2
<*> Souffle.findFact prog fact3
results `shouldBe` (Just fact, Nothing, Nothing)
-- TODO writeFiles / loadFiles
describe "Semigroup and Monoid instances" $ parallel $ do
it "combines Souffle actions into one using (<>)" $ do
edges <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
action1 = Souffle.addFact prog $ Edge "e" "f"
action2 = Souffle.addFact prog $ Edge "f" "g"
action = action1 <> action2
action
Souffle.run prog
Souffle.getFacts prog
edges `shouldBe` [ Edge "f" "g", Edge "e" "f"
, Edge "b" "c", Edge "a" "b"
]
it "supports mempty" $ do
edges <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
action = Souffle.addFact prog $ Edge "e" "f"
action' = action <> mempty
action'
Souffle.run prog
Souffle.getFacts prog
edges `shouldBe` [Edge "e" "f", Edge "b" "c", Edge "a" "b"]
it "supports foldMap" $ do
edges <- Souffle.runSouffle Path $ \handle -> do
let prog = fromJust handle
fact1 = Edge "e" "f"
fact2 = Edge "f" "g"
action = foldMap (Souffle.addFact prog) [fact1, fact2]
action
Souffle.run prog
Souffle.getFacts prog
edges `shouldBe` [ Edge "f" "g", Edge "e" "f"
, Edge "b" "c", Edge "a" "b"
]