Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
module Data.Valuation (
Valuation,
-- * Constructors
singleton,
fromMap,
fromPairs,
-- * Destructors
toMap,
toPairs,
-- * Access
setTruthValue,
truthValue,
condition,
-- * Helpers
viaMap,
viaMapF,
) where
import Data.Functor.Identity
import qualified Data.Map.Strict as Map
newtype Valuation l = Valuation {toMap :: Map.Map l Bool}
singleton :: (Ord l) => l -> Bool -> Valuation l
singleton l t = fromMap $ Map.singleton l t
viaMap :: (Map.Map l Bool -> Map.Map l Bool) -> Valuation l -> Valuation l
viaMap fn = runIdentity . viaMapF (Identity . fn)
viaMapF :: (Functor f) => (Map.Map l Bool -> f (Map.Map l Bool)) -> Valuation l -> f (Valuation l)
viaMapF fn = fmap fromMap . fn . toMap
fromMap :: Map.Map l Bool -> Valuation l
fromMap = Valuation
fromPairs :: (Ord l) => [(l, Bool)] -> Valuation l
fromPairs = Valuation . Map.fromList
toPairs :: Valuation l -> [(l, Bool)]
toPairs = Map.toList . toMap
truthValue :: (Ord l) => Valuation l -> l -> Maybe Bool
truthValue (Valuation m) = (`Map.lookup` m)
{- | Conditions a valuation with key value pair, if it conficts with the valuation,
it returns Nothing
-}
condition :: (Ord l) => Valuation l -> l -> Bool -> Maybe (Valuation l)
condition v l t =
viaMapF
( Map.alterF
\case
Just t' | t' /= t -> Nothing
_ -> Just (Just t)
l
)
v
setTruthValue :: (Ord l) => Valuation l -> l -> Bool -> Valuation l
setTruthValue v l t = viaMap (Map.insert l t) v