added utility class and 'allMaps' function

This commit is contained in:
Felix Dilke 2026-02-10 13:18:59 +00:00
parent f4cd68a76e
commit 7c984dbb2a
4 changed files with 57 additions and 1 deletions

View File

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

View File

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

View File

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

View File

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