Condition data type. (#13)

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

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