diff --git a/haskell-experiments/haskell-experiments.cabal b/haskell-experiments/haskell-experiments.cabal index 3e83a9e..999914f 100644 --- a/haskell-experiments/haskell-experiments.cabal +++ b/haskell-experiments/haskell-experiments.cabal @@ -81,6 +81,7 @@ test-suite haskell-exps-test Test.Datalog.DatalogParserSpec Test.Datalog.InMemoryDBSpec Test.Datalog.NaiveQESpec + Test.Utility.UtilitySpec library langfeatures import: warnings, commonSettings @@ -95,6 +96,7 @@ library langfeatures Datalog.DatalogDB Datalog.NaiveQE Datalog.QueryEngine + Utility.Utility executable haskell-experiments import: warnings, commonSettings diff --git a/haskell-experiments/src/Utility/Utility.hs b/haskell-experiments/src/Utility/Utility.hs new file mode 100644 index 0000000..c2f7f7c --- /dev/null +++ b/haskell-experiments/src/Utility/Utility.hs @@ -0,0 +1,22 @@ +{-# HLINT ignore "Redundant flip" #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# LANGUAGE DatatypeContexts #-} + +module Utility.Utility where + +import Control.Exception.Base +import Data.List +import Data.Maybe +import Data.Set qualified as Set +import Data.Text (Text) +import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog) +import Datalog.DatalogDB + +import qualified Data.Map as Map + +-- All functions from domain to codomain +allMaps :: Ord a => [a] -> [b] -> [Map.Map a b] +allMaps [] _ = [Map.empty] +allMaps (x:xs) cod = [ Map.insert x y m | y <- cod, m <- allMaps xs cod ] \ No newline at end of file diff --git a/haskell-experiments/test/Main.hs b/haskell-experiments/test/Main.hs index b810fdb..56ed89f 100644 --- a/haskell-experiments/test/Main.hs +++ b/haskell-experiments/test/Main.hs @@ -7,6 +7,7 @@ import qualified Test.ArithmeticParserSpec as ArithmeticParserSpec import qualified Test.Datalog.DatalogParserSpec as DatalogParserSpec import qualified Test.Datalog.InMemoryDBSpec as InMemoryDBSpec import qualified Test.Datalog.NaiveQESpec as NaiveQESpec +import qualified Test.Utility.UtilitySpec as UtilitySpec main :: IO () main = hspec $ do @@ -16,4 +17,4 @@ main = hspec $ do describe "DatalogParser" DatalogParserSpec.spec describe "InMemoryDB" InMemoryDBSpec.spec describe "NaiveQE" NaiveQESpec.spec - + describe "Utility" UtilitySpec.spec diff --git a/haskell-experiments/test/Test/Utility/UtilitySpec.hs b/haskell-experiments/test/Test/Utility/UtilitySpec.hs new file mode 100644 index 0000000..70de4e5 --- /dev/null +++ b/haskell-experiments/test/Test/Utility/UtilitySpec.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# HLINT ignore "Use const" #-} +{-# HLINT ignore "Unused LANGUAGE pragma" #-} +{-# HLINT ignore "Avoid lambda" #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +module Test.Utility.UtilitySpec where + +import Test.Hspec +import Utility.Utility +import qualified Data.Map as Map +import Data.Map + +spec :: Spec +spec = do + describe "UtilitySpec" do + it "..." $ do + uncharacteristic <$> (allMaps [1, 2, 3] [True, False]) `shouldMatchList` [ + [1,2,3], [1,2], [1,3], [1], [2, 3], [2], [3], [] + ] + +uncharacteristic :: forall a . Map a Bool -> [a] +uncharacteristic intmap = [ x | (x, v) <- toList intmap, v ] +