hasbolt-extras 0.0.0.4 → 0.0.0.6

raw patch · 8 files changed

+168/−34 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• hasbolt-extras.cabal +3/−1
• src/Database/Bolt/Extras/Condition.hs +64/−0
• src/Database/Bolt/Extras/Query.hs +6/−1
• src/Database/Bolt/Extras/Query/Cypher.hs +6/−7
• src/Database/Bolt/Extras/Query/Get.hs +2/−1
• src/Database/Bolt/Extras/Query/Put.hs +35/−24
• src/Database/Bolt/Extras/Query/Set.hs +47/−0

@@ -6,6 +6,11 @@  ## [Unreleased] +## [0.0.0.6] - 2018-04-20+### Added+- Added ability to update properties of the existing node; added ability to choose+if you want to `CREATE` or `MERGE` the relationship.+ ## [0.0.0.4] - 2018-04-05 ### Changed - More accurate `toNode` on data fields with `Maybe a` type. If the corresponding field in the type is Nothing, this field won't be included to `Node`.

@@ -1,5 +1,5 @@ name:           hasbolt-extras-version:        0.0.0.4+version:        0.0.0.6 synopsis:       Extras for hasbolt library description:    Extras for hasbolt library homepage:       https://github.com/biocad/hasbolt-extras#readme@@ -24,6 +24,7 @@ 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@@ -31,6 +32,7 @@                      , Database.Bolt.Extras.Utils   other-modules:       Database.Bolt.Extras.Query.Get                      , Database.Bolt.Extras.Query.Put+                     , Database.Bolt.Extras.Query.Set                      , Database.Bolt.Extras.Query.Utils                        Database.Bolt.Extras.Query.Cypher                   

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

@@ -6,10 +6,12 @@   , NodeGetter (..)   , NodeName   , PutNode (..)+  , PutRelationship (..)   , RelGetter (..)   , ToCypher (..)   , getGraph   , putGraph+  , setNode   ) where  import           Database.Bolt.Extras.Query.Cypher (ToCypher (..))@@ -19,5 +21,8 @@                                                     RelGetter (..), getGraph) import           Database.Bolt.Extras.Query.Put    (GraphPutRequest,                                                     GraphPutResponse,-                                                    PutNode (..), putGraph)+                                                    PutNode (..),+                                                    PutRelationship (..),+                                                    putGraph)+import           Database.Bolt.Extras.Query.Set    (setNode) import           Database.Bolt.Extras.Query.Utils  (NodeName)

@@ -15,13 +15,12 @@ -- This file contains some converation rules from 'Database.Bolt' types to `Cypher`. ------------------------------------------------------------------------------------------------- -import           Data.Text                         as T (Text, concat, cons,-                                                         intercalate, pack,-                                                         toUpper)-import           Database.Bolt                     (Value (..))-import           Database.Bolt.Extras.Template     (Label, Property)-import           Database.Bolt.Extras.Utils        (currentLoc)-import           NeatInterpolation                 (text)+import           Data.Text                     as T (Text, concat, cons,+                                                     intercalate, pack, toUpper)+import           Database.Bolt                 (Value (..))+import           Database.Bolt.Extras.Template (Label, Property)+import           Database.Bolt.Extras.Utils    (currentLoc)+import           NeatInterpolation             (text)  -- | The class for convertation into Cypher. --

@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes       #-} {-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TemplateHaskell   #-}  module Database.Bolt.Extras.Query.Get     ( NodeGetter (..)@@ -9,6 +8,8 @@     , GraphGetResponse     , RelGetter (..)     , getGraph+    , nodeAsText+    , condIdAsText     ) where  import           Control.Monad.IO.Class              (MonadIO)

