diff --git a/hasbolt-extras.cabal b/hasbolt-extras.cabal index 7989506..ac7f240 100644 --- a/hasbolt-extras.cabal +++ b/hasbolt-extras.cabal @@ -1,5 +1,5 @@ name: hasbolt-extras -version: 0.0.0.4 +version: 0.0.0.5 synopsis: Extras for hasbolt library description: Extras for hasbolt library homepage: https://github.com/biocad/hasbolt-extras#readme @@ -24,6 +24,7 @@ source-repository head library hs-source-dirs: src exposed-modules: Database.Bolt.Extras + , Database.Bolt.Extras.Condition , Database.Bolt.Extras.Graph , Database.Bolt.Extras.Persisted , Database.Bolt.Extras.Query diff --git a/src/Database/Bolt/Extras/Condition.hs b/src/Database/Bolt/Extras/Condition.hs new file mode 100644 index 0000000..5374fbe --- /dev/null +++ b/src/Database/Bolt/Extras/Condition.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE ExistentialQuantification #-} + +module Database.Bolt.Extras.Condition + ( + Condition (..) + , tautology + , matches + , itself + ) where + +-- | Conditional expressions over type 'a' and its mappings. +-- Supported operations: +-- * equality check :== +-- * disunction :&& +-- * conjunction :|| +-- +-- Typical usage: +-- Say we have variable 'var :: a', a function 'f :: a -> b' and a value 'val :: b'. +-- Expression 'f :== b' acts as 'f a == b' +-- Examples: +-- +-- > data D = D { fld1 :: Int +-- > , fld2 :: String +-- > , fld3 :: Double +-- > } +-- > +-- > d = D 42 "noononno" 1.618 +-- > d `matches` (fld1 :== 12 :&& fld2 :== "abc") +-- > False +-- > +-- > d `matches` (fld1 :== 42 :|| fld3 == 1.0) +-- > True +-- +infix 4 :== +infixr 3 :&& +infixr 2 :|| +data Condition a = forall b. Eq b => (a -> b) :== b + | Condition a :&& Condition a + | Condition a :|| Condition a + + +-- | Check whether data satisfies conditions on it. +-- +matches :: a -> Condition a -> Bool +matches obj (transform :== ref) = transform obj == ref +matches obj (u :&& v) = matches obj u && matches obj v +matches obj (u :|| v) = matches obj u || matches obj v + + +-- | Matching 'tautology' will always succeed. +-- > whatever `matches` tautology == True +-- > -- Match is lazy: +-- > undefined `matches` tautology == True +-- +tautology :: Condition a +tautology = const True :== True + + +-- | Object itself instead of its mappings is matched with help of this alias. +-- > 42 `matches` (itself :== 42) == True +-- > 42 `matches` (itself :== 41) == False +-- +itself :: a -> a +itself = id