version 0.0.0.6: 'PutRelation' and 'setNode' (#14)

biocad · Apr 20, 2018 · dedf27a · dedf27a
1 parent 88462e1
commit dedf27a
Show file tree

Hide file tree

Showing 7 changed files with 103 additions and 34 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -6,6 +6,11 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
 
 ## [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`.

diff --git a/hasbolt-extras.cabal b/hasbolt-extras.cabal
@@ -1,5 +1,5 @@
 name:           hasbolt-extras
-version:        0.0.0.5
+version:        0.0.0.6
 synopsis:       Extras for hasbolt library
 description:    Extras for hasbolt library
 homepage:       https://github.com/biocad/hasbolt-extras#readme
@@ -32,6 +32,7 @@ library
                      , 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
 

diff --git a/src/Database/Bolt/Extras/Query.hs b/src/Database/Bolt/Extras/Query.hs
@@ -6,10 +6,12 @@ module Database.Bolt.Extras.Query
   , NodeGetter (..)
   , NodeName
   , PutNode (..)
+  , PutRelationship (..)
   , RelGetter (..)
   , ToCypher (..)
   , getGraph
   , putGraph
+  , setNode
   ) where
 
 import           Database.Bolt.Extras.Query.Cypher (ToCypher (..))
@@ -19,5 +21,8 @@ import           Database.Bolt.Extras.Query.Get    (GraphGetRequest,
                                                     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)
diff --git a/src/Database/Bolt/Extras/Query/Cypher.hs b/src/Database/Bolt/Extras/Query/Cypher.hs
@@ -15,13 +15,12 @@ module Database.Bolt.Extras.Query.Cypher
 -- 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.
 --

diff --git a/src/Database/Bolt/Extras/Query/Get.hs b/src/Database/Bolt/Extras/Query/Get.hs
@@ -1,14 +1,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE RecordWildCards   #-}
-{-# LANGUAGE TemplateHaskell   #-}
 
 module Database.Bolt.Extras.Query.Get
     ( NodeGetter (..)
     , GraphGetRequest
     , GraphGetResponse
     , RelGetter (..)
     , getGraph
+    , nodeAsText
+    , condIdAsText
     ) where
 
 import           Control.Monad.IO.Class              (MonadIO)

diff --git a/src/Database/Bolt/Extras/Query/Put.hs b/src/Database/Bolt/Extras/Query/Put.hs
@@ -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           Data.Map.Strict                   (mapWithKey, toList, (!))
 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 @@ import           NeatInterpolation                 (text)
 
 -- | '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 @@ type GraphPutResponse = Graph NodeName BoltId BoltId
 --
 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 @@ putNode ut = case ut of
 -- 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.

diff --git a/src/Database/Bolt/Extras/Query/Set.hs b/src/Database/Bolt/Extras/Query/Set.hs
@@ -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