@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes       #-} {-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TemplateHaskell   #-}  module Database.Bolt.Extras.Query.Put     ( GraphPutRequest     , GraphPutResponse     , PutNode (..)+    , PutRelationship (..)     , putGraph     ) where @@ -16,9 +16,10 @@ import qualified Data.Map.Strict                   as M (map) import qualified Data.Text                         as T (Text, pack) import           Database.Bolt                     (BoltActionT, Node (..),-                                                    RecordValue (..), Value (..),-                                                    URelationship (..), at,-                                                    exact, query)+                                                    RecordValue (..),+                                                    URelationship (..),+                                                    Value (..), at, exact,+                                                    query) import           Database.Bolt.Extras.Graph        (Graph (..)) import           Database.Bolt.Extras.Persisted    (BoltId, fromInt) import           Database.Bolt.Extras.Query.Cypher (ToCypher (..))@@ -27,12 +28,17 @@  -- | 'PutNode' is the wrapper for 'Node' where we can specify if we want to merge or create it. ---data PutNode = BoltId BoltId | Merge Node | Create Node+data PutNode = BoltId BoltId | MergeN Node | CreateN Node   deriving (Show) +-- | 'PutRelationship' is the wrapper for 'Relationship' where we can specify if we want to merge or create it.+--+data PutRelationship = MergeR URelationship | CreateR URelationship+  deriving (Show)+ -- | The graph of 'Node's with specified uploading type and 'URelationship's. ---type GraphPutRequest = Graph NodeName PutNode URelationship+type GraphPutRequest = Graph NodeName PutNode PutRelationship  -- | The graph of 'BoltId's corresponding to the nodes and relationships -- which we get after putting 'GraphPutRequest'.@@ -49,9 +55,9 @@ -- putNode :: (MonadIO m) => PutNode -> BoltActionT m [BoltId] putNode ut = case ut of-    (BoltId bId)  -> pure [bId]-    (Merge node)  -> helper (T.pack "MERGE") node-    (Create node) -> helper (T.pack "CREATE") node+    (BoltId bId)   -> pure [bId]+    (MergeN node)  -> helper (T.pack "MERGE") node+    (CreateN node) -> helper (T.pack "CREATE") node   where     helper :: (MonadIO m) => T.Text -> Node -> BoltActionT m [BoltId]     helper q node = do@@ -72,23 +78,28 @@ -- For given starting and ending 'Node's 'BoltId's, and for @URelationship  _ urelType urelProps@ -- this method makes MERGE query and then returns the corresponding 'BoltId'. ---putRelationship :: (MonadIO m) => BoltId -> URelationship -> BoltId -> BoltActionT m BoltId-putRelationship start URelationship{..} end = do-  [record]      <- query mergeQ-  urelIdentity' <- record `at` varQ >>= exact-  pure $ fromInt urelIdentity'+putRelationship :: (MonadIO m) => BoltId -> PutRelationship -> BoltId -> BoltActionT m BoltId+putRelationship start pr end = case pr of+    (MergeR relationship)  -> helper (T.pack "MERGE") relationship+    (CreateR relationship) -> helper (T.pack "CREATE") relationship   where-    varQ = "r"-    labelQ = toCypher urelType-    propsQ = toCypher . toList $ urelProps-    startT = T.pack . show $ start-    endT = T.pack . show $ end+    helper :: (MonadIO m) => T.Text -> URelationship -> BoltActionT m BoltId+    helper q URelationship{..} = do+        [record]      <- query putQuery+        urelIdentity' <- record `at` varQ >>= exact+        pure $ fromInt urelIdentity'+      where+        varQ = "r"+        labelQ = toCypher urelType+        propsQ = toCypher . toList $ urelProps+        startT = T.pack . show $ start+        endT = T.pack . show $ end -    mergeQ :: T.Text-    mergeQ = [text|MATCH (a), (b)-              WHERE ID(a) = $startT AND ID(b) = $endT-              MERGE (a)-[$varQ $labelQ {$propsQ}]->(b)-              RETURN ID($varQ) as $varQ|]+        putQuery :: T.Text+        putQuery = [text|MATCH (a), (b)+                         WHERE ID(a) = $startT AND ID(b) = $endT+                         $q (a)-[$varQ $labelQ {$propsQ}]->(b)+                         RETURN ID($varQ) as $varQ|]  -- | Creates graph using given 'GraphPutRequest'. -- If there were multiple choices while merging given _vertices, the first match is used for connection.

@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}++module Database.Bolt.Extras.Query.Set+  (+    setNode+  ) where++import           Control.Monad.IO.Class              (MonadIO)+import           Data.Text                           (Text, append, intercalate)+import           Database.Bolt                       (BoltActionT,+                                                      RecordValue (..), at,+                                                      exact, query)+import           Database.Bolt.Extras.Persisted      (BoltId, fromInt)+import           Database.Bolt.Extras.Query.Cypher   (ToCypher (..))+import           Database.Bolt.Extras.Query.Get      (NodeGetter, condIdAsText,+                                                      nodeAsText)+import           Database.Bolt.Extras.Template.Types (Property)+import           NeatInterpolation                   (text)++-- | 'setNode' updates properties for the node,+-- corresponding to the given 'NodeGetter'.+--+setNode :: (MonadIO m) => NodeGetter -> [Property] -> BoltActionT m BoltId+setNode nodeGetter props = do+    let nodeGetterT = nodeAsText (varQ, nodeGetter)+    let condId      = condIdAsText (varQ, nodeGetter)++    let newProperties = intercalate ", " $ fmap formPropertySet props++    let getQuery = [text|MATCH $nodeGetterT+                         WHERE $condId+    					           SET $newProperties+                         RETURN ID($varQ) as $varQ|]++    record <- head <$> query getQuery+    nodeIdentity' <- record `at` varQ >>= exact+    pure $ fromInt nodeIdentity'++  where+    varQ = "n"++    formPropertyName :: Text -> Text+    formPropertyName n = varQ `append` "." `append` n++    formPropertySet :: Property -> Text+    formPropertySet (name, prop) = formPropertyName name `append` "=" `append` toCypher prop