hypher (empty) → 0.1.0

raw patch · 21 files changed

+3750/−0 lines, 21 filesdep +Cabaldep +HTTPdep +HUnitsetup-changed

Dependencies added: Cabal, HTTP, HUnit, QuickCheck, aeson, base, bytestring, containers, data-default, hashable, http-conduit, http-types, lifted-base, monad-control, mtl, resourcet, scientific, test-framework, test-framework-hunit, test-framework-quickcheck2, test-framework-th, text, transformers, transformers-base, unordered-containers, vector

Files

• LICENSE +21/−0
• Setup.hs +2/−0
• hypher.cabal +88/−0
• src/Database/Neo4j.hs +131/−0
• src/Database/Neo4j/Batch.hs +41/−0
• src/Database/Neo4j/Batch/Label.hs +66/−0
• src/Database/Neo4j/Batch/Node.hs +48/−0
• src/Database/Neo4j/Batch/Property.hs +78/−0
• src/Database/Neo4j/Batch/Relationship.hs +73/−0
• src/Database/Neo4j/Batch/Types.hs +96/−0
• src/Database/Neo4j/Cypher.hs +91/−0
• src/Database/Neo4j/Graph.hs +272/−0
• src/Database/Neo4j/Http.hs +192/−0
• src/Database/Neo4j/Index.hs +32/−0
• src/Database/Neo4j/Label.hs +53/−0
• src/Database/Neo4j/Node.hs +34/−0
• src/Database/Neo4j/Property.hs +66/−0
• src/Database/Neo4j/Relationship.hs +79/−0
• src/Database/Neo4j/Transactional/Cypher.hs +339/−0
• src/Database/Neo4j/Types.hs +357/−0
• tests/IntegrationTests.hs +1591/−0

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2014 Antoni Silvestre++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,88 @@+name:                hypher+version:             0.1.0+synopsis:            A Haskell neo4j client+description:         +    Library to interact with Neo4j databases. +    .+    This library covers: +    .+       -Cypher transactions+    .+       -CRUD operations for nodes, relationships, labels and indexes+    .+       -Batch calls for CRUD operations.+    .+    .+    All code has been tested with Neo4j versions 2.0.3 and 2.1.5+homepage:            https://github.com/zoetic-community/hyper.git+license:             MIT+license-file:        LICENSE+author:              Antoni Silvestre & Jeff Taggart+maintainer:          jeff@jetaggart.com+copyright:           (c) 2015 Jeff Taggart+category:            Database+build-type:          Simple+cabal-version:       >=1.8++source-repository this+    type: git+    location: https://github.com/zoetic-community/hypher.git+    tag: master++Test-Suite test-hypher+     Type:           exitcode-stdio-1.0+     Hs-Source-Dirs: src, tests+     Main-is:        IntegrationTests.hs+     Build-Depends:  base >=4.6 && <4.8,+                     bytestring ==0.10.*,+                     test-framework ==0.8.*,+                     test-framework-quickcheck2 ==0.3.*,+                     QuickCheck ==2.7.*,+                     test-framework-hunit ==0.3.*,+                     test-framework-th ==0.2.*,+                     HUnit ==1.2.*,+                     Cabal,+                     text >= 1.1 && < 1.3,+                     http-conduit ==2.1.*,+                     http-types ==0.8.*,+                     resourcet ==1.1.*,+                     data-default ==0.5.*,+                     transformers ==0.4.*,+                     aeson >= 0.7 && < 0.9,+                     vector ==0.10.*,+                     scientific ==0.3.*,+                     unordered-containers ==0.2.*,+                     transformers-base ==0.4.*,+                     HTTP ==4000.2.*,+                     lifted-base ==0.2.*,+                     hashable ==1.2.*,+                     monad-control ==0.3.*,+                     mtl ==2.2.*++library+  hs-source-dirs:      src+  exposed-modules:     Database.Neo4j, Database.Neo4j.Graph, Database.Neo4j.Batch, Database.Neo4j.Cypher,+                       Database.Neo4j.Transactional.Cypher+  other-modules:       Database.Neo4j.Types, Database.Neo4j.Http, Database.Neo4j.Node, Database.Neo4j.Relationship,+                       Database.Neo4j.Property, Database.Neo4j.Label, Database.Neo4j.Index, Database.Neo4j.Batch.Node,+                       Database.Neo4j.Batch.Relationship, Database.Neo4j.Batch.Property, Database.Neo4j.Types,+                       Database.Neo4j.Batch.Label, Database.Neo4j.Batch.Types+  build-depends:       base >=4.6 && <4.8,+                       containers ==0.5.*,+                       text >= 1.1 && < 1.3,+                       http-conduit ==2.1.*,+                       http-types ==0.8.*,+                       bytestring ==0.10.*,+                       resourcet ==1.1.*,+                       data-default ==0.5.*,+                       transformers ==0.4.*,+                       aeson >= 0.7 && < 0.9,+                       vector ==0.10.*,+                       scientific ==0.3.*,+                       unordered-containers ==0.2.*,+                       HTTP ==4000.2.*,+                       lifted-base ==0.2.*,+                       hashable ==1.2.*,+                       transformers-base ==0.4.*,+                       monad-control ==0.3.*,+                       mtl ==2.2.*

@@ -0,0 +1,131 @@+{-# LANGUAGE OverloadedStrings  #-}++-- |+-- Module:      Database.Neo4j+-- Copyright:   (c) 2014, Antoni Silvestre+-- License:     MIT+-- Maintainer:  Antoni Silvestre <antoni.silvestre@gmail.com>+-- Stability:   experimental+-- Portability: portable+--+-- Library to interact with the Neo4j REST API.+--++module Database.Neo4j (+    -- * How to use this library+    -- $use++    -- * Connection handling objects+    Connection, Hostname, Port, newConnection, withConnection,+    -- * Main monadic type to handle sequences of commands to Neo4j+    Neo4j(..),+    -- * Constructing and managing node/relationship properties+    Val(..), PropertyValue(..), newval, (|:), Properties, emptyProperties, getProperties, getProperty, setProperties,+        setProperty, deleteProperties, deleteProperty, +    -- * Managing nodes+    Node, getNodeProperties, createNode, getNode, deleteNode, nodeId, nodePath, runNodeIdentifier, NodeIdentifier(..),+         NodePath(..),+    -- * Managing relationships+    Relationship, Direction(..), RelationshipType, createRelationship, getRelationship, deleteRelationship,+        getRelationships, relId, relPath, allRelationshipTypes, getRelProperties, getRelType, runRelIdentifier,+        getRelationshipFrom, getRelationshipTo, RelIdentifier(..), RelPath(..),+    -- * Managing labels and getting nodes by label+    EntityIdentifier(..), Label, allLabels, getLabels, getNodesByLabelAndProperty, addLabels, changeLabels,+    removeLabel,+    -- * Indexes+    Index(..), createIndex, getIndexes, dropIndex,+    -- * Exceptions+    Neo4jException(..)+    ) where++import Database.Neo4j.Index+import Database.Neo4j.Http+import Database.Neo4j.Label+import Database.Neo4j.Node+import Database.Neo4j.Relationship+import Database.Neo4j.Property+import Database.Neo4j.Types++-- $use+--+-- In order to start issuing commands to neo4j you must establish a connection, in order to do that you can use+-- the function 'withConnection':+--+-- > withConnection "127.0.0.1" 7474 $ do+-- >    neo <- createNode M.empty+-- >    cypher <- createNode M.empty+-- >    r <- createRelationship "KNOWS" M.empty neo cypher+-- >    ...+--+-- Also most calls have a batch analogue version, with batch mode you can issue several commands to Neo4j at once.+-- In order to issue batches you must use the "Database.Neo4j.Batch" monad, parameters in batch mode can be actual+-- entities already obtained by issuing regular commands or previous batch commands, or even batch futures,+-- that is you can refer to entities created in the same batch, for instance:+--+-- > withConnection "127.0.0.1" 7474 $ do+-- >    g <- B.runBatch $ do+-- >        neo <- B.createNode M.empty+-- >        cypher <- B.createNode M.empty+-- >        B.createRelationship "KNOWS" M.empty neo cypher+-- >    ...+--+-- As you can see this example does the same thing the previous one does but it will be more efficient as it will+-- be translated into only one request to the database.+--+-- Batch commands return a "Database.Neo4j.Graph" object that holds all the information about relationships, nodes+-- and their labels that can be inferred from running a batch command.+--+-- Another example with batches would be for instance remove all the nodes in a "Database.Neo4j.Graph" object+--+-- > withConnection "127.0.0.1" 7474 $ do+-- >    ...+-- >    B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+--+-- For more information about batch commands and graph objects you can refer to their "Database.Neo4j.Batch" and+-- "Database.Neo4j.Graph" modules.+--+-- Properties are hashmaps with key 'Data.Text' and values a custom type called 'PropertyValue'.+-- This custom type tries to use Haskell's type system to match property values to what Neo4j expects, we only allow+-- 'Int64', 'Double', 'Bool' and 'Text' like values and one-level arrays of these.+-- The only restriction we cannot guarantee with these types is that arrays of values must be of the same type.+--+-- In order to create a 'PropertyValue' from a literal or a value of one of the allowed types you can use the 'newval'+-- function or the operator '|:' to create pairs of key values:+--+-- > import qualified Data.HashMap.Lazy as M+-- >+-- > myval = newval False+-- > someProperties = M.fromList ["mytext" |: ("mytext" :: T.Text),+-- >                             "textarrayprop" |: ["a" :: T.Text, "", "adeu"],+-- >                             "int" |: (-12 :: Int64),+-- >                             "intarray" |: [1 :: Int64, 2],+-- >                             "double" |: (-12.23 :: Double),+-- >                             "doublearray" |: [0.1, -12.23 :: Double],+-- >                             "bool" |: False,+-- >                             "aboolproparray" |: [False, True]+-- >                            ]+-- +-- When unexpected errors occur a 'Neo4jException' will be raised, sometimes with a specific exception value like for+-- instance 'Neo4jNoEntityException', or more generic ones like 'Neo4jHttpException' or 'Neo4jParseException'+-- if the server  returns something totally unexpected. (I'm sure there's still work to do here preparing the code+-- to return more specific exceptions for known scenarios)+-- +-- About Cypher support for now we allow sending queries with parameters, the result is a collection of column headers+-- and JSON data values, the Graph object has the function addCypher that tries to find+-- nodes and relationships in a cypher query result and insert them in a "Database.Neo4j.Graph" object+--+-- > import qualified Database.Neo4j.Cypher as C+-- >+-- > withConnection host port $ do+-- >    ...+-- >    -- Run a cypher query with parameters+-- >    res <- C.cypher "CREATE (n:Person { name : {name} }) RETURN n" M.fromList [("name", C.newparam ("Pep" :: T.Text))]+-- >+-- >    -- Get all nodes and relationships that this query returned and insert them in a Graph object+-- >    let graph = G.addCypher (C.fromSuccess res) G.empty+-- >+-- >    -- Get the column headers+-- >    let columnHeaders = C.cols $ C.fromSuccess res+-- >+-- >    -- Get the rows of JSON values received+-- >    let values = C.vals $ C.fromSuccess res

@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances  #-}++module Database.Neo4j.Batch (+    -- * Usage+    -- $use    ++    -- * General+    Batch, runBatch, BatchFuture(..), NodeBatchIdentifier, RelBatchIdentifier, BatchEntity,+    -- * Nodes+    createNode, getNode, deleteNode,+    -- * Relationships+    createRelationship, getRelationship, getRelationshipFrom, getRelationshipTo, deleteRelationship, getRelationships,+    -- * Properties+    setProperties, setProperty, deleteProperties, deleteProperty,+    -- * Labels+    getLabels, getNodesByLabelAndProperty, addLabels, changeLabels, removeLabel+    )where++import Database.Neo4j.Batch.Label+import Database.Neo4j.Batch.Node+import Database.Neo4j.Batch.Property+import Database.Neo4j.Batch.Relationship+import Database.Neo4j.Batch.Types++-- $use+--+-- With batch mode you can issue several commands to Neo4j at once.+-- In order to issue batches you must use the Batch monad, parameters in batch mode can be actual entities already+-- obtained by issuing regular commands or previous batch commands, or even batch futures, that is you can refer+-- to entities created in the same batch, for instance:+--+-- > withConnection "127.0.0.1" 7474 $ do+-- >    g <- B.runBatch $ do+-- >        neo <- B.createNode M.empty+-- >        cypher <- B.createNode M.empty+-- >        B.createRelationship "KNOWS" M.empty neo cypher+-- >    ...+--+-- Batch commands return a "Database.Neo4j.Graph" object that holds all the information about relationships,+-- nodes and their labels that can be inferred from running a batch command.

@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances  #-}++module Database.Neo4j.Batch.Label where++import Data.Maybe (fromMaybe)+import Data.String (fromString)+import Network.HTTP.Base (urlEncodeVars)++import qualified Data.Aeson as J+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Network.HTTP.Types as HT++import qualified Database.Neo4j.Graph as G++import Database.Neo4j.Types+import Database.Neo4j.Batch.Node+import Database.Neo4j.Batch.Types++parseLabelsPath :: J.Value -> T.Text -> NodeUrl+parseLabelsPath j suf = NodeUrl $ let p = tryParseFrom j in fromMaybe p $ T.stripSuffix suf p++-- | Retrieve all labels for a node, if the node doesn't exist already it will raise an exception+-- | Raises Neo4jNoEntityException if the node doesn't exist+getLabels :: NodeBatchIdentifier a => a -> Batch (BatchFuture [Label])+getLabels n = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodGet, cmdPath = path, cmdBody = "", cmdParse = parser}+          path = getNodeBatchId n <> "/labels"+          parser jn = G.setNodeLabels (parseLabelsPath jn "/labels") (tryParseBody jn)++-- | Get all nodes using a label and a property+getNodesByLabelAndProperty :: Label -> Maybe (T.Text, PropertyValue) -> Batch (BatchFuture [Node])+getNodesByLabelAndProperty lbl prop = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodGet, cmdPath = path, cmdBody = "", cmdParse = parser}+          path = "/label/" <> lbl <> "/nodes" <> fromString (propUrl prop)+          propUrl Nothing = ""+          propUrl (Just (name, value)) = '?' : urlEncodeVars [(T.unpack name, lbsToStr $ J.encode value)]+          lbsToStr = S.unpack . L.toStrict+          parser jn g = foldl (\gacc n -> G.addNodeLabel n lbl (G.addNode n gacc)) g (tryParseBody jn)++-- | Add labels to a node+-- | Raises Neo4jNoEntityException if the node doesn't exist+addLabels :: NodeBatchIdentifier a => [Label] -> a -> Batch (BatchFuture ())+addLabels lbls n = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodPost, cmdPath = path, cmdBody = J.toJSON lbls, cmdParse = parser}+          path = getNodeBatchId n <> "/labels"+          parser jn g = let from = parseLabelsPath jn "/labels" in foldl (flip (G.addNodeLabel from)) g lbls++-- | Change node labels+-- | Raises Neo4jNoEntityException if the node doesn't exist+changeLabels :: NodeBatchIdentifier a => [Label] -> a -> Batch (BatchFuture ())+changeLabels lbls n = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodPut, cmdPath = path, cmdBody = J.toJSON lbls, cmdParse = parser}+          path = getNodeBatchId n <> "/labels"+          parser jn = G.setNodeLabels (parseLabelsPath jn "/labels") lbls++-- | Remove a label for a node+-- | Raises Neo4jNoEntityException if the node doesn't exist+removeLabel :: NodeBatchIdentifier a => Label -> a -> Batch (BatchFuture ())+removeLabel lbl n = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodDelete, cmdPath = path, cmdBody = "", cmdParse = parser}+          suffix = "/labels/" <> lbl+          path = getNodeBatchId n <> suffix+          parser jn = G.deleteNodeLabel (parseLabelsPath jn suffix) lbl

@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances  #-}++module Database.Neo4j.Batch.Node where++import Data.String (fromString)++import qualified Data.Aeson as J+import qualified Data.Text as T+import qualified Network.HTTP.Types as HT++import qualified Database.Neo4j.Graph as G++import Database.Neo4j.Batch.Types+import Database.Neo4j.Types++class NodeBatchIdentifier a where+    getNodeBatchId :: a -> T.Text++instance NodeBatchIdentifier Node where+    getNodeBatchId = urlMinPath . runNodePath . nodePath++instance NodeBatchIdentifier NodeUrl where+    getNodeBatchId = urlMinPath . runNodeUrl++instance NodeBatchIdentifier NodePath where+    getNodeBatchId = urlMinPath . runNodePath++instance NodeBatchIdentifier (BatchFuture Node) where+    getNodeBatchId (BatchFuture bId) = "{" <> (fromString . show) bId <> "}"++-- | Batch operation to create a node+createNode :: Properties -> Batch (BatchFuture Node)+createNode props = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodPost, cmdPath = "/node", cmdBody = J.toJSON props, cmdParse = parser}+          parser n = G.addNode (tryParseBody n)++-- | Batch operation to get a node from the DB+getNode :: NodeBatchIdentifier a => a -> Batch (BatchFuture Node)+getNode n = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodGet, cmdPath = getNodeBatchId n, cmdBody = "", cmdParse = parser}+          parser jn = G.addNode (tryParseBody jn)++-- | Batch operation to delete a node+deleteNode :: NodeBatchIdentifier a => a -> Batch (BatchFuture ())+deleteNode n = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodDelete, cmdPath = getNodeBatchId n, cmdBody = "", cmdParse = parser}+          parser f = G.deleteNode (NodeUrl $ tryParseFrom f)

@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances  #-}++module Database.Neo4j.Batch.Property where++import Data.Maybe (fromMaybe)++import qualified Data.Aeson as J+import qualified Data.Text as T+import qualified Network.HTTP.Types as HT++import qualified Database.Neo4j.Graph as G++import Database.Neo4j.Types+import Database.Neo4j.Batch.Node+import Database.Neo4j.Batch.Relationship+import Database.Neo4j.Batch.Types++class BatchEntity a where+    getEntityBatchId :: a -> T.Text++instance BatchEntity Node where+    getEntityBatchId = getNodeBatchId++instance BatchEntity NodeUrl where+    getEntityBatchId = getNodeBatchId++instance BatchEntity NodePath where+    getEntityBatchId = getNodeBatchId++instance BatchEntity (BatchFuture Node) where+    getEntityBatchId = getNodeBatchId++instance BatchEntity Relationship where+    getEntityBatchId = getRelBatchId++instance BatchEntity RelUrl where+    getEntityBatchId = getRelBatchId++instance BatchEntity RelPath where+    getEntityBatchId = getRelBatchId++instance BatchEntity (BatchFuture Relationship) where+    getEntityBatchId = getRelBatchId++parsePropertiesPath :: J.Value -> T.Text -> T.Text+parsePropertiesPath j suf = let p = tryParseFrom j in fromMaybe p $ T.stripSuffix suf p++-- | Set all relationship/node properties+setProperties :: BatchEntity a => a -> Properties -> Batch (BatchFuture ())+setProperties e props = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodPut, cmdPath = path, cmdBody = J.toJSON props, cmdParse = parser}+          path = getEntityBatchId e <> "/properties"+          parser f = G.setProperties (parsePropertiesPath f "/properties") props++-- | Set a relationship/node property+setProperty :: BatchEntity a => a -> T.Text -> PropertyValue -> Batch (BatchFuture ())+setProperty e name value = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodPut, cmdPath = path, cmdBody = J.toJSON value, cmdParse = parser}+          path = getEntityBatchId e <> pathsuffix+          pathsuffix = "/properties/" <> name+          parser :: J.Value -> G.Graph -> G.Graph+          parser f = G.setProperty (parsePropertiesPath f pathsuffix) name value++-- | Delete all relationship/node properties+deleteProperties :: BatchEntity a => a -> Batch (BatchFuture ())+deleteProperties e = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodDelete, cmdPath = path, cmdBody = "", cmdParse = parser}+          path = getEntityBatchId e <> "/properties"+          parser f = G.deleteProperties (parsePropertiesPath f "/properties")++-- | Delete a relationship/node property+deleteProperty :: BatchEntity a => a -> T.Text -> Batch (BatchFuture ())+deleteProperty e key = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodDelete, cmdPath = path, cmdBody = "", cmdParse = parser}+          path = getEntityBatchId e <> pathsuffix+          pathsuffix = "/properties/" <> key+          parser f = G.deleteProperty (parsePropertiesPath f pathsuffix) key

@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances  #-}++module Database.Neo4j.Batch.Relationship where++import Data.Aeson ((.=))+import Data.String (fromString)++import qualified Data.Aeson as J+import qualified Data.Text as T+import qualified Network.HTTP.Types as HT++import qualified Database.Neo4j.Graph as G++import Database.Neo4j.Types+import Database.Neo4j.Batch.Node+import Database.Neo4j.Batch.Types++class RelBatchIdentifier a where+    getRelBatchId :: a -> T.Text++instance RelBatchIdentifier Relationship where+    getRelBatchId = urlMinPath . runRelPath . relPath++instance RelBatchIdentifier RelUrl where+    getRelBatchId = urlMinPath . runRelUrl++instance RelBatchIdentifier RelPath where+    getRelBatchId = urlMinPath . runRelPath++instance RelBatchIdentifier (BatchFuture Relationship) where+    getRelBatchId (BatchFuture bId) = "{" <> (fromString . show) bId <> "}"++-- | Create a new relationship with a type and a set of properties+createRelationship :: (NodeBatchIdentifier a, NodeBatchIdentifier b) => RelationshipType -> Properties -> a -> b ->+                         Batch (BatchFuture Relationship)+createRelationship t props nodefrom nodeto = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodPost, cmdPath = path, cmdBody = J.toJSON body, cmdParse = parser}+          path = getNodeBatchId nodefrom <> "/relationships"+          body = J.object ["to" .= getNodeBatchId nodeto, "type" .= t, "data" .= J.toJSON props]+          parser r = G.addRelationship (tryParseBody r)++-- | Refresh a relationship entity with the contents in the DB+getRelationship :: RelBatchIdentifier r => r -> Batch (BatchFuture Relationship)+getRelationship rel = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodGet, cmdPath = getRelBatchId rel, cmdBody = "", cmdParse = parser}+          parser jr = G.addRelationship (tryParseBody jr)++-- | Get the "node from" from a relationship from the DB+getRelationshipFrom :: Relationship -> Batch (BatchFuture Node)+getRelationshipFrom rel = getNode $ relFrom rel++-- | Get the "node to" from a relationship from the DB+getRelationshipTo :: Relationship -> Batch (BatchFuture Node)+getRelationshipTo rel = getNode $ relTo rel++-- | Delete a relationship+deleteRelationship :: RelBatchIdentifier r => r -> Batch (BatchFuture ())+deleteRelationship rel = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodDelete, cmdPath = getRelBatchId rel, cmdBody = "", cmdParse = parser}+          parser jr = G.deleteRelationship (RelUrl $ tryParseFrom jr)++-- | Get all relationships for a node+getRelationships :: NodeBatchIdentifier n => n -> Direction -> [RelationshipType] -> Batch (BatchFuture [Relationship])+getRelationships n dir types = nextState cmd+    where cmd = defCmd{cmdMethod = HT.methodGet, cmdPath = path, cmdBody = "", cmdParse = parser}+          path = getNodeBatchId n <> "/relationships/" <> dirStr dir <> filterStr types+          parser jr g = foldl (flip G.addRelationship) g (tryParseBody jr)+          dirStr Outgoing = "out"+          dirStr Incoming = "in"+          dirStr Any = "all"+          filterStr [] = ""+          filterStr f = "/" <> T.intercalate "%26" f

@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances  #-}++module Database.Neo4j.Batch.Types where++import Control.Exception.Base (throw)+import Data.Aeson ((.=), (.:))+import Data.Maybe (fromMaybe)+import Control.Monad.State (state, State, runState)++import qualified Data.Aeson as J+import qualified Data.Aeson.Types as JT+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Vector as V+import qualified Network.HTTP.Types as HT++import Database.Neo4j.Graph+import Database.Neo4j.Http+import Database.Neo4j.Types++newtype BatchFuture a = BatchFuture Int++type CmdParser = J.Value -> Graph -> Graph++data BatchCmd = BatchCmd {cmdMethod :: HT.Method, cmdPath ::T.Text, cmdBody :: J.Value,+                            cmdParse :: CmdParser, cmdId :: Int}++defCmd :: BatchCmd+defCmd = BatchCmd{cmdMethod = HT.methodGet, cmdPath = "", cmdBody = "", cmdParse = \_ g -> g, cmdId = -1}++data BatchState = BatchState {commands :: [BatchCmd], batchId :: Int}++type Batch a = State BatchState a++getCmds :: Batch a -> [BatchCmd]+getCmds s = let (_, BatchState cmds _) = runState s (BatchState [] (-1)) in reverse cmds++instance J.ToJSON (Batch a) where+    toJSON b = J.toJSON $ getCmds b++instance J.ToJSON BatchCmd where+    toJSON (BatchCmd m p b _ cId) = J.object ["method" .= TE.decodeUtf8 m, "to" .= p, "body" .= b, "id" .= cId]++-- | Helper function to parse a batch element response from a body entry+tryParseBody :: J.FromJSON a => J.Value -> a+tryParseBody (J.Object jb) = let res = flip JT.parseEither jb $ \obj -> (obj .: "body") >>= J.parseJSON+               in case res of+                     Right entity -> entity+                     Left e -> throw $ Neo4jParseException ("Error parsing entity: " ++ e)+tryParseBody _ = throw $ Neo4jParseException "Error expecting an object"++-- | Helper function to parse a batch element response from a from entry+tryParseFrom :: J.FromJSON a => J.Value -> a+tryParseFrom (J.Object jb) = let res = flip JT.parseEither jb $ \obj -> (obj .: "from") >>= J.parseJSON+               in case res of+                     Right entity -> entity+                     Left e -> throw $ Neo4jParseException ("Error parsing entity: " ++ e)+tryParseFrom _ = throw $ Neo4jParseException "Error expecting an object"++nextState :: BatchCmd -> Batch (BatchFuture a)+nextState cmd = state $ \(BatchState cmds cId) ->+                                 (BatchFuture $ cId + 1, BatchState (cmd{cmdId = cId + 1} : cmds) (cId + 1))++parseBatchResponse :: J.Array -> Batch a -> Graph+parseBatchResponse jarr b = foldl (flip ($)) empty appliedParsers+    where cmds = getCmds b+          parsers = foldr (\cmd ps -> cmdParse cmd : ps) [] cmds+          appliedParsers = zipWith ($) parsers (V.toList jarr)++-- | Get teh exception type for a given batch exception message, if nothing is found a default exception is given+exceptionByName :: Neo4jException -> T.Text -> T.Text -> Neo4jException+exceptionByName _ "NoSuchPropertyException" msg = Neo4jNoSuchProperty msg+exceptionByName def _ _ = def++-- | Parse batch exceptions+parseException :: L.ByteString -> Neo4jException+parseException b = fromMaybe defaultException $ do+                    parsedobj <- J.decode b+                    msg <- flip JT.parseMaybe parsedobj $ \obj -> (obj .: "message") >>= J.parseJSON +                    parsedmsg <- J.decode (L.fromStrict $ TE.encodeUtf8 msg)+                    (errName, expl) <- flip JT.parseMaybe parsedmsg $ \obj -> do+                                                                        expl <- obj .: "message"+                                                                        errName <- obj .: "exception"+                                                                        return (errName, expl)+                    return $ exceptionByName defaultException errName expl+    where defaultException = Neo4jBatchException b++runBatch :: Batch a -> Neo4j Graph+runBatch b = Neo4j $ \conn -> do+        res <- httpCreate500Explained conn "/db/data/batch" $ J.encode b+        let arr = case res of+                    Left bodyErr -> throw $ parseException bodyErr+                    Right bodySuc -> bodySuc+        return $ parseBatchResponse arr b

@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings  #-}++-- | IMPORTANT! MODULE DEPRECATED, better use the code in this same library that uses the Neo4j transactional endpoint+--   in "Database.Neo4j.Transactional.Cypher"+--  Module to provide Cypher support.+--  Currently we allow sending queries with parameters, the result is a collection of column headers+--  and JSON data values, the Graph object has the function addCypher that tries to find+--  nodes and relationships in a cypher query result and insert them in a "Database.Neo4j.Graph" object+--+-- > import qualified Database.Neo4j.Cypher as C+-- >+-- > withConnection host port $ do+-- >    ...+-- >    -- Run a cypher query with parameters+-- >    res <- C.cypher "CREATE (n:Person { name : {name} }) RETURN n" M.fromList [("name", C.newparam ("Pep" :: T.Text))]+-- >+-- >    -- Get all nodes and relationships that this query returned and insert them in a Graph object+-- >    let graph = G.addCypher (C.fromSuccess res) G.empty+-- >+-- >    -- Get the column headers+-- >    let columnHeaders = C.cols $ C.fromSuccess res+-- >+-- >    -- Get the rows of JSON values received+-- >    let values = C.vals $ C.fromSuccess res+module Database.Neo4j.Cypher (+    -- * Types+    Response(..), ParamValue(..), Params, newparam,+    -- * Sending queries+    cypher, fromResult, fromSuccess, isSuccess+    ) where++import Data.Aeson ((.=), (.:))+import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)++import qualified Data.Aeson as J+import qualified Data.ByteString as S+import qualified Data.HashMap.Lazy as M+import qualified Data.Text as T++import Database.Neo4j.Types+import Database.Neo4j.Http++-- | Type for a Cypher response with tuples containing column name and their values+data Response = Response {cols :: [T.Text], vals :: [[J.Value]]} deriving (Show, Eq)++-- | How to create a response object from a cypher JSON response+instance J.FromJSON Response where+    parseJSON (J.Object o) = Response <$> (o .: "columns" >>= J.parseJSON) <*> (o .: "data" >>= J.parseJSON)+    parseJSON _ = mzero+                        +cypherAPI :: S.ByteString+cypherAPI = "/db/data/cypher"++-- | Value for a cypher parmeter value, might be a literal, a property map or a list of property maps+data ParamValue = ParamLiteral PropertyValue | ParamProperties Properties | ParamPropertiesArray [Properties]+     deriving (Show, Eq)++newparam :: PropertyValueConstructor a => a -> ParamValue+newparam = ParamLiteral . newval++-- | Instance toJSON for param values so we can serialize them in queries+instance J.ToJSON ParamValue where+    toJSON (ParamLiteral l) = J.toJSON l+    toJSON (ParamProperties p) = J.toJSON p+    toJSON (ParamPropertiesArray ps) = J.toJSON ps++-- | We use hashmaps to represent Cypher parameters+type Params = M.HashMap T.Text ParamValue++-- | Run a cypher query+cypher :: T.Text -> Params -> Neo4j (Either T.Text Response)+cypher cmd params = Neo4j $ \conn -> httpCreate4XXExplained conn cypherAPI body+    where body = J.encode $ J.object ["query" .= cmd, "params" .= J.toJSON params]++-- | Get the result of the response or a default value+fromResult :: Response -> Either T.Text Response -> Response+fromResult def (Left _) = def+fromResult _ (Right resp) = resp++-- | Get the result of the response or a default value+fromSuccess :: Either T.Text Response -> Response+fromSuccess (Left _) = error "Cypher.fromSuccess but is Error"+fromSuccess (Right resp) = resp++-- | True if the operation succeeded+isSuccess :: Either T.Text Response -> Bool+isSuccess (Left _) = False+isSuccess (Right _) = True++{-# DEPRECATED cypher, fromResult, fromSuccess, isSuccess "Use Database.Neo4j.Transactional.Cypher instead" #-} 

@@ -0,0 +1,272 @@+{-# LANGUAGE OverloadedStrings  #-}++-- | Module to handle 'Graph' objects. These have information about a group of nodes, relationships,+--  and information about labels per node and nodes per label.+--  Notice a graph can have relationships and at the same time not have some of the nodes of those+--  relationships, see the section called handling orphaned relationships. This is so because commands in a batch+--  might retrieve relationships but might not create or retrieve their respective nodes.+module Database.Neo4j.Graph (+    -- * General objects+    Graph, LabelSet, empty,+    -- * Handling nodes in the graph object+    addNode, hasNode, deleteNode, getNodes, getNode, getNodeFrom, getNodeTo,+    -- * Handling properties in the graph object+    getRelationships, hasRelationship, addRelationship, deleteRelationship, getRelationshipNodeFrom,+    getRelationshipNodeTo, getRelationship,+    -- ** Handling orphaned relationships #orphan#+    getOrphansFrom, getOrphansTo, cleanOrphanRelationships,+    -- * Handling properties+    setProperties, setProperty, deleteProperties, deleteProperty,+    -- * Handling labels+    setNodeLabels, addNodeLabel, getNodeLabels, deleteNodeLabel,+    -- * Handling Cypher results+    addCypher,+    -- * Graph filtering functions+    nodeFilter, relationshipFilter,+    -- * Graph operations+    union, difference, intersection+    )where++import Data.Maybe (fromMaybe)++import Control.Applicative ((<$>))+import Control.Monad (join)+import qualified Data.Aeson as J+import qualified Data.HashMap.Lazy as M+import qualified Data.HashSet as HS+import qualified Data.List as L+import qualified Data.Text as T++import Database.Neo4j.Types+import qualified Database.Neo4j.Cypher as C++type NodeIndex = M.HashMap NodePath Node+type RelIndex = M.HashMap RelPath Relationship+type NodeSet = HS.HashSet NodePath+type LabelNodeIndex = M.HashMap Label NodeSet+type LabelSet = HS.HashSet Label+type NodeLabelIndex = M.HashMap NodePath LabelSet+type RelSet = HS.HashSet RelPath+type NodeRelIndex = M.HashMap NodePath RelSet++data Graph = Graph {nodes :: NodeIndex, labels :: LabelNodeIndex, rels :: RelIndex,+                    nodeLabels :: NodeLabelIndex, nodeFromRels :: NodeRelIndex, nodeToRels :: NodeRelIndex+                    } deriving (Eq, Show)++-- | Create an empty graph+empty :: Graph+empty = Graph {nodes = M.empty, labels = M.empty, rels = M.empty, nodeLabels = M.empty, nodeFromRels = M.empty,+               nodeToRels = M.empty}++-- | Add a node to the graph+addNode :: Node -> Graph -> Graph+addNode n g = g {nodes = M.insert (getNodePath n) n (nodes g)}++-- | Set the properties of a node or relationship in the graph, if not present it won't do anything+setProperties :: EntityIdentifier a => a -> Properties -> Graph -> Graph+setProperties ei props g = fromMaybe g $ (addEntity . newEntity) <$> entity+    where path = getEntityPath ei+          entity = case path of +                    (EntityNodePath p) -> entityObj <$> M.lookup p (nodes g)+                    (EntityRelPath p) -> entityObj <$> M.lookup p (rels g)+          newEntity e = setEntityProperties e props+          addEntity e = case e of+                            (EntityNode n) -> g{nodes = M.insert (getNodePath n) n (nodes g)}+                            (EntityRel r) -> g{rels = M.insert (getRelPath r) r (rels g)}++-- | Set a property of a node or relationship in the graph, if not present it won't do anything+setProperty :: EntityIdentifier a => a -> T.Text -> PropertyValue -> Graph -> Graph+setProperty ei name value g = fromMaybe g $ (addEntity . newEntity) <$> entity+    where path = getEntityPath ei+          entity = case path of +                    (EntityNodePath p) -> entityObj <$> M.lookup p (nodes g)+                    (EntityRelPath p) -> entityObj <$> M.lookup p (rels g)+          newEntity e = setEntityProperties e $ M.insert name value (getEntityProperties e)+          addEntity e = case e of+                            (EntityNode n) -> g{nodes = M.insert (getNodePath n) n (nodes g)}+                            (EntityRel r) -> g{rels = M.insert (getRelPath r) r (rels g)}++-- | Delete all the properties of a node or relationship, if the entity is not present it won't do anything+deleteProperties :: EntityIdentifier a => a -> Graph -> Graph+deleteProperties ei g = fromMaybe g $ (addEntity . newEntity) <$> entity+    where path = getEntityPath ei+          entity = case path of +                    (EntityNodePath p) -> entityObj <$> M.lookup p (nodes g)+                    (EntityRelPath p) -> entityObj <$> M.lookup p (rels g)+          newEntity e = setEntityProperties e emptyProperties+          addEntity e = case e of+                            (EntityNode n) -> g{nodes = M.insert (getNodePath n) n (nodes g)}+                            (EntityRel r) -> g{rels = M.insert (getRelPath r) r (rels g)}++-- | Delete a property of a node or relationship, if the entity is not present it won't do anything+deleteProperty :: EntityIdentifier a => a -> T.Text -> Graph -> Graph+deleteProperty ei key g = fromMaybe g $ (addEntity . newEntity) <$> entity+    where path = getEntityPath ei+          entity = case path of +                    (EntityNodePath p) -> entityObj <$> M.lookup p (nodes g)+                    (EntityRelPath p) -> entityObj <$> M.lookup p (rels g)+          newEntity e = setEntityProperties e $ M.delete key (getEntityProperties e)+          addEntity e = case e of+                            (EntityNode n) -> g{nodes = M.insert (getNodePath n) n (nodes g)}+                            (EntityRel r) -> g{rels = M.insert (getRelPath r) r (rels g)}++-- | Whether a node is present in the graph+hasNode :: NodeIdentifier a => a -> Graph -> Bool+hasNode n g = getNodePath n `M.member` nodes g++-- | Get a node in the graph+getNode :: NodeIdentifier a => a -> Graph -> Maybe Node+getNode n g = getNodePath n `M.lookup` nodes g++-- | Get outgoing relationships from a node+getNodeFrom :: NodeIdentifier a => a -> Graph -> Maybe [Relationship]+getNodeFrom n g = join $ sequence <$> filter (/=Nothing) <$> map getRel <$> fromrels+    where getRel = flip getRelationship g+          fromrels = HS.toList <$> getNodePath n `M.lookup` nodeFromRels g++-- | Get incoming relationships from a node+getNodeTo :: NodeIdentifier a => a -> Graph -> Maybe [Relationship]+getNodeTo n g = join $ sequence <$> filter (/=Nothing) <$> map getRel <$> torels+    where getRel = flip getRelationship g+          torels = HS.toList <$> getNodePath n `M.lookup` nodeToRels g++-- | Get a list with all the nodes in the graph+getNodes :: Graph -> [Node]+getNodes g = M.elems $ nodes g++-- | Whether a relationship is present in the graph+hasRelationship :: RelIdentifier a => a -> Graph -> Bool +hasRelationship r g = getRelPath r `M.member` rels g++-- | Delete a node from the graph+deleteNode :: NodeIdentifier a => a -> Graph -> Graph+deleteNode n g = g {nodes = M.delete nodeLoc (nodes g),+                 labels = cleanLabelNodeIndex $ removeNodeFromLabels (labels g) labelsForNode,+                 nodeLabels = M.delete nodeLoc (nodeLabels g)}+    where labelsForNode = M.lookupDefault HS.empty nodeLoc (nodeLabels g)+          nodeLoc = getNodePath n+          removeNodeFromLabels = HS.foldl' (\acc x -> M.insertWith (\_ -> HS.delete nodeLoc) x HS.empty acc)+          cleanLabelNodeIndex = M.filter (/=HS.empty) ++-- | Add a relationship to the graph+addRelationship :: Relationship -> Graph -> Graph+addRelationship r g = g {rels = M.insert (getRelPath r) r (rels g),+                         nodeFromRels = M.insertWith HS.union (pathFrom r) (HS.singleton relpath) (nodeFromRels g),+                         nodeToRels = M.insertWith HS.union (pathTo r) (HS.singleton relpath) (nodeToRels g)}+    where pathFrom = getNodePath . relFrom+          pathTo = getNodePath . relTo+          relpath = getRelPath r++-- | Get a list with all the relationships in the graph+getRelationships :: Graph -> [Relationship]+getRelationships g = M.elems $ rels g++-- | Get a relationship in the graph+getRelationship :: RelIdentifier a => a -> Graph -> Maybe Relationship+getRelationship r g = getRelPath r `M.lookup` rels g++-- | Get relationships missing their "from" node+getOrphansFrom :: Graph -> [Relationship]+getOrphansFrom g = M.elems $ M.filter noNode (rels g)+    where noNode r = not $ getNodePath (relFrom r) `M.member` nodes g++-- | Get relationships missing their "to" node+getOrphansTo :: Graph -> [Relationship]+getOrphansTo g = M.elems $ M.filter noNode (rels g)+    where noNode r = not $ getNodePath (relTo r) `M.member` nodes g++-- | Remove all relationships with a missing node+cleanOrphanRelationships :: Graph -> Graph+cleanOrphanRelationships g = foldl (flip deleteRelationship) g (getOrphansFrom g ++ getOrphansTo g)++-- | Delete a relationship from the graph+deleteRelationship :: RelIdentifier a => a -> Graph -> Graph+deleteRelationship r g = g {rels = M.delete (getRelPath r) (rels g),+                            nodeFromRels = removeNodeRef (nodeFromRels g) pathFrom,+                            nodeToRels = removeNodeRef (nodeToRels g) pathTo}+    where updNodeRel = const $ HS.delete (getRelPath r)+          rel = M.lookup (getRelPath r) (rels g)+          pathFrom = (getNodePath . relFrom) <$> rel+          pathTo = (getNodePath . relTo) <$> rel+          removeNodeRef nodeRel (Just nodepath) = M.insertWith updNodeRel nodepath HS.empty nodeRel+          removeNodeRef nodeRel Nothing = nodeRel+++-- | Get the "node from" from a relationship+getRelationshipNodeFrom :: Relationship -> Graph -> Maybe Node+getRelationshipNodeFrom r g = M.lookup (getNodePath (relFrom r)) (nodes g) ++-- | Get the "node to" from a relationship+getRelationshipNodeTo :: Relationship -> Graph -> Maybe Node+getRelationshipNodeTo r g = M.lookup (getNodePath (relTo r)) (nodes g)++-- | Set what labels a node has+setNodeLabels :: NodeIdentifier a => a -> [Label] -> Graph -> Graph+setNodeLabels n lbls g = g {nodeLabels = M.insert (getNodePath n) (HS.fromList lbls) (nodeLabels g),+                            labels = insertLabels lbls (labels g)}+    where insertLabels xs acc = foldl (\accum x -> M.insertWith HS.union x defaultNodeSet accum) acc xs+          defaultNodeSet = HS.singleton $ getNodePath n++-- | Add a label to a node+addNodeLabel :: NodeIdentifier a => a -> Label -> Graph -> Graph+addNodeLabel n lbl g = g {nodeLabels = M.insertWith HS.union locationForNode (HS.singleton lbl) nodeLabelIndex,+                            labels = M.insertWith HS.union lbl (HS.singleton locationForNode) labelNodeIndex}+    where locationForNode = getNodePath n+          nodeLabelIndex = nodeLabels g+          labelNodeIndex = labels g++-- | Get the labels of a node+getNodeLabels :: NodeIdentifier a => a -> Graph -> LabelSet+getNodeLabels n g = let loc = getNodePath n in M.lookupDefault HS.empty loc (nodeLabels g)++-- | Remove a label from a node+deleteNodeLabel :: NodeIdentifier a => a -> Label -> Graph -> Graph+deleteNodeLabel n lbl g = g {nodeLabels = M.insertWith nodeLabelIndexOp locationForNode HS.empty nodeLabelIndex,+                            labels = M.insertWith labelNodeIndexOp lbl HS.empty labelNodeIndex}+    where locationForNode = getNodePath n+          nodeLabelIndex = nodeLabels g+          nodeLabelIndexOp = const $ HS.delete lbl+          labelNodeIndex = labels g+          labelNodeIndexOp = const $ HS.delete locationForNode+          ++-- | Filter the nodes of a graph+nodeFilter :: (Node -> Bool) -> Graph -> Graph+nodeFilter f g = foldl (\gacc n -> if f n then gacc else deleteNode n gacc) g (M.elems $ nodes g)++-- | Filter the relationships of a graph+relationshipFilter :: (Relationship -> Bool) -> Graph -> Graph+relationshipFilter f g = foldl (\gacc r -> if f r then gacc else deleteRelationship r gacc) g (M.elems $ rels g)++-- | Add two graphs resulting in a graph with all the nodes, labels and relationships of both+-- | If a node/entity is present in both the second one will be chosen+union :: Graph -> Graph -> Graph+union ga gb = addLabels (addRels (addNodes ga gb) gb) gb+    where addRels g1 g2 = foldl (\gacc r -> addRelationship r gacc) g1 (getRelationships g2)+          addNodes g1 g2 = foldl (flip addNode) g1 (getNodes g2)+          addLabels g1 g2 = foldl (\gacc n -> setNodeLabels n (HS.toList $ getNodeLabels n g2) gacc) g1 (getNodes g2)++-- | Remove the nodes and relationships in the first graph that appear in the second+difference :: Graph -> Graph -> Graph+difference ga gb = relationshipFilter relFilterFunc (nodeFilter nodeFilterFunc ga)+    where relFilterFunc r = not $ hasRelationship r gb+          nodeFilterFunc n = not $ hasNode n gb++-- | Have a graph that only has nodes and relationships that are present in both+intersection :: Graph -> Graph -> Graph+intersection ga gb = relationshipFilter relFilterFunc (nodeFilter nodeFilterFunc ga)+    where relFilterFunc r = hasRelationship r gb+          nodeFilterFunc n = hasNode n gb++-- | Feed a cypher result (from the old API) into a graph (looks for nodes and relationships and inserts them)+addCypher :: C.Response -> Graph -> Graph+addCypher (C.Response _ vals) ginit = foldl tryAdd ginit (concat vals)+    where tryAdd :: Graph -> J.Value -> Graph+          -- Try first to parse it as a relationship and then as a node, otherwise leave the graph as it is+          tryAdd g v = fromMaybe g $ L.find parseSuccess (map ($ v) [relParser g, nodeParser g]) >>= fromResult+          relParser g v = flip addRelationship g <$> J.fromJSON v+          nodeParser g v = flip addNode g <$> J.fromJSON v+          parseSuccess (J.Success _) = True+          parseSuccess (J.Error _) = False+          fromResult (J.Error _) = Nothing+          fromResult (J.Success g) = Just g

@@ -0,0 +1,192 @@+{-# LANGUAGE OverloadedStrings  #-}++module Database.Neo4j.Http where++import Control.Exception.Base (Exception, throw, catch, toException)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Resource (runResourceT)+import Data.Default (def)+import Data.Maybe (fromMaybe)++import Data.Aeson ((.:))+import Data.Aeson.Types (parseMaybe)++import qualified Data.Aeson as J+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Network.HTTP.Conduit as HC+import qualified Network.HTTP.Types as HT++import Database.Neo4j.Types+++-- | Create a new connection that can be manually closed with runResourceT+newConnection :: Hostname -> Port -> IO Connection+newConnection hostname port = do+        mgr <- HC.newManager HC.conduitManagerSettings+        return $ Connection hostname port mgr++-- | Run a set of Neo4j commands in a single connection+withConnection :: Hostname -> Port -> Neo4j a -> IO a +withConnection hostname port cmds = runResourceT $ HC.withManager $+         \mgr -> liftIO $ runNeo4j cmds $ Connection hostname port mgr+        +-- | General function for HTTP requests+httpReq :: Connection -> HT.Method -> S.ByteString -> L.ByteString -> (HT.Status -> Bool) ->+     IO (HC.Response L.ByteString)+httpReq (Connection h p m) method path body statusCheck = do+            let request = def {+                    HC.host = h,+                    HC.port = p,+                    HC.path = path,+                    HC.method = method,+                    HC.requestBody = HC.RequestBodyLBS body,+                    HC.checkStatus = \s _ _ -> if statusCheck s+                                                 then Nothing+                                                 else Just (toException $ Neo4jUnexpectedResponseException s),+                    HC.requestHeaders = [(HT.hAccept, "application/json; charset=UTF-8"),+                                          (HT.hContentType, "application/json")]}+            -- TODO: Would be better to use exceptions package Control.Monad.Catch ??+            -- Wrapping up HTTP-Conduit exceptions in our own+            liftIO $ HC.httpLbs request m `catch` wrapException+    where wrapException :: HC.HttpException -> a+          wrapException = throw . Neo4jHttpException . show++-- | Extracts the exception description from a HTTP Neo4j response if the status code matches otherwise Nothing+extractException :: HC.Response L.ByteString -> T.Text+extractException resp = fromMaybe "" $ do+                resobj <- J.decode $ HC.responseBody resp+                flip parseMaybe resobj $ \obj -> obj .: "exception"++-- | Launch a POST request, this will raise an exception if 201 or 200 is not received+httpCreate :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString -> IO a+httpCreate conn path body = do+            res <- httpReq conn HT.methodPost path body (`elem` [HT.status200, HT.status201])+            let resBody = J.eitherDecode $ HC.responseBody res+            return $ case resBody of+                        Right entity -> entity+                        Left e -> throw $ Neo4jParseException ("Error parsing created entity: " ++ e)++-- | Launch a POST request and get some headers+httpCreateWithHeaders :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString -> IO (a, HT.ResponseHeaders)+httpCreateWithHeaders conn path body = do+            res <- httpReq conn HT.methodPost path body (`elem` [HT.status200, HT.status201])+            let resBody = J.eitherDecode $ HC.responseBody res+            let result = case resBody of+                            Right entity -> entity+                            Left e -> throw $ Neo4jParseException ("Error parsing created entity: " ++ e)+            let headers = HC.responseHeaders res+            return (result, headers)++-- | Launch a POST request, this will raise an exception if 201 or 204 is not received, explain 500+httpCreate500Explained :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString ->+                                             IO (Either L.ByteString a)+httpCreate500Explained conn path body = do+            res <- httpReq conn HT.methodPost path body (`elem` [HT.status200, HT.status201, HT.status500])+            let status = HC.responseStatus res+            let resBody = HC.responseBody res+            return $ if status == HT.status500 then Left resBody else parseBody resBody+        where parseBody b = case J.eitherDecode b of+                        Right entity -> Right entity+                        Left e -> throw $ Neo4jParseException ("Error parsing created entity: " ++ e)++-- | Launch a POST request, this will raise an exception if 201 or 204 is not received+--   With 404 or 400 will return a left with the explanation+httpCreate4XXExplained :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString -> IO (Either T.Text a)+httpCreate4XXExplained conn path body = do+            res <- httpReq conn HT.methodPost path body (\s -> s `elem` validcodes ++ errcodes)+            let status = HC.responseStatus res+            return $ if status `elem`  validcodes then parseBody res else Left $ extractException res+    where parseBody resp = case J.eitherDecode $ HC.responseBody resp of+                            Right entity -> Right entity+                            Left e -> throw $ Neo4jParseException ("Error parsing created entity: " ++ e)+          validcodes = [HT.status200, HT.status201]+          errcodes = [HT.status404, HT.status400]++-- | Launch a POST request that doesn't expect response body, this will raise an exception if 204 is not received+httpCreate_ :: Connection -> S.ByteString -> L.ByteString -> IO ()+httpCreate_ conn path body = do+            _ <- httpReq conn HT.methodPost path body (\s -> s == HT.status201 || s == HT.status204)+            return ()++-- | Launch a GET request, this will raise an exception if 200 or 404 is not received+httpRetrieve :: J.FromJSON a => Connection -> S.ByteString -> IO (Maybe a)+httpRetrieve conn path = do+            res <- httpReq conn HT.methodGet path "" (\s -> s == HT.status200 || s == HT.status404)+            let status = HC.responseStatus res+            let body = if status == HT.status200+                         then Just $ J.eitherDecode $ HC.responseBody res+                         else Nothing+            return $ case body of+                        Just (Right entity) -> Just entity+                        Just (Left e) -> throw $ Neo4jParseException ("Error parsing received entity: " ++ e)+                        Nothing -> Nothing++-- | Launch GET request, just allow 200, if 404 is received an exception will be raised+httpRetrieveSure :: J.FromJSON a => Connection -> S.ByteString -> IO a+httpRetrieveSure conn path = do+            res <- httpReq conn HT.methodGet path "" (==HT.status200)+            let body = J.eitherDecode $ HC.responseBody res+            return $ case body of+                        Right entity -> entity+                        Left e -> throw $ Neo4jParseException ("Error parsing received entity: " ++ e)++-- | Launch a GET request, this will raise an exception if 200 or 404 is not received+--   With 404 will return a left with the explanation+--   Unlike httpRetrieve this method can parse any JSON value even if it's non-top (arrays and objects)+httpRetrieveValue :: J.FromJSON a => Connection -> S.ByteString -> IO (Either T.Text a)+httpRetrieveValue conn path = do+            res <- httpReq conn HT.methodGet path "" (\s -> s == HT.status200 || s == HT.status404)+            let status = HC.responseStatus res+            return $ if status == HT.status200 then parseBody res else Left $ extractException res+                         -- Ugly hack to parse values that aren't top level JSON values (objects and arrays)+    where parseBody resp = case  J.eitherDecode $ "[" `L.append` HC.responseBody resp `L.append` "]" of+                                Right (entity:[]) -> Right entity+                                Right _ -> throw $ Neo4jParseException "Error parsing received entity"+                                Left e -> throw $ Neo4jParseException ("Error parsing received entity: " ++ e)+            ++-- | Launch a DELETE request, this will raise an exception if 204 is not received+--   If we receive 404, we will just return true, though wasn't existing already the result is the same+httpDelete :: Connection -> S.ByteString -> IO () +httpDelete c pth = do+            _ <- httpReq c HT.methodDelete pth "" (\s -> s == HT.status204 || s == HT.status404)+            return ()++-- | Launch a DELETE request, this will raise an exception if 204 is not received+--   We don't accept 404+httpDeleteNo404 :: Connection -> S.ByteString -> IO () +httpDeleteNo404 c pth = do+            _ <- httpReq c HT.methodDelete pth "" (==HT.status204)+            return ()++-- | Launch a DELETE request, this will raise an exception if 204 is not received+--   If we receive 404, we will return the server explanation+httpDelete404Explained :: Connection -> S.ByteString -> IO (Either T.Text ())+httpDelete404Explained c pth = do+            res <- httpReq c HT.methodDelete pth "" (\s -> s == HT.status204 || s == HT.status404)+            let status = HC.responseStatus res+            return $ if status /= HT.status404 then Right () else Left $ extractException res++-- | Launch a PUT request, this will raise an exception if 200 or 204 is not received+httpModify :: Connection -> S.ByteString -> L.ByteString -> IO ()+httpModify c path body = do+            _ <- httpReq c HT.methodPut path body (\s -> s == HT.status200 || s == HT.status204)+            return ()++-- | Launch a PUT request, this will raise an exception if 200 or 204 is not received+--   If we receive 404, we will return the server explanation+httpModify404Explained :: Connection -> S.ByteString -> L.ByteString -> IO (Either T.Text ())+httpModify404Explained c path body = do+            res <- httpReq c HT.methodPut path body (\s -> s == HT.status200 || s == HT.status204 || s == HT.status404)+            let status = HC.responseStatus res+            return $ if status /= HT.status404 then Right () else Left $ extractException res++-- | Wrap 404 exception into Neo4jNoEntity exceptions+proc404Exc :: Entity e => e -> Neo4jException -> a+proc404Exc e exc@(Neo4jUnexpectedResponseException s)+        | s == HT.status404 = throw (Neo4jNoEntityException $ entityPath e)+        | otherwise = throw exc+proc404Exc _ exc = throw exc+

@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings  #-}++module Database.Neo4j.Index where++import Data.Aeson ((.=))++import qualified Data.Aeson as J+import qualified Data.ByteString.Char8 as S+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++import Database.Neo4j.Types+import Database.Neo4j.Http+++indexPath :: Label -> Maybe T.Text -> S.ByteString+indexPath lbl prop = "/db/data/schema/index/" <> TE.encodeUtf8 lbl <> propPath prop+    where propPath (Just name) = "/" <> TE.encodeUtf8 name+          propPath Nothing = ""++-- | Creates an index for a label and a property+createIndex :: Label -> T.Text -> Neo4j Index+createIndex lbl prop = Neo4j $ \conn -> httpCreate conn (indexPath lbl Nothing) body+    where body = J.encode $ J.object ["property_keys" .= [prop]]++-- | Gets all indexes for a label+getIndexes :: Label -> Neo4j [Index]+getIndexes lbl = Neo4j $ \conn -> httpRetrieveSure conn (indexPath lbl Nothing)++-- | Drop and index+dropIndex :: Label -> T.Text -> Neo4j ()+dropIndex lbl prop = Neo4j $ \conn -> httpDelete conn (indexPath lbl (Just prop))

@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings  #-}++module Database.Neo4j.Label where++import Network.HTTP.Base (urlEncodeVars)+import Control.Exception.Lifted (catch)++import qualified Data.Aeson as J+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++import Database.Neo4j.Types+import Database.Neo4j.Http+++-- | Get all labels in the DB+allLabels :: Neo4j [Label]+allLabels = Neo4j $ \conn -> httpRetrieveSure conn "/db/data/labels"++-- | Retrieve all labels for a node, if the node doesn't exist already it will raise an exception+-- | Raises Neo4jNoEntityException if the node doesn't exist+getLabels :: Node -> Neo4j [Label]+getLabels n = Neo4j $ \conn -> httpRetrieveSure conn (runNodeIdentifier n <> "/labels") `catch` proc404Exc n++-- | Get all nodes using a label and a property+getNodesByLabelAndProperty :: Label -> Maybe (T.Text, PropertyValue) -> Neo4j [Node]+getNodesByLabelAndProperty lbl prop = Neo4j $ \conn -> +        httpRetrieveSure conn ("/db/data/label/" <> TE.encodeUtf8 lbl <> "/nodes" <> propUrl prop)+    where propUrl Nothing = ""+          propUrl (Just (name, value)) = S.pack $ '?' : urlEncodeVars [(T.unpack name, lbsToStr $ J.encode value)]+          lbsToStr = S.unpack . L.toStrict++-- | Add labels to a node+-- | Raises Neo4jNoEntityException if the node doesn't exist+addLabels :: [Label] -> Node -> Neo4j ()+addLabels lbls n = Neo4j $ \conn -> (do+        httpCreate_ conn (runNodeIdentifier n <> "/labels") (J.encode lbls) +        return ()) `catch` proc404Exc n++-- | Change node labels+-- | Raises Neo4jNoEntityException if the node doesn't exist+changeLabels :: [Label] -> Node -> Neo4j ()+changeLabels lbls n = Neo4j $ \conn ->+                             httpModify conn (runNodeIdentifier n <> "/labels") (J.encode lbls) `catch` proc404Exc n++-- | Remove a label for a node+-- | Raises Neo4jNoEntityException if the node doesn't exist+removeLabel :: Label -> Node -> Neo4j ()+removeLabel lbl n = Neo4j $ \conn -> (do+        _ <- httpDeleteNo404 conn (runNodeIdentifier n <> "/labels/" <> TE.encodeUtf8 lbl)+        return ()) `catch` proc404Exc n

@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings  #-}++module Database.Neo4j.Node where++import Control.Exception.Lifted (throw, catch)++import qualified Data.Aeson as J+import qualified Data.ByteString as S+import qualified Network.HTTP.Types as HT++import Database.Neo4j.Types+import Database.Neo4j.Http+    ++-- | Get the ID of a node+nodeId :: Node -> S.ByteString+nodeId n = S.drop (pathLength + 1) (runNodeIdentifier n)+    where pathLength = S.length nodeAPI++-- | Create a new node with a set of properties+createNode :: Properties -> Neo4j Node+createNode props = Neo4j $ \conn -> httpCreate conn nodeAPI (J.encode props)++-- | Refresh a node entity with the contents in the DB+getNode :: NodeIdentifier a => a -> Neo4j (Maybe Node)+getNode n = Neo4j $ \conn -> httpRetrieve conn (runNodeIdentifier n)++-- | Delete a node, if the node has relationships it will raise a Neo4jNonOrphanNodeDeletion+deleteNode :: NodeIdentifier a => a -> Neo4j () +deleteNode n = Neo4j $ \conn -> httpDelete conn (runNodeIdentifier n) `catch` processConflict+    where processConflict e@(Neo4jUnexpectedResponseException s) +            | s == HT.status409 = throw (Neo4jNonOrphanNodeDeletionException $ runNodeIdentifier n)+            | otherwise = throw e+          processConflict e = throw e

@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings  #-}++module Database.Neo4j.Property where++import Control.Exception.Lifted (throw, catch)++import qualified Data.Aeson as J+import qualified Data.HashMap.Lazy as M+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++import Database.Neo4j.Types+import Database.Neo4j.Http+++-- | Retrieve relationship/node properties from the DB, if the entity is not present it will raise an exception+--   If the entity doesn't exist it will raise a Neo4jNoEntity exception+getProperties :: Entity a => a -> Neo4j Properties+getProperties e = Neo4j $ \conn -> httpRetrieveSure conn (propertyPath e) `catch` proc404Exc e++-- | Get a relationship/node property+--   If the 404 is because the parent entity doesn't exist we'll raise the corresponding Neo4jNoEntity+--   If the 404 is because there is no property just return Nothing+getProperty :: Entity a => a -> T.Text -> Neo4j (Maybe PropertyValue)+getProperty e prop =  Neo4j $ \conn -> do+        res <- httpRetrieveValue conn path+        case res of+                    Right value -> return value+                    Left expl -> if expl `elem` excList then throw (Neo4jNoEntityException $ entityPath e)+                                 else return Nothing+    where path = propertyPath e <> "/" <> TE.encodeUtf8 prop+          excList = ["RelationshipNotFoundException", "NodeNotFoundException"]++-- | Set all relationship/node properties+--   If the entity doesn't exist it will raise a Neo4jNoEntity exception+setProperties :: Entity a => a -> Properties -> Neo4j a+setProperties e props =  Neo4j $ \conn -> (do+            httpModify conn (propertyPath e) $ J.encode props+            return $ setEntityProperties e props) `catch` proc404Exc e++-- | Set a relationship/node property+--   If the entity doesn't exist it will raise a Neo4jNoEntity exception+setProperty :: Entity a => a -> T.Text -> PropertyValue -> Neo4j a +setProperty e name value =  Neo4j $ \conn -> (do+            httpModify conn (propertyPath e <> "/" <> TE.encodeUtf8 name) $ J.encode value+            return $ setEntityProperties e $ M.insert name value (getEntityProperties e)) `catch` proc404Exc e++-- | Delete all relationship/node properties+--   If the entity doesn't exist it will raise a Neo4jNoEntity exception+deleteProperties :: Entity a => a -> Neo4j a+deleteProperties e = Neo4j $ \conn -> (do+            httpDeleteNo404 conn (propertyPath e)+            return $ setEntityProperties e emptyProperties) `catch` proc404Exc e++-- | Delete a relationship/node property+--   If the entity doesn't exist it will raise a Neo4jNoEntity exception+deleteProperty :: Entity a => a -> T.Text -> Neo4j a+deleteProperty e name = Neo4j $ \conn -> do+            res <- httpDelete404Explained conn (propertyPath e <> "/" <> TE.encodeUtf8 name)+            case res of+                    Right _ -> return resultingProps+                    Left expl -> if expl `elem` excList then throw (Neo4jNoEntityException $ entityPath e)+                                 else return resultingProps+    where excList = ["RelationshipNotFoundException", "NodeNotFoundException"]+          resultingProps = setEntityProperties e $ M.delete name (getEntityProperties e)+

@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings  #-}++module Database.Neo4j.Relationship where+++import Control.Exception.Lifted (throw, catch)+import Data.Aeson ((.=))+import Data.Maybe (fromMaybe)++import qualified Data.Aeson as J+import qualified Data.ByteString as S+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Network.HTTP.Types as HT++import Database.Neo4j.Node+import Database.Neo4j.Http+import Database.Neo4j.Types+++-- | Get the ID of a relationship+relId :: Relationship -> S.ByteString+relId n = S.drop (pathLength + 1) (runRelIdentifier n)+    where pathLength = S.length relationshipAPI++-- | Gets all relationship types in the DB+allRelationshipTypes :: Neo4j [RelationshipType]+allRelationshipTypes = Neo4j $ \conn -> httpRetrieveSure conn "/db/data/relationship/types"++-- | Create a new relationship with a type and a set of properties+createRelationship :: RelationshipType -> Properties -> Node -> Node -> Neo4j Relationship+createRelationship t props nodefrom nodeto = Neo4j $ \conn -> do+            res <- httpCreate4XXExplained conn reqPath reqBody+            case res of+                        Right rel -> return rel+                        Left expl -> wrapExc expl+    where reqPath = runNodeIdentifier nodefrom <> "/relationships"+          reqBody = J.encode $ J.object ["to" .= runNodePath (nodePath nodeto), "type" .= t,+                                         "data" .= J.toJSON props]+          wrapExc msg+            | msg == "StartNodeNotFoundException" = throw (Neo4jNoEntityException $ runNodeIdentifier nodefrom)+            | msg == "EndNodeNotFoundException" = throw (Neo4jNoEntityException $ runNodeIdentifier nodeto)+            | otherwise = throw (Neo4jHttpException $ T.unpack msg)++-- | Refresh a relationship entity with the contents in the DB+getRelationship :: RelIdentifier a => a -> Neo4j (Maybe Relationship)+getRelationship rel = Neo4j $ \conn -> httpRetrieve conn (runRelIdentifier rel)++-- | Get the "node from" from a relationship from the DB+-- | Raises Neo4jNoEntityException if the node (and thus the relationship) does not exist any more+getRelationshipFrom :: Relationship -> Neo4j Node+getRelationshipFrom rel = getNode node >>= processMaybe+    where node = relFrom rel+          processMaybe n = return $ fromMaybe (throw $ Neo4jNoEntityException (runNodeIdentifier node)) n++-- | Get the "node to" from a relationship from the DB+-- | Raises Neo4jNoEntityException if the node (and thus the relationship) does not exist any more+getRelationshipTo :: Relationship -> Neo4j Node+getRelationshipTo rel = getNode node >>= processMaybe+    where node = relTo rel+          processMaybe n = return $ fromMaybe (throw $ Neo4jNoEntityException (runNodeIdentifier node)) n ++-- | Delete a relationship+deleteRelationship :: RelIdentifier a => a -> Neo4j ()+deleteRelationship rel = Neo4j $ \conn -> httpDelete conn (runRelIdentifier rel)++-- | Get all relationships for a node, if the node has disappeared it will raise an exception+getRelationships :: Node -> Direction -> [RelationshipType] -> Neo4j [Relationship]+getRelationships n dir types = Neo4j $ \conn -> +      httpRetrieveSure conn (runNodeIdentifier n <> "/relationships/" <> dirStr dir <> filterStr types) `catch` procExc+    where dirStr Outgoing = "out"+          dirStr Incoming = "in"+          dirStr Any = "all"+          filterStr [] = ""+          filterStr f = "/" <> TE.encodeUtf8 (T.intercalate "%26" f)+          procExc exc@(Neo4jUnexpectedResponseException s)+                  | s == HT.status404 = throw (Neo4jNoEntityException $ runNodeIdentifier n)+                  | otherwise = throw exc+          procExc exc = throw exc

@@ -0,0 +1,339 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances  #-}++-- | Module to provide Cypher support using the transactional endpoint.+-- +--  Example:+--+-- > import qualified Database.Neo4j.Transactional.Cypher as T+-- >+-- > withConnection host port $ do+-- >    ...+-- >    res <- TC.runTransaction $ do+-- >            -- Queries return a result with columns, rows, a list of graphs and stats+-- >            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+-- >                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+-- >                                M.fromList [("age", TC.newparam (78 :: Int64)),+-- >                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+-- >            -- if any of the commands returns an error the transaction is rollbacked and leaves+-- >            result 2 <- T.cypher "not a command" M.empty+-- >            void $ TC.cypher "CREATE (pep: PERSON {age: 55})" M.empty+-- >            -- Transactions are implicitly commited/rollbacked (in case of exception)+-- >            -- but can be explicitly committed and rollbacked+-- >            return (result, result2)+module Database.Neo4j.Transactional.Cypher (+    -- * Types+    Result(..), Stats(..), ParamValue(..), Params, newparam, emptyStats, TransError, Transaction,+    -- * Sending queries+    loneQuery,  runTransaction, cypher, rollback, commit, keepalive, commitWith, rollbackAndLeave,+    -- * Aux functions+    isSuccess, fromResult, fromSuccess+    ) where++import Control.Monad.Reader+import Control.Monad.State.Strict+import Control.Monad.Trans.Except++import Control.Applicative ((<$>), (<*>))+import Data.Aeson ((.=), (.:))+import Data.List (find)+import Data.Maybe (fromMaybe)+import Text.Read (readMaybe)++import qualified Control.Exception as Exc+import qualified Control.Monad.Trans.Resource as R+import qualified Data.Aeson as J+import qualified Data.Acquire as A+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Network.HTTP.Types as HT++import Database.Neo4j.Types+import Database.Neo4j.Http+import Database.Neo4j.Cypher (ParamValue(..), Params, newparam)+import qualified Database.Neo4j.Graph as G+++-- | Holds the connection stats+data Stats = Stats {containsUpdates :: Bool,+                    nodesCreated :: Integer,+                    nodesDeleted :: Integer,+                    propsSet :: Integer,+                    relsCreated :: Integer,+                    relsDeleted :: Integer,+                    lblsAdded :: Integer,+                    lblsRemoved :: Integer,+                    idxAdded :: Integer,+                    idxRemoved :: Integer,+                    constAdded :: Integer,+                    constRemoved :: Integer} deriving (Eq, Show)+                +-- | Type for a Cypher response with tuples containing column name and their values+data Result = Result {cols :: [T.Text], vals :: [[J.Value]], graph :: [G.Graph], stats :: Stats} deriving (Show, Eq)++-- | Default stats+emptyStats :: Stats+emptyStats = Stats False 0 0 0 0 0 0 0 0 0 0 0++-- | An empty response+emptyResponse :: Result+emptyResponse = Result [] [] [] emptyStats++newtype CypherNode = CypherNode {runCypherNode :: (Node, [Label])} deriving (Eq, Show)+newtype CypherRel = CypherRel {runCypherRel :: Relationship} deriving (Eq, Show)++readDefault :: Read a => a -> String -> a+readDefault d = fromMaybe d . readMaybe++readIntDefault :: Integer -> String -> Integer+readIntDefault = readDefault+++-- | Instance to parse stats from a JSON+instance J.FromJSON Stats where+    parseJSON (J.Object o) = Stats <$> o .: "contains_updates" <*>+                                       o .: "nodes_created" <*>+                                       o .: "nodes_deleted" <*>+                                       o .: "properties_set" <*>+                                       o .: "relationships_created" <*>+                                       o .: "relationship_deleted" <*>+                                       o .: "labels_added" <*>+                                       o .: "labels_removed" <*>+                                       o .: "indexes_added" <*>+                                       o .: "indexes_removed" <*>+                                       o .: "constraints_added" <*>+                                       o .: "constraints_removed"+    parseJSON _ = mzero++-- | Instance for the node type in cypher responses+instance J.FromJSON CypherNode where+    parseJSON (J.Object o) = CypherNode <$> ((,) <$> parseNode <*> (o .: "labels" >>= J.parseJSON))+        where parseNode = do+                idStr <- o .: "id"+                props <- o .: "properties" >>= J.parseJSON+                return $ Node (getNodePath $ readIntDefault 0 idStr) props+    parseJSON _ = mzero++-- | Instance for the rel type in cypher responses+instance J.FromJSON CypherRel where+    parseJSON (J.Object o) = CypherRel <$> (Relationship <$> (relId <$> o .: "id") <*> o .: "type" <*>+           (o .: "properties" >>= J.parseJSON) <*> (nodeId <$> o .: "startNode") <*> (nodeId <$> o .: "endNode") )+        where relId = getRelPath . readIntDefault 0+              nodeId = getNodePath . readIntDefault 0+    parseJSON _ = mzero++-- | Build a graph from a cypher response+buildGraph :: [CypherNode] -> [CypherRel] -> G.Graph+buildGraph ns = foldl addRel (foldl addNode G.empty ns)+    where addNode g cn = let (n, lbls) = runCypherNode cn in G.setNodeLabels n lbls (n `G.addNode` g)+          addRel g cr = let r = runCypherRel cr in r `G.addRelationship` g+              +newtype DataElem = DataElem {runDataElem :: ([J.Value], G.Graph)} deriving (Eq, Show)++instance J.FromJSON DataElem where+    parseJSON (J.Object o) = DataElem <$> ((,) <$> (o .: "row" >>= J.parseJSON) <*> (o .: "graph" >>= parseGraph))+        where parseGraph (J.Object g) = buildGraph <$> (g .: "nodes" >>= J.parseJSON) <*> +                    (g .: "relationships" >>= J.parseJSON)+              parseGraph _ = mzero+    parseJSON _ = mzero++-- | How to create a response object from a cypher JSON response+instance J.FromJSON Result where+    parseJSON (J.Object o) = Result <$> (o .: "columns" >>= J.parseJSON) <*> (fst <$> pData) <*> (snd <$> pData)+                                         <*> (o .: "stats" >>= J.parseJSON)+        where parseData v = parseDataElem <$> J.parseJSON v+              parseDataElem ds = unzip $ map runDataElem ds+              pData = o .: "data" >>= parseData+    parseJSON _ = mzero+                        +transAPI :: S.ByteString+transAPI = "/db/data/transaction"++-- | Error code and message for a transaction error+type TransError = (T.Text, T.Text)++type TransactionId = S.ByteString++-- | Different transaction states+data TransState = TransInit | TransStarted R.ReleaseKey TransactionId | TransDone++type Transaction a = ExceptT TransError (ReaderT Connection (StateT TransState (R.ResourceT IO))) a++newtype Response = Response {runResponse :: Either TransError Result} deriving (Show, Eq)++instance J.FromJSON Response where+    parseJSON (J.Object o) = do+        errs <- o .: "errors" >>= parseErrs+        case errs of+            Just err -> return $ Response (Left err)+            Nothing -> Response . Right <$> (o .: "results" >>= parseResult)+     where parseErrs (J.Array es) =  if V.null es then return Nothing else Just <$> parseErr (V.head es)+           parseErrs _ = mzero+           parseErr (J.Object e) = (,) <$> e .: "code" <*> e .: "message"+           parseErr _ = mzero+           parseResult (J.Array rs) = if V.null rs then return emptyResponse else J.parseJSON $ V.head rs+           parseResult _ = mzero+    parseJSON _ = mzero++-- Transaction in one request+loneQuery :: T.Text -> Params -> Neo4j (Either TransError Result)+loneQuery =  transactionReq (transAPI <> "/commit")++-- Generate the body for a query+queryBody :: T.Text -> Params -> L.ByteString+queryBody cmd params = J.encode $ J.object ["statements" .= [+                                        J.object ["statement" .= cmd, resultSpec, includeStats,+                                                  "parameters" .= J.toJSON params]]]+    where resultSpec = "resultDataContents" .= ["row", "graph" :: T.Text]+          includeStats = "includeStats" .= True++-- | General function to launch queries inside a transaction+transactionReq :: S.ByteString -> T.Text -> Params -> Neo4j (Either TransError Result)+transactionReq path cmd params = Neo4j $ \conn -> runResponse <$> httpCreate conn path (queryBody cmd params)++-- | Run a transaction and get its final result, has an implicit commit request (or rollback if an exception occurred).+-- This implicit commit/rollback will only be executed if it hasn't before because of an explicit one+runTransaction :: Transaction a -> Neo4j (Either TransError a)+runTransaction t = Neo4j $ \conn ->+                     R.runResourceT (fst <$> runStateT (runReaderT (runExceptT $ catchErrors t) conn) TransInit)++-- | If a query returns an error we have to stop processing the transaction and make sure it's rolled back+catchErrors :: Transaction a -> Transaction a+catchErrors t = catchE t handle+    where handle err@("Rollback", _) = ExceptT $ return (Left err)+          handle err = do+                        st <- lift get+                        -- We can get here from commitWith, which runs and commits, in that case rollback is useless+                        unless (isDone st) rollback+                        ExceptT $ return (Left err)+          isDone TransDone = True+          isDone _ = False++-- | Run a cypher query in a transaction, if an error occurs the transaction will stop and rollback+cypher :: T.Text -> Params -> Transaction Result+cypher cmd params = do+      conn <- ask+      st <- lift get+      res <- case st of+                -- if this is the first query and the transaction hasn't been created yet, create it+                TransInit -> do +                        (key, (resp, headers)) <- lift $ lift $ lift $ reqNewTrans conn+                        lift $ put (TransStarted key $ transIdFromHeaders headers)+                        return resp+                -- the transaction is already created+                TransStarted _ transId -> liftIO $ reqTransCreated conn transId+                -- if the transaction has already ended raise an exception+                TransDone -> liftIO $ Exc.throw TransactionEndedExc+      ExceptT $ return $ runResponse res+    where reqNewTrans conn = acquireTrans conn $ httpCreateWithHeaders conn transAPI (queryBody cmd params)+          reqTransCreated conn path = httpCreate conn path (queryBody cmd params)++-- | Rollback a transaction.+--  After this, executing rollback, commit, keepalive, cypher in the transaction will result in an exception+rollback :: Transaction ()+rollback = do+    conn <- ask+    st <- lift get+    case st of+        TransInit -> return ()+        TransStarted key transId -> do+                        liftIO $ rollbackReq conn transId+                        void $ R.unprotect key+                        lift $ put TransDone+        TransDone -> liftIO $ Exc.throw TransactionEndedExc++-- | Rollback a transaction and stop processing it, set the message that runTransaction will return as error+rollbackAndLeave :: T.Text -> Transaction ()+rollbackAndLeave msg = do+    conn <- ask+    st <- lift get+    case st of+        TransInit -> throwE ("Rollback", msg)+        TransStarted key transId -> do+                        liftIO $ rollbackReq conn transId+                        void $ R.unprotect key+                        lift $ put TransDone+                        throwE ("Rollback", msg)+        TransDone -> liftIO $ Exc.throw TransactionEndedExc++-- | Commit a transaction.+--  After this, executing rollback, commit, keepalive, cypher in the transaction will result in an exception+commit :: Transaction ()+commit = do+    conn <- ask+    st <- lift get+    case st of+        TransInit -> return ()+        TransStarted key transId -> do+            liftIO $ commitReq conn transId+            void $ R.unprotect key+            lift $ put TransDone+        TransDone -> liftIO $ Exc.throw TransactionEndedExc++-- | Send a cypher query and commit at the same time, if an error occurs the transaction will be rolled back.+--  After this, executing rollback, commit, keepalive, cypher in the transaction will result in an exception+commitWith :: T.Text -> Params -> Transaction Result+commitWith cmd params = do+      conn <- ask+      st <- lift get+      res <- case st of+                -- if this is the first query and the transaction hasn't been created yet, create it+                TransInit -> liftIO $ req conn (transAPI <> "/commit")+                -- the transaction is already created+                TransStarted key transId -> do+                    void $ R.unprotect key+                    liftIO $ req conn (transId <> "/commit")+                -- if the transaction has already ended raise an exception+                TransDone -> liftIO $ Exc.throw TransactionEndedExc+      lift $ put TransDone+      ExceptT $ return $ runResponse res+    where req conn path = httpCreate conn path (queryBody cmd params)++-- | Send a keep alive message to an open transaction+keepalive :: Transaction ()+keepalive = do+    conn <- ask+    st <- lift get+    case st of+        TransInit -> return ()+        TransStarted _ transId -> liftIO $ keepaliveReq conn transId+        TransDone -> liftIO $ Exc.throw TransactionEndedExc++-- | Get the transaction ID from the location header+transIdFromHeaders :: HT.ResponseHeaders -> TransactionId+transIdFromHeaders headers = commitId $ fromMaybe (transAPI <> "-1") (snd <$> find ((==HT.hLocation) . fst) headers)+   where commitId loc = snd $ S.breakSubstring transAPI loc++-- | Start a transaction and register the transaction to be committed/rollbacked+acquireTrans :: Connection -> IO (a, HT.ResponseHeaders) -> R.ResourceT IO (R.ReleaseKey, (a, HT.ResponseHeaders))+acquireTrans conn req = A.allocateAcquire (A.mkAcquireType req freeRes)+    where freeRes (_, headers) A.ReleaseNormal = let transId = transIdFromHeaders headers in commitReq conn transId+          freeRes (_, headers) _ = let transId = transIdFromHeaders headers in rollbackReq conn transId++commitReq :: Connection -> TransactionId -> IO ()+commitReq conn trId = void $ httpReq conn HT.methodPost (trId <> "/commit") "" (const True)++rollbackReq :: Connection -> TransactionId -> IO ()+rollbackReq conn trId = void $ httpReq conn HT.methodDelete trId "" (const True)++keepaliveReq :: Connection -> TransactionId -> IO ()+keepaliveReq conn trId = void $ httpReq conn HT.methodPost trId keepaliveBody (const True)+    where keepaliveBody = J.encode $ J.object ["statements" .= ([] :: [Integer])]++-- | Get the result of the response or a default value+fromResult :: Result -> Either TransError Result -> Result+fromResult def (Left _) = def+fromResult _ (Right resp) = resp++-- | Get the result of the response or a default value+fromSuccess :: Either TransError Result -> Result+fromSuccess (Left _) = error "Cypher.fromSuccess but is Error"+fromSuccess (Right resp) = resp++-- | True if the operation succeeded+isSuccess :: Either TransError Result -> Bool+isSuccess (Left _) = False+isSuccess (Right _) = True

@@ -0,0 +1,357 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Database.Neo4j.Types where++import Data.Hashable (Hashable)+import Data.Int (Int64)+import Data.Maybe (fromMaybe)+import Data.Monoid (Monoid, mappend)+import Data.String (fromString)+import Data.Typeable (Typeable)+import Control.Exception (throw)+import Control.Exception.Base (Exception)+import Control.Applicative+import Control.Monad (mzero, ap, liftM)+import Control.Monad.Base (MonadBase, liftBase)+import Control.Monad.IO.Class (MonadIO, liftIO)+--import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith, restoreM, StM)+import Control.Monad.Trans.Resource (MonadThrow, throwM)+import GHC.Generics (Generic)++import Data.Aeson ((.:))+import qualified Data.Aeson as J+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.HashMap.Lazy as M+import qualified Data.Scientific as Sci+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Vector as V+import qualified Network.HTTP.Conduit as HC+import qualified Network.HTTP.Types as HT++(<>) :: (Monoid a) => a -> a -> a+(<>) = mappend++-- | Type for a single value of a Neo4j property+data Val = IntVal Int64 | BoolVal Bool | TextVal T.Text | DoubleVal Double deriving (Show, Eq)++-- | Wrapping type for a Neo4j single property or array of properties+--   Using these types allows type checking for only correct properties+--   that is int, double, string, boolean and single typed arrays of these, also nulls are not allowed+data PropertyValue = ValueProperty Val | ArrayProperty [Val] deriving (Show, Eq)++-- | This class allows easy construction of property value types from literals+class PropertyValueConstructor a where+    newval :: a -> PropertyValue++instance PropertyValueConstructor Int64 where+    newval v = ValueProperty $ IntVal v++instance PropertyValueConstructor Bool where+    newval v = ValueProperty $ BoolVal v++instance PropertyValueConstructor T.Text where+    newval v = ValueProperty $ TextVal v++instance PropertyValueConstructor Double where+    newval v = ValueProperty $ DoubleVal v++instance PropertyValueConstructor [Int64] where+    newval v = ArrayProperty $ map IntVal v++instance PropertyValueConstructor [Bool] where+    newval v = ArrayProperty $ map BoolVal v++instance PropertyValueConstructor [T.Text] where+    newval v = ArrayProperty $ map TextVal v++instance PropertyValueConstructor [Double] where+    newval v = ArrayProperty $ map DoubleVal v++-- | This operator allows easy construction of property value types from literals+(|:) :: PropertyValueConstructor a => T.Text -> a -> (T.Text, PropertyValue)+name |: v = (name, newval v)++-- | Specifying how to convert property single values to JSON+instance J.ToJSON Val where+    toJSON (IntVal v)  = J.Number $ fromIntegral v+    toJSON (BoolVal v)  = J.Bool v+    toJSON (TextVal v)  = J.String v+    toJSON (DoubleVal v)  = J.Number $ Sci.fromFloatDigits v++-- | Specifying how to convert property values to JSON+instance J.ToJSON PropertyValue where+    toJSON (ValueProperty v) = J.toJSON v+    toJSON (ArrayProperty vs) = J.Array (V.fromList $ map J.toJSON vs) ++-- | JSON to single property values+instance J.FromJSON Val where+    parseJSON (J.Number v) = let parsedNum = Sci.floatingOrInteger v in+                             return $ case parsedNum of+                                         Left d -> DoubleVal d+                                         Right i -> IntVal i+    parseJSON (J.Bool v) = return $ BoolVal v+    parseJSON (J.String v) = return $ TextVal v+    parseJSON _ = mzero++-- | JSON to property values+instance J.FromJSON PropertyValue where+    parseJSON (J.Array v) = ArrayProperty <$> mapM J.parseJSON (V.toList v)+    parseJSON v = ValueProperty <$> J.parseJSON v++-- | We use hashmaps to represent Neo4j properties+type Properties = M.HashMap T.Text PropertyValue++-- | Shortcut for emtpy properties+emptyProperties :: M.HashMap T.Text PropertyValue+emptyProperties = M.empty++-- | Tries to get the path from a URL, we try our best otherwise return the url as is+urlPath :: T.Text -> T.Text+urlPath url = fromMaybe url $ T.dropWhile (/='/') <$> T.stripPrefix "http://" url++-- | Path without the /db/data part, useful for batch paths and such+urlMinPath :: T.Text -> T.Text+urlMinPath url =  fromMaybe url $ T.stripPrefix "/db/data" (urlPath url)+++data EntityObj = EntityNode Node | EntityRel Relationship deriving (Eq, Show)++-- | Class for top-level Neo4j entities (nodes and relationships) useful to have generic property management code+class Entity a where+    entityPath :: a -> S.ByteString+    propertyPath :: a -> S.ByteString+    getEntityProperties :: a -> Properties+    setEntityProperties :: a -> Properties -> a+    entityObj :: a -> EntityObj+    +newtype NodeUrl = NodeUrl {runNodeUrl :: T.Text} deriving (Show, Eq, Generic)+instance Hashable NodeUrl++-- | Representation of a Neo4j node, has a location URI and a set of properties+data Node = Node {nodePath :: NodePath, nodeProperties :: Properties} deriving (Show, Eq)++-- | Get the properties of a node+getNodeProperties :: Node -> Properties+getNodeProperties = nodeProperties++-- | JSON to Node+instance J.FromJSON Node where+    parseJSON (J.Object v) = Node <$> (getNodePath . NodeUrl <$> (v .: "self")) <*> (v .: "data" >>= J.parseJSON)+    parseJSON _ = mzero++instance Entity Node where+    entityPath = runNodeIdentifier+    propertyPath n = runNodeIdentifier n <> "/properties"+    getEntityProperties = nodeProperties+    setEntityProperties n props = n {nodeProperties = props}+    entityObj = EntityNode++nodeAPI :: S.ByteString+nodeAPI = "/db/data/node"++nodeAPITxt :: T.Text+nodeAPITxt = "/db/data/node"++newtype NodePath = NodePath {runNodePath :: T.Text} deriving (Show, Eq, Generic)+instance Hashable NodePath++class NodeIdentifier a where+    getNodePath :: a -> NodePath++instance NodeIdentifier Node where+    getNodePath = nodePath++instance NodeIdentifier S.ByteString where+    getNodePath t = NodePath $ TE.decodeUtf8 $ nodeAPI <> "/" <> t++instance NodeIdentifier Integer where+    getNodePath n = NodePath $ nodeAPITxt <> "/" <> (fromString . show) n++instance NodeIdentifier NodePath where+    getNodePath = id++instance NodeIdentifier NodeUrl where+    getNodePath n = NodePath $ (urlPath . runNodeUrl) n++runNodeIdentifier :: NodeIdentifier a => a -> S.ByteString+runNodeIdentifier = TE.encodeUtf8 . runNodePath . getNodePath++-- | Type for a relationship type description+type RelationshipType = T.Text++-- | Relationship direction+data Direction = Outgoing | Incoming | Any++-- | Type for a relationship location+newtype RelUrl = RelUrl {runRelUrl :: T.Text} deriving (Show, Eq, Generic)+instance Hashable RelUrl++-- | Type for a Neo4j relationship, has a location URI, a relationship type, a starting node and a destination node+data Relationship = Relationship {relPath :: RelPath,+                                  relType :: RelationshipType,+                                  relProperties :: Properties,+                                  relFrom :: NodePath,+                                  relTo :: NodePath} deriving (Show, Eq)++-- | Get the properties of a relationship+getRelProperties :: Relationship -> Properties+getRelProperties = relProperties++-- | Get the type of a relationship+getRelType :: Relationship -> RelationshipType+getRelType = relType++-- | JSON to Relationship+instance J.FromJSON Relationship where+    parseJSON (J.Object v) = Relationship <$> (getRelPath . RelUrl <$> v .: "self") <*> v .: "type" <*>+                                (v .: "data" >>= J.parseJSON) <*> (getNodePath . NodeUrl <$> v .: "start") <*>+                                (getNodePath . NodeUrl <$> v .: "end")+    parseJSON _ = mzero++instance Entity Relationship where+    entityPath = runRelIdentifier+    propertyPath r = runRelIdentifier r <> "/properties"+    getEntityProperties = relProperties+    setEntityProperties r props = r {relProperties = props}+    entityObj = EntityRel++instance Entity EntityObj where+    entityPath (EntityNode n) = runNodeIdentifier n+    entityPath (EntityRel n) = runRelIdentifier n+    propertyPath (EntityNode n) = runNodeIdentifier n <> "/properties"+    propertyPath (EntityRel n) = runRelIdentifier n <> "/properties"+    getEntityProperties (EntityNode n) = nodeProperties n+    getEntityProperties (EntityRel n) = relProperties n+    setEntityProperties (EntityNode n) props = EntityNode $ n {nodeProperties = props}+    setEntityProperties (EntityRel n) props = EntityRel $ n {relProperties = props}+    entityObj = id++relationshipAPI :: S.ByteString+relationshipAPI = "/db/data/relationship"++relationshipAPITxt :: T.Text+relationshipAPITxt = "/db/data/relationship"++newtype RelPath = RelPath {runRelPath :: T.Text} deriving (Show, Eq, Generic)+instance Hashable RelPath++class RelIdentifier a where+    getRelPath :: a -> RelPath++instance RelIdentifier Relationship where+    getRelPath = relPath++instance RelIdentifier RelPath where+    getRelPath = id++instance RelIdentifier S.ByteString where+    getRelPath t = RelPath $ TE.decodeUtf8 $ relationshipAPI <> "/" <> t++instance RelIdentifier RelUrl where+    getRelPath = RelPath . urlPath . runRelUrl++instance RelIdentifier Integer where+    getRelPath n = RelPath $ relationshipAPITxt <> "/" <> (fromString . show) n++runRelIdentifier :: RelIdentifier a => a -> S.ByteString+runRelIdentifier = TE.encodeUtf8 . runRelPath . getRelPath++data EntityPath = EntityRelPath RelPath | EntityNodePath NodePath deriving (Show, Eq)++class EntityIdentifier a where+    getEntityPath :: a -> EntityPath++instance EntityIdentifier Node where+    getEntityPath = EntityNodePath . getNodePath++instance EntityIdentifier NodePath where+    getEntityPath = EntityNodePath . getNodePath++instance EntityIdentifier NodeUrl where+    getEntityPath = EntityNodePath . getNodePath++instance EntityIdentifier Relationship where+    getEntityPath = EntityRelPath . getRelPath++instance EntityIdentifier RelPath where+    getEntityPath = EntityRelPath . getRelPath++instance EntityIdentifier RelUrl where+    getEntityPath = EntityRelPath . getRelPath++instance EntityIdentifier T.Text where+    getEntityPath i = (if T.count "/node" p > 0 then EntityNodePath . NodePath else EntityRelPath . RelPath) p+        where p = urlPath i++-- | Type for a label+type Label = T.Text++-- | Type for an index+data Index = Index {indexLabel :: Label, indexProperties :: [T.Text]} deriving (Show, Eq)++-- | JSON to Index+instance J.FromJSON Index where+    parseJSON (J.Object v) = Index <$> v .: "label" <*> (v .: "property_keys" >>= J.parseJSON)+    parseJSON _ = mzero++-- | Exceptions this library can raise+data Neo4jException = Neo4jHttpException String |+                      Neo4jNonOrphanNodeDeletionException S.ByteString |+                      Neo4jNoEntityException S.ByteString |+                      Neo4jUnexpectedResponseException HT.Status |+                      Neo4jNoSuchProperty T.Text |+                      Neo4jBatchException L.ByteString |+                      Neo4jParseException String |+                      TransactionEndedExc deriving (Show, Typeable, Eq)+instance Exception Neo4jException++-- | Type for a connection+data Connection = Connection {dbHostname :: Hostname, dbPort :: Port, manager :: HC.Manager}++type Hostname = S.ByteString+type Port = Int++-- | Neo4j monadic type to be able to sequence neo4j commands in a connection+newtype Neo4j a = Neo4j { runNeo4j :: Connection -> IO a }++instance Monad Neo4j where+    return x = Neo4j (const (return x))+    (Neo4j cmd) >>= f = Neo4j $ \con -> do+                            a <- cmd con+                            runNeo4j (f a) con++instance Functor Neo4j where+    fmap = liftM++instance Applicative Neo4j where+    pure = return+    (<*>) = ap++instance MonadIO Neo4j where+	liftIO f = Neo4j $ const (liftIO f)++instance MonadThrow Neo4j where+    throwM e = Neo4j $ const (throw e)++instance MonadBase (Neo4j) (Neo4j) where+    liftBase = id++--instance MonadTransControl Neo4j where+--    newtype StT Neo4j a = StReader {unStReader :: a}+--    liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r+--    restoreT = ResourceT . const . liftM unStReader++--instance MonadBaseControl b IO => MonadBaseControl b (Neo4j) where+--    newtype StM Neo4j a = StNeo4j a+--    liftBaseWith f = Neo4j $ \conn ->+--         liftBaseWith $ \runInBase ->+--             f $ liftM StNeo4j . runInBase . (\(Neo4j r) -> r conn)+--    restoreM (StNeo4j x) = Neo4j $ const $ restoreM x

@@ -0,0 +1,1591 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}+module Main where++import Control.Monad (void, join)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Monoid (Monoid, mappend)+import Data.Int (Int64)+import Data.Maybe (fromJust)++import qualified Data.Aeson as J+import qualified Data.ByteString as S+import qualified Data.HashMap.Lazy as M+import qualified Data.HashSet as HS+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Vector as V++import Control.Exception (handle)+import Test.Framework.TH (defaultMainGenerator)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit.Base hiding (Test, Node)++import Database.Neo4j+import qualified Database.Neo4j.Batch as B+import qualified Database.Neo4j.Cypher as C+import qualified Database.Neo4j.Graph as G+import qualified Database.Neo4j.Transactional.Cypher as TC++(<>) :: Monoid a => a -> a -> a+(<>) = mappend++-- Get the string of a exception raised by an action+getException :: IO a -> IO (Maybe Neo4jException)+getException action = handle (return . Just) $ do+    _ <- action+    return Nothing++assertException :: Neo4jException -> IO a -> Assertion+assertException exExc action = do+        resExc <- getException action+        checkExc resExc+    where --checkExc :: (Exception e, Show e) => Maybe e -> Assertion+          checkExc Nothing = assertFailure $ "Expected exception " <> show exExc <> " but none raised"+          checkExc (Just e) = assertEqual "" exExc e+    +-- | handy assertEqual inside a Neo4j monad+neo4jEqual :: (Show a, Eq a) => a -> a -> Neo4j ()+neo4jEqual a b = liftIO $ assertEqual "" a b++-- | handy assertBool inside a Neo4j monad+neo4jBool :: Bool -> Neo4j ()+neo4jBool f = liftIO $ assertBool "" f+++main :: IO ()+main = $(defaultMainGenerator)++-- TODO: Is it possible to avoid so many type declarations for literals when constructing properties??+-- | Dummy properties+someProperties :: Properties+someProperties = M.fromList ["mytext" |: ("mytext" :: T.Text),+                             "textarrayprop" |: ["a" :: T.Text, "", "adeu"],+                             "int" |: (-12 :: Int64),+                             "intarray" |: [1 :: Int64, 2],+                             "double" |: (-12.23 :: Double),+                             "doublearray" |: [0.1, -12.23 :: Double],+                             "bool" |: False,+                             "aboolproparray" |: [False, True]+                            ]++-- | Default Neo4j port+port :: Port+port = 7474++-- | Default Neo4j host+host :: Hostname+host = "localhost"++someOtherProperties :: Properties+someOtherProperties = M.fromList ["hola" |: ("adeu" :: T.Text), "proparray" |: ["a" :: T.Text, "", "adeu"]]++anotherProperties :: Properties+anotherProperties = M.empty++myRelType :: T.Text+myRelType = "MYREL"+++-- | Test connecting to a non-existing server+case_NoConnection :: Assertion+case_NoConnection = assertException expException $ withConnection "localhost" 77 $ createNode someProperties+    where expException = Neo4jHttpException "FailedConnectionException2 \"localhost\" 77 False connect: does\+                                             \ not exist (Connection refused)"++-- | Test get and create a node+case_CreateGetDeleteNode :: Assertion+case_CreateGetDeleteNode = withConnection host port $ do+    n <- createNode someProperties+    newN <- getNode n+    neo4jEqual (Just n) newN+    deleteNode n++-- | Test delete and get a node+case_CreateDeleteGetNode :: Assertion+case_CreateDeleteGetNode = withConnection host port $ do+    n <- createNode someProperties+    deleteNode n+    newN <- getNode n+    neo4jEqual Nothing newN++-- | Test double delete+case_DoubleDeleteNode :: Assertion+case_DoubleDeleteNode = withConnection host port $ do+    n <- createNode someProperties+    deleteNode n+    deleteNode n++-- | Test get node by id+case_GetNodeById :: Assertion+case_GetNodeById = withConnection host port $ do+    n <- createNode someProperties+    newN <- getNode (nodeId n)+    neo4jEqual (Just n) newN+    deleteNode n++-- | Test get node with unexisting id+case_GetUnexistingNodeById :: Assertion+case_GetUnexistingNodeById = withConnection host port $ do+    newN <- getNode ("unexistingnode" :: S.ByteString)+    neo4jEqual Nothing newN+        +-- | Test delete node by id+case_DeleteNodeById :: Assertion+case_DeleteNodeById = withConnection host port $ do+    n <- createNode someProperties+    deleteNode (nodeId n)++-- | Test delete unexisting node by id+case_DeleteUnexistingNodeById :: Assertion+case_DeleteUnexistingNodeById = withConnection host port $ deleteNode ("unexistingnode" :: S.ByteString)++-- | Refresh node properties from the DB+case_getNodeProperties :: Assertion+case_getNodeProperties = withConnection host port $ do+    n <- createNode someProperties+    props <- getProperties n+    neo4jEqual someProperties props+    deleteNode n++-- | Get node properties from a deleted node+case_getDeletedNodeProperties :: Assertion+case_getDeletedNodeProperties = do+        n <- withConnection host port $ createNode someProperties+        let expException = Neo4jNoEntityException $ runNodeIdentifier n+        assertException expException $ withConnection host port $ do+            deleteNode n+            getProperties n++-- | Get a property from a node+case_getNodeProperty :: Assertion+case_getNodeProperty = withConnection host port $ do+    n <- createNode someProperties+    prop <- getProperty n "intarray"+    neo4jEqual (M.lookup "intarray" someProperties) prop+    deleteNode n++-- | Get an unexisting property from a node+case_getNodeUnexistingProperty :: Assertion+case_getNodeUnexistingProperty = withConnection host port $ do+    n <- createNode someProperties+    prop <- getProperty n "noproperty"+    neo4jEqual Nothing prop+    deleteNode n++-- | Get a property from an unexisting node+case_getUnexistingNodeProperty :: Assertion+case_getUnexistingNodeProperty = do+    n <- withConnection host port $ createNode someProperties+    let expException = Neo4jNoEntityException $ runNodeIdentifier n+    assertException expException $ withConnection host port $ do+        deleteNode n+        _ <- getProperty n "noproperty"+        return ()++-- | Get change the properties of a node+case_changeNodeProperties :: Assertion+case_changeNodeProperties = withConnection host port $ do+        n <- createNode someProperties+        newN <- setProperties n otherProperties+        neo4jEqual otherProperties (getNodeProperties newN)+        renewN <- getNode n+        neo4jEqual otherProperties (getNodeProperties $ fromJust renewN)+        deleteNode newN+    where otherProperties = M.insert "newbool" (newval True) someProperties++-- | Get change the properties of a node that doesn't exist+case_changeUnexistingNodeProperties :: Assertion+case_changeUnexistingNodeProperties = do+    n <- withConnection host port $ createNode someProperties+    let expException = Neo4jNoEntityException $ runNodeIdentifier n+    assertException expException $ withConnection host port $ do+        deleteNode n+        setProperties n someProperties++-- | Change a property of a node+case_changeNodeProperty :: Assertion+case_changeNodeProperty = withConnection host port $ do+        n <- createNode someProperties+        newN <- setProperty n otherValName otherVal+        neo4jEqual otherProperties (getNodeProperties newN)+        renewN <- getNode n+        neo4jEqual otherProperties (getNodeProperties $ fromJust renewN)+        deleteNode newN+    where otherProperties = M.insert otherValName otherVal someProperties+          otherValName = "int"+          otherVal = newval False++-- | Change an array property of a node to empty+case_changeNodePropertyToEmpty :: Assertion+case_changeNodePropertyToEmpty = withConnection host port $ do+        n <- createNode someProperties+        newN <- setProperty n otherValName otherVal+        neo4jEqual otherProperties (getNodeProperties newN)+        renewN <- getNode n+        neo4jEqual otherProperties (getNodeProperties $ fromJust renewN)+        deleteNode newN+    where otherProperties = M.insert otherValName otherVal someProperties+          otherValName = "intarray"+          otherVal = newval ([] :: [Int64])++-- | Set an unexisting property of a node+case_changeNodeUnexistingProperty :: Assertion+case_changeNodeUnexistingProperty = withConnection host port $ do+        n <- createNode someProperties+        newN <- setProperty n otherValName otherVal+        neo4jEqual otherProperties (getNodeProperties newN)+        renewN <- getNode n+        neo4jEqual otherProperties (getNodeProperties $ fromJust renewN)+        deleteNode newN+    where otherProperties = M.insert otherValName otherVal someProperties+          otherValName = "mynewbool"+          otherVal = newval False++-- | Set property of an unexisting node+case_changeUnexistingNodeProperty :: Assertion+case_changeUnexistingNodeProperty = do+    n <- withConnection host port $ createNode someProperties+    let expException = Neo4jNoEntityException $ runNodeIdentifier n+    assertException expException $ withConnection host port $ do+        deleteNode n+        _ <- setProperty n otherValName otherVal+        return ()+    where otherValName = "mynewbool"+          otherVal = newval False++-- | Delete node properties+case_deleteNodeProperties :: Assertion+case_deleteNodeProperties = withConnection host port $ do+    n <- createNode someProperties+    newN <- deleteProperties n+    neo4jEqual M.empty (getNodeProperties newN)+    renewN <- getNode n+    neo4jEqual M.empty (getNodeProperties $ fromJust renewN)+    deleteNode newN++-- | Delete unexisting node properties+case_deleteUnexistingNodeProperties :: Assertion+case_deleteUnexistingNodeProperties = do+    n <- withConnection host port $ createNode someProperties+    let expException = Neo4jNoEntityException $ runNodeIdentifier n+    assertException expException $ withConnection host port $ do+        deleteNode n+        _ <- deleteProperties n+        return ()++-- | Delete a node property+case_deleteNodeProperty :: Assertion+case_deleteNodeProperty = withConnection host port $ do+        n <- createNode someProperties+        newN <- deleteProperty n valName+        neo4jEqual otherProperties (getNodeProperties newN)+        renewN <- getNode n+        neo4jEqual otherProperties (getNodeProperties $ fromJust renewN)+        deleteNode newN+    where otherProperties = M.delete valName someProperties+          valName = "int"++-- | Delete an unexisting property from a node+case_deleteNodeUnexistingProperty :: Assertion+case_deleteNodeUnexistingProperty = withConnection host port $ do+        n <- createNode someProperties+        newN <- deleteProperty n valName+        neo4jEqual otherProperties (getNodeProperties newN)+        renewN <- getNode n+        neo4jEqual otherProperties (getNodeProperties $ fromJust renewN)+        deleteNode newN+    where otherProperties = M.delete valName someProperties+          valName = "noproperty"++-- | Delete a property from an unexisting node+case_deleteUnexistingNodeProperty :: Assertion+case_deleteUnexistingNodeProperty = do+    n <- withConnection host port $ createNode someProperties+    let expException = Neo4jNoEntityException $ runNodeIdentifier n+    assertException expException $ withConnection host port $ do+        deleteNode n+        _ <- deleteProperty n valName+        return ()+    where valName = "noproperty"++setupRelTests :: Neo4j (Node, Node, Relationship)+setupRelTests = do+    nodeFrom <- createNode anotherProperties+    nodeTo <- createNode someOtherProperties+    r <- createRelationship myRelType someProperties nodeFrom nodeTo+    return (nodeFrom, nodeTo, r)++teardownRelTests :: Node -> Node -> Relationship -> Neo4j()+teardownRelTests f t r = do+    deleteRelationship r+    deleteNode f+    deleteNode t++-- | Delete a node with a relationship+case_deleteNodeWithRelationship :: Assertion+case_deleteNodeWithRelationship = do+    (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+    let expException = Neo4jNonOrphanNodeDeletionException $ runNodeIdentifier nodeFrom+    assertException expException $ withConnection host port $ deleteNode nodeFrom+    withConnection host port $ teardownRelTests nodeFrom nodeTo r+    +-- | Test get and create a relationship+case_CreateGetDeleteRelationship :: Assertion+case_CreateGetDeleteRelationship = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    newN <- getRelationship r+    neo4jEqual (Just r) newN+    teardownRelTests nodeFrom nodeTo r++-- | Test get all relationship properties+case_allRelationshipProperties :: Assertion+case_allRelationshipProperties = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    rs <- allRelationshipTypes+    neo4jBool $ myRelType `elem` rs+    teardownRelTests nodeFrom nodeTo r++-- | Test get the start and end of a relationship+case_relationshipFromTo :: Assertion+case_relationshipFromTo = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    nfrom <- getRelationshipFrom r+    neo4jEqual nodeFrom nfrom+    nto <- getRelationshipTo r+    neo4jEqual nodeTo nto+    teardownRelTests nodeFrom nodeTo r++-- | Test get the start of relationship that doesn't exist any more+case_nonExistingRelationshipFrom :: Assertion+case_nonExistingRelationshipFrom = do+    (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+    let expException = Neo4jNoEntityException $ runNodeIdentifier nodeFrom+    assertException expException $ withConnection host port $ do+        deleteRelationship r+        deleteNode nodeFrom+        n <- getRelationshipFrom r+        neo4jEqual nodeFrom n -- Doing this to force the evaluation of n (the exception is thrown after parsing)+        return ()+    withConnection host port $ teardownRelTests nodeFrom nodeTo r++-- | Test get the end of relationship that doesn't exist any more+case_nonExistingRelationshipTo :: Assertion+case_nonExistingRelationshipTo = do+    (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+    let expException = Neo4jNoEntityException $ runNodeIdentifier nodeTo+    assertException expException $ withConnection host port $ do+        deleteRelationship r+        deleteNode nodeTo+        n <- getRelationshipTo r+        neo4jEqual nodeTo n -- Doing this to force the evaluation of n (the exception is thrown after parsing)+        return ()+    withConnection host port $ teardownRelTests nodeFrom nodeTo r++-- | Create relationship with missing node from+case_CreateRelationshipMissingFrom :: Assertion+case_CreateRelationshipMissingFrom = do+    (nodeFrom, nodeTo) <- withConnection host port $ do+        nodeFrom <- createNode anotherProperties+        nodeTo <- createNode someOtherProperties+        return (nodeFrom, nodeTo)+    let expException = Neo4jNoEntityException $ runNodeIdentifier nodeFrom+    assertException expException $ withConnection host port $ do+        deleteNode nodeFrom+        _ <- createRelationship myRelType someProperties nodeFrom nodeTo+        return ()+    withConnection host port $ deleteNode nodeTo++-- | Create relationship with missing node to+case_CreateRelationshipMissingTo :: Assertion+case_CreateRelationshipMissingTo = do+    (nodeFrom, nodeTo) <- withConnection host port $ do+        nodeFrom <- createNode anotherProperties+        nodeTo <- createNode someOtherProperties+        return (nodeFrom, nodeTo)+    let expException = Neo4jNoEntityException $ runNodeIdentifier nodeTo+    assertException expException $ withConnection host port $ do+        deleteNode nodeTo +        _ <- createRelationship myRelType someProperties nodeFrom nodeTo+        return ()+    withConnection host port $ deleteNode nodeFrom++-- | Test delete and get a relationship+case_CreateDeleteGetRelationship :: Assertion+case_CreateDeleteGetRelationship = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    deleteRelationship r+    newN <- getRelationship r+    neo4jEqual Nothing newN+    teardownRelTests nodeFrom nodeTo r++-- | Test double delete+case_DoubleDeleteRelationship :: Assertion+case_DoubleDeleteRelationship = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    deleteRelationship r+    deleteRelationship r+    teardownRelTests nodeFrom nodeTo r++-- | Test get relationship by id+case_GetRelationshipById :: Assertion+case_GetRelationshipById = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    newN <- getRelationship (relId r)+    neo4jEqual (Just r) newN+    teardownRelTests nodeFrom nodeTo r++-- | Test get relationship with unexisting id+case_GetUnexistingRelationshipById :: Assertion+case_GetUnexistingRelationshipById = withConnection host port $ do+    newN <- getRelationship ("unexistingrelationship" :: S.ByteString)+    neo4jEqual Nothing newN+        +-- | Test delete relationship by id+case_DeleteRelationshipById :: Assertion+case_DeleteRelationshipById = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    deleteRelationship (relId r)+    teardownRelTests nodeFrom nodeTo r++-- | Test delete unexisting relationship by id+case_DeleteUnexistingRelationshipById :: Assertion+case_DeleteUnexistingRelationshipById = withConnection host port $ +        deleteRelationship ("unexistingrelationship" :: S.ByteString)++-- | Refresh relationship properties from the DB+case_getRelationshipProperties :: Assertion+case_getRelationshipProperties = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    props <- getProperties r+    neo4jEqual someProperties props+    teardownRelTests nodeFrom nodeTo r++-- | Get relationship properties from a deleted node+case_getDeletedRelationshipProperties :: Assertion+case_getDeletedRelationshipProperties = do+    (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+    let expException = Neo4jNoEntityException $ runRelIdentifier r+    assertException expException $ withConnection host port $ do+        deleteRelationship r+        deleteNode nodeFrom+        deleteNode nodeTo+        getProperties r++-- | Get a property from a relationship+case_getRelationshipProperty :: Assertion+case_getRelationshipProperty = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    prop <- getProperty r "intarray"+    neo4jEqual (M.lookup "intarray" someProperties) prop+    teardownRelTests nodeFrom nodeTo r++-- | Get an unexisting property from a relationship+case_getRelationshipUnexistingProperty :: Assertion+case_getRelationshipUnexistingProperty = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    prop <- getProperty r "noproperty"+    neo4jEqual Nothing prop+    teardownRelTests nodeFrom nodeTo r++-- | Get a property from an unexisting relationship+case_getUnexistingRelationshipProperty :: Assertion+case_getUnexistingRelationshipProperty = do+    (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+    let expException = Neo4jNoEntityException $ runRelIdentifier r+    assertException expException $ withConnection host port $ do+        teardownRelTests nodeFrom nodeTo r+        _ <- getProperty r "noproperty"+        return ()++-- | Get change the properties of a relationship+case_changeRelationshipProperties :: Assertion+case_changeRelationshipProperties = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        newN <- setProperties r otherProperties+        neo4jEqual otherProperties (getRelProperties newN)+        renewN <- getRelationship r+        neo4jEqual otherProperties (getRelProperties $ fromJust renewN)+        teardownRelTests nodeFrom nodeTo newN+    where otherProperties = M.insert "newbool" (newval True) someProperties++-- | Get change the properties of a relationship that doesn't exist+case_changeUnexistingRelationshipProperties :: Assertion+case_changeUnexistingRelationshipProperties = do+    (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+    let expException = Neo4jNoEntityException $ runRelIdentifier r+    assertException expException $ withConnection host port $ do+        deleteRelationship r+        deleteNode nodeFrom+        deleteNode nodeTo+        setProperties r someProperties++-- | Change a property of a relationship+case_changeRelationshipProperty :: Assertion+case_changeRelationshipProperty = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        newN <- setProperty r otherValName otherVal+        neo4jEqual otherProperties (getRelProperties newN)+        renewN <- getRelationship r+        neo4jEqual otherProperties (getRelProperties $ fromJust renewN)+        teardownRelTests nodeFrom nodeTo newN+    where otherProperties = M.insert otherValName otherVal someProperties+          otherValName = "int"+          otherVal = newval False++-- | Change an array property of a relationship to empty+case_changeRelationshipPropertyToEmpty :: Assertion+case_changeRelationshipPropertyToEmpty = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        newN <- setProperty r otherValName otherVal+        neo4jEqual otherProperties (getRelProperties newN)+        renewN <- getRelationship r+        neo4jEqual otherProperties (getRelProperties $ fromJust renewN)+        teardownRelTests nodeFrom nodeTo newN+    where otherProperties = M.insert otherValName otherVal someProperties+          otherValName = "intarray"+          otherVal = newval ([] :: [Int64])++-- | Set an unexisting property of a relationship+case_changeRelationshipUnexistingProperty :: Assertion+case_changeRelationshipUnexistingProperty = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        newN <- setProperty r otherValName otherVal+        neo4jEqual otherProperties (getRelProperties newN)+        renewN <- getRelationship r+        neo4jEqual otherProperties (getRelProperties $ fromJust renewN)+        teardownRelTests nodeFrom nodeTo newN+    where otherProperties = M.insert otherValName otherVal someProperties+          otherValName = "mynewbool"+          otherVal = newval False++-- | Set property of an unexisting node+case_changeUnexistingRelationshipProperty :: Assertion+case_changeUnexistingRelationshipProperty = do+    (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+    let expException = Neo4jNoEntityException $ runRelIdentifier r+    assertException expException $ withConnection host port $ do+        deleteRelationship r+        _ <- setProperty r otherValName otherVal+        return ()+    withConnection host port $ teardownRelTests nodeFrom nodeTo r+    where otherValName = "mynewbool"+          otherVal = newval False++-- | Delete relationship properties+case_deleteRelationshipProperties :: Assertion+case_deleteRelationshipProperties = withConnection host port $ do+    (nodeFrom, nodeTo, r) <- setupRelTests+    newN <- deleteProperties r+    neo4jEqual M.empty (getRelProperties newN)+    renewN <- getRelationship r+    neo4jEqual M.empty (getRelProperties $ fromJust renewN)+    teardownRelTests nodeFrom nodeTo newN++-- | Delete unexisting relationship properties+case_deleteUnexistingRelationshipProperties :: Assertion+case_deleteUnexistingRelationshipProperties = do+    (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+    let expException = Neo4jNoEntityException $ runRelIdentifier r +    assertException expException $ withConnection host port $ do+        deleteRelationship r+        _ <- deleteProperties r+        return ()+    withConnection host port $ teardownRelTests nodeFrom nodeTo r++-- | Delete a relationship property+case_deleteRelationshipProperty :: Assertion+case_deleteRelationshipProperty = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        newN <- deleteProperty r valName+        neo4jEqual otherProperties (getRelProperties newN)+        renewN <- getRelationship r+        neo4jEqual otherProperties (getRelProperties $ fromJust renewN)+        teardownRelTests nodeFrom nodeTo newN+    where otherProperties = M.delete valName someProperties+          valName = "int"++-- | Delete an unexisting property from a relationship+case_deleteRelationshipUnexistingProperty :: Assertion+case_deleteRelationshipUnexistingProperty = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        newN <- deleteProperty r valName+        neo4jEqual otherProperties (getRelProperties newN)+        renewN <- getRelationship r+        neo4jEqual otherProperties (getRelProperties $ fromJust renewN)+        teardownRelTests nodeFrom nodeTo newN+    where otherProperties = M.delete valName someProperties+          valName = "noproperty"++-- | Delete a property from an unexisting relationship+case_deleteUnexistingRelationshipProperty :: Assertion+case_deleteUnexistingRelationshipProperty = do+        (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+        let expException = Neo4jNoEntityException $ runRelIdentifier r +        assertException expException $ withConnection host port $ do+            deleteRelationship r+            _ <- deleteProperty r valName+            return ()+        withConnection host port $ teardownRelTests nodeFrom nodeTo r+    where valName = "noproperty"++-- | Get relationships for a node+case_GetNodeRelationships :: Assertion+case_GetNodeRelationships = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        -- test getting relationships for the origin node+        rsAny <- getRelationships nodeFrom Any []+        neo4jEqual [r] rsAny+        rsOutgoing <- getRelationships nodeFrom Outgoing []+        neo4jEqual [r] rsOutgoing+        rsIncoming <- getRelationships nodeFrom Incoming []+        neo4jEqual [] rsIncoming+        -- test getting relationships for the destination node+        rsAnyTo <- getRelationships nodeTo Any []+        neo4jEqual [r] rsAnyTo+        rsOutgoingTo <- getRelationships nodeTo Outgoing []+        neo4jEqual [] rsOutgoingTo+        rsIncomingTo <- getRelationships nodeTo Incoming []+        neo4jEqual [r] rsIncomingTo+        teardownRelTests nodeFrom nodeTo r++-- | Get relationships for an unexisting node+case_GetUnexistingNodeRelationships :: Assertion+case_GetUnexistingNodeRelationships = do+        (nodeFrom, nodeTo, r) <- withConnection host port setupRelTests+        let expException = Neo4jNoEntityException $ runNodeIdentifier nodeFrom+        assertException expException $ withConnection host port $ do+            teardownRelTests nodeFrom nodeTo r+            _ <- getRelationships nodeFrom Any []+            return ()++-- | Get relationships for a node with multiple relationships+case_GetNodeRelationshipsMultiple :: Assertion+case_GetNodeRelationshipsMultiple = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        r2 <- createRelationship myRelType someOtherProperties nodeTo nodeFrom+        rsAny <- getRelationships nodeFrom Any []+        neo4jBool (r `elem` rsAny)+        neo4jBool (r2 `elem` rsAny)+        neo4jEqual 2 (length rsAny)+        rsOutgoing <- getRelationships nodeFrom Outgoing []+        neo4jEqual [r] rsOutgoing+        rsIncoming <- getRelationships nodeFrom Incoming []+        neo4jEqual [r2] rsIncoming+        deleteRelationship r2+        teardownRelTests nodeFrom nodeTo r++-- | Get relationships for a node with a type filter+case_GetNodeRelationshipsWithType :: Assertion+case_GetNodeRelationshipsWithType = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        rsAny <- getRelationships nodeFrom Any [myRelType]+        neo4jEqual [r] rsAny+        teardownRelTests nodeFrom nodeTo r++-- | Get relationships for a node with an unexisting type filter+case_GetNodeRelationshipsWithUnexistingType :: Assertion+case_GetNodeRelationshipsWithUnexistingType = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        rsAny <- getRelationships nodeFrom Any ["notype"]+        neo4jEqual [] rsAny+        teardownRelTests nodeFrom nodeTo r++-- | Get relationships for a node with a type filter with multiple elements+case_GetNodeRelationshipsWithTypes :: Assertion+case_GetNodeRelationshipsWithTypes = withConnection host port $ do+        (nodeFrom, nodeTo, r) <- setupRelTests+        -- Create another relationship with another type+        r2 <- createRelationship type2 anotherProperties nodeTo nodeFrom+        rsAny <- getRelationships nodeFrom Any [myRelType, type2, "notype"]+        neo4jBool (r `elem` rsAny)+        neo4jBool (r2 `elem` rsAny)+        neo4jEqual 2 (length rsAny)+        deleteRelationship r2+        teardownRelTests nodeFrom nodeTo r+    where type2 = "reltype2"++-- | Get all labels in the DB (We don't have control of all the labels the DB has)+case_getLabels :: Assertion+case_getLabels = withConnection host port $ do+        n <- createNode someProperties+        addLabels [lbl] n+        lbls <- allLabels+        neo4jBool $ lbl `elem` lbls+        deleteNode n+    where lbl = "label1"++-- | Get labels for a node it doesn't have any+case_getNodeLabelsWithNone :: Assertion+case_getNodeLabelsWithNone = withConnection host port $ do+    n <- createNode someProperties+    lbls <- getLabels n+    neo4jEqual [] lbls+    deleteNode n++-- | Get labels for an unexisting node+case_getUnexistingNodeLabels :: Assertion+case_getUnexistingNodeLabels = do+    n <- withConnection host port $ createNode someProperties+    let expException = Neo4jNoEntityException $ runNodeIdentifier n+    assertException expException $ withConnection host port $ do+        deleteNode n+        _ <- getLabels n+        return ()++-- | Add labels to a node and get them+case_getAddAndGetNodeLabels :: Assertion+case_getAddAndGetNodeLabels = withConnection host port $ do+        n <- createNode someProperties+        addLabels [lbl1, lbl2] n+        addLabels [lbl3] n+        lbls <- getLabels n+        neo4jEqual 3 (length lbls)+        neo4jBool $ all (`elem` lbls) [lbl1, lbl2, lbl3]+        deleteNode n+    where lbl1 = "mylabel1"+          lbl2 = "mylabel2"+          lbl3 = "mylabel3"++-- | Add labels to an unexisting node+case_addUnexistingNodeLabels :: Assertion+case_addUnexistingNodeLabels = do +    n <- withConnection host port $ createNode someProperties+    let expException = Neo4jNoEntityException $ runNodeIdentifier n+    assertException expException $ withConnection host port $ do+        deleteNode n+        addLabels ["mylabel"] n++-- | Change node labels+case_changeNodeLabels :: Assertion+case_changeNodeLabels = withConnection host port $ do+        n <- createNode someProperties+        addLabels [lbl1, lbl2] n+        changeLabels [lbl3] n+        lbls <- getLabels n+        neo4jEqual [lbl3] lbls+        deleteNode n+    where lbl1 = "mylabel1"+          lbl2 = "mylabel2"+          lbl3 = "otherlabel"++-- | Change node labels to empty+case_changeNodeLabelsToEmpty :: Assertion+case_changeNodeLabelsToEmpty = withConnection host port $ do+        n <- createNode someProperties+        addLabels [lbl1, lbl2] n+        changeLabels [] n+        lbls <- getLabels n+        neo4jEqual [] lbls+        deleteNode n+    where lbl1 = "mylabel1"+          lbl2 = "mylabel2"++-- | Change labels for an unexisting node+case_changeUnexistingNodeLabels :: Assertion+case_changeUnexistingNodeLabels = do +    n <- withConnection host port $ createNode someProperties+    let expException = Neo4jNoEntityException $ runNodeIdentifier n+    assertException expException $ withConnection host port $ do+        deleteNode n+        changeLabels ["mylabel"] n++-- | Remove a label from a node+case_removeNodeLabel :: Assertion+case_removeNodeLabel = withConnection host port $ do+        n <- createNode someProperties+        addLabels [lbl1, lbl2] n+        removeLabel lbl1 n+        lbls <- getLabels n+        neo4jEqual [lbl2] lbls+        deleteNode n+    where lbl1 = "mylabel1"+          lbl2 = "mylabel2"++-- | Remove an unexisting label from a node (nothing should happen)+case_removeNodeUnexistingLabel :: Assertion+case_removeNodeUnexistingLabel = withConnection host port $ do+        n <- createNode someProperties+        addLabels [lbl1] n+        removeLabel "nolabel" n+        lbls <- getLabels n+        neo4jEqual [lbl1] lbls+        deleteNode n+    where lbl1 = "mylabel1"++-- | Remove label for an unexisting node+case_removeUnexistingNodeLabel :: Assertion+case_removeUnexistingNodeLabel = do +    n <- withConnection host port $ createNode someProperties+    let expException = Neo4jNoEntityException $ runNodeIdentifier n+    assertException expException $ withConnection host port $ do+        deleteNode n+        removeLabel "mylabel" n++-- | Get all nodes with a label+case_allNodesWithLabel :: Assertion+case_allNodesWithLabel = withConnection host port $ do+        n1 <- createNode someProperties+        n2 <- createNode someProperties+        n3 <- createNode someProperties+        addLabels [lbl1, lbl2] n1+        addLabels [lbl2] n2+        addLabels [lbl1] n3+        ns <- getNodesByLabelAndProperty lbl1 Nothing+        neo4jEqual 2 (length ns)+        neo4jBool $ all (`elem` ns) [n1, n3]+        ns2 <- getNodesByLabelAndProperty "nolbl" Nothing+        neo4jEqual [] ns2+        mapM_ deleteNode [n1, n2, n3]+    where lbl1 = "lbl1"+          lbl2 = "lbl2"++-- | Get all nodes with a label and a property+case_allNodesWithLabelAndProperty :: Assertion+case_allNodesWithLabelAndProperty = withConnection host port $ do+        n1 <- createNode someProperties+        n2 <- createNode someProperties+        n3 <- createNode anotherProperties+        addLabels [lbl1, lbl2] n1+        addLabels [lbl2] n2+        addLabels [lbl1] n3+        ns <- getNodesByLabelAndProperty lbl1 $ Just ("doublearray", newval [0.1, -12.23 :: Double])+        neo4jEqual [n1] ns+        ns2 <- getNodesByLabelAndProperty lbl1 $ Just ("doublearray", newval [0.1, -12.22 :: Double])+        neo4jEqual [] ns2+        mapM_ deleteNode [n1, n2, n3]+    where lbl1 = "lbl1"+          lbl2 = "lbl2"++-- | Create, get and destroy index+case_createGetDropIndex :: Assertion+case_createGetDropIndex = withConnection host port $ do+        dropIndex lbl prop1+        dropIndex lbl prop2+        dropIndex lbl2 prop1+        dropIndex lbl2 prop2+        idx1 <- createIndex lbl prop1+        idx2 <- createIndex lbl prop2+        idx3 <- createIndex lbl2 prop1+        idx4 <- createIndex lbl2 prop2+        idxs <- getIndexes lbl+        neo4jBool $ all (`elem` idxs) [idx1, idx2]+        neo4jBool $ all (not . (`elem` idxs)) [idx3, idx4]+        idxs2 <- getIndexes lbl2+        neo4jBool $ all (not . (`elem` idxs2)) [idx1, idx2]+        neo4jBool $ all (`elem` idxs2) [idx3, idx4]+        dropIndex lbl prop1+        dropIndex lbl prop2+        dropIndex lbl2 prop1+        dropIndex lbl2 prop2+        idxs3 <- getIndexes lbl+        idxs4 <- getIndexes lbl2+        neo4jBool $ all (not . (`elem` idxs3)) [idx1, idx2]+        neo4jBool $ all (not . (`elem` idxs4)) [idx3, idx4]+    where lbl = "mylabel11"+          lbl2 = "mylabel2"+          prop1 = "myprop"+          prop2 = "myprop2"++-- | Test batch, create a node and get it again+case_batchCreateGetNode :: Assertion+case_batchCreateGetNode = withConnection host port $ do+                g <- B.runBatch $ do+                        n <- B.createNode someProperties+                        B.getNode n+                neo4jEqual 1 (length $ G.getNodes g)+                neo4jBool $ someProperties `elem` map getNodeProperties (G.getNodes g)+                deleteNode (head $ G.getNodes g)++-- | Test batch, create two nodes in a batch+case_batchCreate2Nodes :: Assertion+case_batchCreate2Nodes = withConnection host port $ do+                g <- B.runBatch $ do+                        _ <- B.createNode someProperties+                        B.createNode anotherProperties+                neo4jEqual 2 (length $ G.getNodes g)+                neo4jBool $ someProperties `elem` map getNodeProperties (G.getNodes g)+                neo4jBool $ anotherProperties `elem` map getNodeProperties (G.getNodes g)+                mapM_ deleteNode (G.getNodes g)++-- | Test batch, create and delete+case_batchCreateDeleteNode :: Assertion+case_batchCreateDeleteNode = withConnection host port $ do+                g <- B.runBatch $ do+                        n <- B.createNode someProperties+                        B.deleteNode n+                neo4jEqual 0 (length $ G.getNodes g)++-- | Test batch, create two nodes and two relationships between them+case_batchCreateRelationships :: Assertion+case_batchCreateRelationships = withConnection host port $ do+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    _ <- B.createRelationship "type1" someOtherProperties n1 n2+                    B.createRelationship "type2" someProperties n2 n1+                neo4jEqual 2 (length $ G.getNodes g)+                neo4jEqual 2 (length $ G.getRelationships g)+                neo4jBool $ someOtherProperties `elem` map getRelProperties (G.getRelationships g)+                neo4jBool $ someProperties `elem` map getRelProperties (G.getRelationships g)+                neo4jBool $ "type1" `elem` map getRelType (G.getRelationships g)+                neo4jBool $ "type2" `elem` map getRelType (G.getRelationships g)+                let r1 : r2 : [] = G.getRelationships g+                neo4jEqual (G.getRelationshipNodeFrom r1 g) (G.getRelationshipNodeTo r2 g)+                neo4jEqual (G.getRelationshipNodeFrom r2 g) (G.getRelationshipNodeTo r1 g)+                _ <- B.runBatch $ do+                    mapM_ B.deleteRelationship (G.getRelationships g)+                    mapM_ B.deleteNode (G.getNodes g)+                return ()++-- | Test batch, create and delete a relationship+case_batchCreateDelRelationships :: Assertion+case_batchCreateDelRelationships = withConnection host port $ do+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    r <- B.createRelationship "type1" someOtherProperties n1 n2+                    B.deleteRelationship r+                neo4jEqual 2 (length $ G.getNodes g)+                neo4jEqual 0 (length $ G.getRelationships g)+                mapM_ deleteRelationship (G.getRelationships g)+                mapM_ deleteNode (G.getNodes g)++-- | Test batch getRelationshipFrom+case_batchRelationshipNodeFrom :: Assertion+case_batchRelationshipNodeFrom = withConnection host port $ do+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    B.createRelationship "type1" someOtherProperties n1 n2+                g2 <- B.runBatch $ B.getRelationshipFrom (head $ G.getRelationships g)+                neo4jEqual 1 (length $ G.getNodes g2)+                neo4jEqual 0 (length $ G.getRelationships g2)+                neo4jBool $ someProperties `elem` map getNodeProperties (G.getNodes g2)+                _ <- B.runBatch $ do+                    mapM_ B.deleteRelationship (G.getRelationships g)+                    mapM_ B.deleteNode (G.getNodes g)+                return ()++-- | Test batch getRelationshipTo+case_batchRelationshipNodeTo :: Assertion+case_batchRelationshipNodeTo = withConnection host port $ do+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    B.createRelationship "type1" someOtherProperties n1 n2+                g2 <- B.runBatch $ B.getRelationshipTo (head $ G.getRelationships g)+                neo4jEqual 1 (length $ G.getNodes g2)+                neo4jEqual 0 (length $ G.getRelationships g2)+                neo4jBool $ anotherProperties `elem` map getNodeProperties (G.getNodes g2)+                _ <- B.runBatch $ do+                    mapM_ B.deleteRelationship (G.getRelationships g)+                    mapM_ B.deleteNode (G.getNodes g)+                return ()++-- | Test batch, get all relationships with filter+case_batchGetRelationships :: Assertion+case_batchGetRelationships = withConnection host port $ do+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    _ <- B.createRelationship "type1" someOtherProperties n1 n2+                    B.createRelationship "type2" someProperties n2 n1+                g2 <- B.runBatch $ do+                    let n = head $ G.getNodes g+                    B.getRelationships n Any ["type1", "type2"]+                neo4jEqual 2 (length $ G.getRelationships g2)+                neo4jBool $ someOtherProperties `elem` map getRelProperties (G.getRelationships g2)+                neo4jBool $ someProperties `elem` map getRelProperties (G.getRelationships g2)+                neo4jBool $ "type1" `elem` map getRelType (G.getRelationships g2)+                neo4jBool $ "type2" `elem` map getRelType (G.getRelationships g2)+                mapM_ deleteRelationship (G.getRelationships g)+                mapM_ deleteNode (G.getNodes g)++-- | Test batch, set properties+case_batchSetProperties :: Assertion+case_batchSetProperties = withConnection host port $ do+                let newProperties = M.fromList ["croqueta" |: ("2" :: T.Text)]+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    r <- B.createRelationship "type1" someOtherProperties n1 n2+                    _ <- B.setProperties n1 newProperties+                    B.setProperties r newProperties+                neo4jEqual 2 (length $ G.getNodes g)+                neo4jEqual 1 (length $ G.getRelationships g)+                neo4jBool $ newProperties `elem` map getRelProperties (G.getRelationships g)+                neo4jBool $ newProperties `elem` map getNodeProperties (G.getNodes g)+                _ <- B.runBatch $ do+                    mapM_ B.deleteRelationship (G.getRelationships g)+                    mapM_ B.deleteNode (G.getNodes g)+                return ()+++-- | Test batch, set property+case_batchSetProperty :: Assertion+case_batchSetProperty = withConnection host port $ do+                let key = "hola"+                let val = newval False+                let newSomeProperties = M.insert key val someProperties+                let newSomeOtherProperties = M.insert key val someOtherProperties+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    r <- B.createRelationship "type1" someOtherProperties n1 n2+                    _ <- B.setProperty n1 key val+                    B.setProperty r key val+                neo4jEqual 2 (length $ G.getNodes g)+                neo4jEqual 1 (length $ G.getRelationships g)+                neo4jBool $ newSomeProperties `elem` map getNodeProperties (G.getNodes g)+                neo4jBool $ newSomeOtherProperties `elem` map getRelProperties (G.getRelationships g)+                _ <- B.runBatch $ do+                    mapM_ B.deleteRelationship (G.getRelationships g)+                    mapM_ B.deleteNode (G.getNodes g)+                return ()++-- | Test batch, delete properties+case_batchDeleteProperties :: Assertion+case_batchDeleteProperties = withConnection host port $ do+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    r <- B.createRelationship "type1" someOtherProperties n1 n2+                    _ <- B.deleteProperties n1+                    B.deleteProperties r+                neo4jEqual 2 (length $ G.getNodes g)+                neo4jEqual 1 (length $ G.getRelationships g)+                neo4jBool $ emptyProperties `elem` map getRelProperties (G.getRelationships g)+                neo4jBool $ emptyProperties `elem` map getNodeProperties (G.getNodes g)+                _ <- B.runBatch $ do+                    mapM_ B.deleteRelationship (G.getRelationships g)+                    mapM_ B.deleteNode (G.getNodes g)+                return ()++-- | Test batch, delete property+case_batchDeleteProperty :: Assertion+case_batchDeleteProperty= withConnection host port $ do+                let key = "mytext"+                let newSomeProperties = M.delete key someProperties+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    r <- B.createRelationship "type1" someProperties n1 n2+                    _ <- B.deleteProperty n1 key+                    B.deleteProperty r key+                neo4jEqual 2 (length $ G.getNodes g)+                neo4jEqual 1 (length $ G.getRelationships g)+                neo4jBool $ newSomeProperties `elem` map getNodeProperties (G.getNodes g)+                neo4jBool $ newSomeProperties `elem` map getRelProperties (G.getRelationships g)+                _ <- B.runBatch $ do+                    mapM_ B.deleteRelationship (G.getRelationships g)+                    mapM_ B.deleteNode (G.getNodes g)+                return ()++-- | Test batch, delete an unknown property, it should raise an exception+case_batchDeleteUnknownProperty :: Assertion+case_batchDeleteUnknownProperty= do+        n <- withConnection host port $ createNode someProperties+        let excMsg = "Node[" <> TE.decodeUtf8 (nodeId n) <>"] does not have a property \"" <> prop <> "\""+        let expException = Neo4jNoSuchProperty excMsg+        assertException expException $ withConnection host port $ do+                    g <- B.runBatch $ B.deleteProperty n prop+                    neo4jEqual G.empty g -- Doing this to force evaluation+        withConnection host port $ deleteNode n+    where prop = "noprop" :: T.Text++-- | Test batch, set add labels+case_batchAddLabels :: Assertion+case_batchAddLabels = withConnection host port $ do+                let label1 = "label1"+                let label2 = "label2"+                let label3 = "label3"+                let labelset = HS.fromList [label1, label2, label3]+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    _ <- B.createNode anotherProperties+                    _ <- B.addLabels [label1, label2] n1+                    B.addLabels [label3] n1+                neo4jEqual 2 (length $ G.getNodes g)+                neo4jBool $ labelset `elem` map (`G.getNodeLabels` g) (G.getNodes g)+                neo4jBool $ HS.empty `elem` map (`G.getNodeLabels` g) (G.getNodes g)+                _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes g)+                return ()++-- | Test batch, change labels+case_batchChangeLabels :: Assertion+case_batchChangeLabels = withConnection host port $ do+                let label1 = "label1"+                let label2 = "label2"+                let label3 = "label3"+                let labelset = HS.fromList [label2]+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    _ <- B.addLabels [label1, label2, label3] n1+                    B.changeLabels [label2] n1+                neo4jBool $ labelset `elem` map (`G.getNodeLabels` g) (G.getNodes g)+                _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes g)+                return ()++-- | Test batch, remove label+case_batchRemoveLabel :: Assertion+case_batchRemoveLabel = withConnection host port $ do+                let label1 = "label1"+                let label2 = "label2"+                let label3 = "label3"+                let labelset = HS.fromList [label2, label3]+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    _ <- B.addLabels [label1, label2, label3] n1+                    B.removeLabel label1 n1+                neo4jBool $ labelset `elem` map (`G.getNodeLabels` g) (G.getNodes g)+                _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes g)+                return ()++-- | Test batch, get all nodes with a label+case_batchAllNodesWithLabel :: Assertion+case_batchAllNodesWithLabel = withConnection host port $ do+        gp <- B.runBatch $ do+            n1 <- B.createNode someProperties+            n2 <- B.createNode someProperties+            n3 <- B.createNode someProperties+            _ <- B.addLabels [lbl1, lbl2] n1+            _ <- B.addLabels [lbl2] n2+            B.addLabels [lbl1] n3+        g <- B.runBatch $ B.getNodesByLabelAndProperty lbl1 Nothing+        neo4jEqual 2 (length $ G.getNodes g)+        neo4jBool $ all (`elem` G.getNodes gp) (G.getNodes g)+        gempty <- B.runBatch $ B.getNodesByLabelAndProperty "nolbl" Nothing+        neo4jEqual [] (G.getNodes gempty)+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where lbl1 = "la21bl1"+          lbl2 = "la21bl2"++-- | Test batch, get all nodes with a label and a property+case_batchAllNodesWithLabelAndProperty :: Assertion+case_batchAllNodesWithLabelAndProperty = withConnection host port $ do+        gp <- B.runBatch $ do+            n1 <- B.createNode someProperties+            n2 <- B.createNode someProperties+            n3 <- B.createNode anotherProperties+            _ <- B.addLabels [lbl1, lbl2] n1+            _ <- B.addLabels [lbl2] n2+            B.addLabels [lbl1] n3+        g <- B.runBatch $ B.getNodesByLabelAndProperty lbl1 $ Just ("doublearray", newval [0.1, -12.23 :: Double])+        neo4jEqual 1 (length $ G.getNodes g)+        neo4jBool $ all (`elem` G.getNodes gp) (G.getNodes g)+        g2 <- B.runBatch $ B.getNodesByLabelAndProperty lbl1 $ Just ("doublearray", newval [0.1, -12.22 :: Double])+        neo4jEqual [] (G.getNodes g2)+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where lbl1 = "lbl1"+          lbl2 = "lbl2"++-- | Test cypher basic test+case_cypherBasic :: Assertion+case_cypherBasic = withConnection host port $ do+        -- create initial data+        gp <- B.runBatch $ do+            n1 <- B.createNode $ M.fromList ["name" |: ("I" :: T.Text)]+            n2 <- B.createNode $ M.fromList ["name" |: ("you" :: T.Text)]+            B.createRelationship "know" M.empty n1 n2+        -- actual test+        res <- C.cypher query params+        neo4jBool $ C.isSuccess res+        neo4jEqual ["TYPE(r)"] (C.cols $ C.fromSuccess res)+        neo4jBool $ ["know"] `elem` (C.vals $ C.fromSuccess res)+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "MATCH (x {name: {startName}})-[r]-(friend) WHERE friend.name = {name} RETURN TYPE(r)"+          params = M.fromList [("startName", C.newparam ("I" :: T.Text)), ("name", C.newparam ("you" :: T.Text))]+++-- | Test cypher create a node+case_cypherCreateNode :: Assertion+case_cypherCreateNode = withConnection host port $ do+        res <- C.cypher query params+        neo4jBool $ C.isSuccess res+        let gp = G.addCypher (C.fromSuccess res) G.empty+        let props = M.fromList ["name" |: ("Andres" :: T.Text)]+        neo4jEqual 1 (length $ G.getNodes gp)+        neo4jBool $ props `elem` map getNodeProperties (G.getNodes gp)+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "CREATE (n:Person { name : {name} }) RETURN n"+          params = M.fromList [("name", C.newparam ("Andres" :: T.Text))]++-- | Test cypher create a node with multiple properties+case_cypherCreateNodeMultipleProperties :: Assertion+case_cypherCreateNodeMultipleProperties = withConnection host port $ do+        res <- C.cypher query params+        neo4jBool $ C.isSuccess res+        let gp = G.addCypher (C.fromSuccess res) G.empty+        neo4jEqual 1 (length $ G.getNodes gp)+        neo4jBool $ props `elem` map getNodeProperties (G.getNodes gp)+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "CREATE (n:Person { props }) RETURN n"+          props = M.fromList ["name" |: ("Michael" :: T.Text), "position" |: ("Developer" :: T.Text),+                              "awesome" |: True, "children" |: (3 :: Int64)]+          params = M.fromList [("props", C.ParamProperties props)]++-- | Test cypher create multiple nodes+case_cypherCreateMultipleNodes :: Assertion+case_cypherCreateMultipleNodes = withConnection host port $ do+        res <- C.cypher query params+        neo4jBool $ C.isSuccess res+        let gp = G.addCypher (C.fromSuccess res) G.empty+        neo4jEqual 2 (length $ G.getNodes gp)+        neo4jBool $ propsA `elem` map getNodeProperties (G.getNodes gp)+        neo4jBool $ propsB `elem` map getNodeProperties (G.getNodes gp)+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "CREATE (n:Person { props }) RETURN n"+          propsA = M.fromList ["name" |: ("Andres" :: T.Text), "position" |: ("Developer" :: T.Text)]+          propsB = M.fromList ["name" |: ("Michael" :: T.Text), "position" |: ("Developer" :: T.Text)]+          params = M.fromList [("props", C.ParamPropertiesArray [propsA, propsB])]++-- | Test cypher set all properties on a node+case_cypherSetAllNodeProperties :: Assertion+case_cypherSetAllNodeProperties = withConnection host port $ do+        res <- C.cypher query params+        neo4jBool $ C.isSuccess res+        let gp = G.addCypher (C.fromSuccess res) G.empty+        neo4jEqual 1 (length $ G.getNodes gp)+        neo4jBool $ props `elem` map getNodeProperties (G.getNodes gp)+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "CREATE (n:Person { name: 'this property is to be deleted' } ) SET n = { props } RETURN n"+          props = M.fromList ["name" |: ("Michael" :: T.Text), "position" |: ("Developer" :: T.Text),+                              "awesome" |: True, "children" |: (3 :: Int64)]+          params = M.fromList [("props", C.ParamProperties props)]++-- | Test cypher basic query+case_cypherBasicQuery :: Assertion+case_cypherBasicQuery = withConnection host port $ do+        -- create initial data+        gp <- B.runBatch $ do+            n1 <- B.createNode $ M.fromList ["name" |: ("I" :: T.Text)]+            n2 <- B.createNode $ M.fromList ["name" |: ("you" :: T.Text)]+            n3 <- B.createNode $ M.fromList ["name" |: ("him" :: T.Text), "age" |: (25 :: Int64)]+            _ <- B.createRelationship "know" M.empty n1 n2+            B.createRelationship "know" M.empty n1 n3+        -- actual test+        res <- C.cypher query params+        neo4jBool $ C.isSuccess res+        neo4jEqual ["type(r)", "n.name", "n.age"] (C.cols $ C.fromSuccess res)+        neo4jBool $ ["know", "him", J.Number 25] `elem` (C.vals $ C.fromSuccess res)+        neo4jBool $ ["know", "you", J.Null] `elem` (C.vals $ C.fromSuccess res)+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "MATCH (x {name: 'I'})-[r]->(n) RETURN type(r), n.name, n.age"+          params = M.empty++-- | Test cypher basic query get relationships+case_cypherBasicQueryGetRels :: Assertion+case_cypherBasicQueryGetRels = withConnection host port $ do+        -- create initial data+        gp <- B.runBatch $ do+            n1 <- B.createNode $ M.fromList ["name" |: ("I" :: T.Text)]+            n2 <- B.createNode $ M.fromList ["name" |: ("you" :: T.Text)]+            n3 <- B.createNode $ M.fromList ["name" |: ("him" :: T.Text), "age" |: (25 :: Int64)]+            _ <- B.createRelationship "know" M.empty n1 n2+            B.createRelationship "know" M.empty n1 n3+        -- actual test+        res <- C.cypher query params+        neo4jBool $ C.isSuccess res+        let gres = G.addCypher (C.fromSuccess res) G.empty+        neo4jBool $ (length $ G.getRelationships gres) >= 2+        neo4jBool $ all (\r -> getRelType r == "know") (G.getRelationships gres)+        neo4jEqual ["r"] (C.cols $ C.fromSuccess res)+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "MATCH (x {name: 'I'})-[r]->(n) RETURN r"+          params = M.empty++-- | Test cypher nested results+case_cypherNestedResults :: Assertion+case_cypherNestedResults = withConnection host port $ do+        -- create initial data+        gp <- B.runBatch $ do+            n1 <- B.createNode $ M.fromList ["name" |: ("I" :: T.Text)]+            n2 <- B.createNode $ M.fromList ["name" |: ("you" :: T.Text)]+            B.createRelationship "know" M.empty n1 n2+        -- actual test+        res <- C.cypher query params+        neo4jBool $ C.isSuccess res+        neo4jEqual ["collect(n.name)"] (C.cols $ C.fromSuccess res)+        let v = case (head $ head $ C.vals $ C.fromSuccess res) of+                 J.Array vec -> vec+                 _ -> V.empty+        neo4jBool $ "you" `V.elem` v+        neo4jBool $ "I" `V.elem` v+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "MATCH (n) WHERE n.name in ['I', 'you'] RETURN collect(n.name)"+          params = M.empty++-- | Test cypher errors+case_cypherError :: Assertion+case_cypherError = withConnection host port $ do+        -- create initial data+        gp <- B.runBatch $ do+            B.createNode $ M.fromList ["age" |: (26 :: Int64)]+        -- actual test+        res <- C.cypher query params+        neo4jBool $ res `elem` [Left "BadInputException", Left "ArithmeticException"]+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "MATCH (x) WHERE has(x.age) RETURN x.age / 0"+          params = M.empty++-- | Test lone transaction cypher basic query+case_loneTransactionBasicQuery :: Assertion+case_loneTransactionBasicQuery = withConnection host port $ do+        -- create initial data+        gp <- B.runBatch $ do+            n1 <- B.createNode $ M.fromList ["name" |: ("I" :: T.Text)]+            n2 <- B.createNode $ M.fromList ["name" |: ("you" :: T.Text)]+            n3 <- B.createNode $ M.fromList ["name" |: ("him" :: T.Text), "age" |: (25 :: Int64)]+            _ <- B.createRelationship "know" M.empty n1 n2+            B.createRelationship "know" M.empty n1 n3+        -- actual test+        res <- TC.loneQuery query params+        neo4jBool $ TC.isSuccess res+        neo4jEqual ["type(r)", "n.name", "n.age"] (TC.cols $ TC.fromSuccess res)+        neo4jBool $ ["know", "him", J.Number 25] `elem` (TC.vals $ TC.fromSuccess res)+        neo4jBool $ ["know", "you", J.Null] `elem` (TC.vals $ TC.fromSuccess res)+        neo4jEqual TC.emptyStats (TC.stats $ TC.fromSuccess res)+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "MATCH (x {name: 'I'})-[r]->(n) RETURN type(r), n.name, n.age"+          params = M.empty++-- | Test cypher errors in a transaction+case_cypherTransactionError :: Assertion+case_cypherTransactionError = withConnection host port $ do+        -- create initial data+        gp <- B.runBatch $ B.createNode $ M.fromList ["age" |: (26 :: Int64)]+        -- actual test+        res <- TC.loneQuery query params+        neo4jEqual (Left ("Neo.ClientError.Statement.ArithmeticError","/ by zero")) res+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "MATCH (x) WHERE has(x.age) RETURN x.age / 0"+          params = M.empty++-- | Test a cypher transaction+case_cypherTransaction :: Assertion+case_cypherTransaction = withConnection host port $ do+        res <- TC.runTransaction $ do+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            voidIO $ assertEqual "" ["pere", "pau", "p1", "pere.age"] (TC.cols result)+            voidIO $ assertEqual "" (TC.Stats True 2 0 2 1 0 2 0 0 0 0 0) (TC.stats result)+            let vals = TC.vals result+            voidIO $ assertEqual "" 1 (length vals)+            voidIO $ assertEqual "" 4 (length $ head vals)+            voidIO $ assertEqual "" (J.Number 78.0) (head vals !! 3)+            voidIO $ assertEqual "" 1 (length $ TC.graph result)+            voidIO $ assertEqual "" 1 (length $ G.getRelationships (head $ TC.graph result))+            voidIO $ assertEqual "" 2 (length $ G.getNodes (head $ TC.graph result))+            return result+        neo4jBool $ TC.isSuccess res+        let (Right tresult) = res+        let gp = head $ TC.graph tresult+        void $ B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        void $ B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+    where voidIO x = void $ liftIO x++-- | Test a cypher transaction with a explicit commit+case_cypherTransactionExplicitCommit :: Assertion+case_cypherTransactionExplicitCommit = withConnection host port $ do+        res <- TC.runTransaction $ do+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            void $ TC.cypher "CREATE (pep: PERSON {age: 55})" M.empty+            TC.commit+            return result+        neo4jBool $ TC.isSuccess res+        let (Right result) = res+        voidIO $ assertEqual "" ["pere", "pau", "p1", "pere.age"] (TC.cols result)+        voidIO $ assertEqual "" (TC.Stats True 2 0 2 1 0 2 0 0 0 0 0) (TC.stats result)+        let vals = TC.vals result+        voidIO $ assertEqual "" 1 (length vals)+        voidIO $ assertEqual "" 4 (length $ head vals)+        voidIO $ assertEqual "" (J.Number 78.0) (head vals !! 3)+        voidIO $ assertEqual "" 1 (length $ TC.graph result)+        voidIO $ assertEqual "" 1 (length $ G.getRelationships (head $ TC.graph result))+        voidIO $ assertEqual "" 2 (length $ G.getNodes (head $ TC.graph result))+        let gp = head $ TC.graph result+        void $ B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        void $ B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+    where voidIO x = void $ liftIO x++-- | Test a cypher transaction with a keepalive+case_cypherTransactionKeepAlive :: Assertion+case_cypherTransactionKeepAlive = withConnection host port $ do+        res <- TC.runTransaction $ do+            TC.keepalive+            void $ TC.cypher "CREATE (pep: PERSON {age: 55})" M.empty+            TC.keepalive+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            return result+        neo4jBool $ TC.isSuccess res+        let (Right result) = res+        voidIO $ assertEqual "" ["pere", "pau", "p1", "pere.age"] (TC.cols result)+        voidIO $ assertEqual "" (TC.Stats True 2 0 2 1 0 2 0 0 0 0 0) (TC.stats result)+        let vals = TC.vals result+        voidIO $ assertEqual "" 1 (length vals)+        voidIO $ assertEqual "" 4 (length $ head vals)+        voidIO $ assertEqual "" (J.Number 78.0) (head vals !! 3)+        voidIO $ assertEqual "" 1 (length $ TC.graph result)+        voidIO $ assertEqual "" 1 (length $ G.getRelationships (head $ TC.graph result))+        voidIO $ assertEqual "" 2 (length $ G.getNodes (head $ TC.graph result))+        let gp = head $ TC.graph result+        void $ B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        void $ B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+    where voidIO x = void $ liftIO x++-- | Test a cypher transaction with an error+case_cypherErrorInTransaction :: Assertion+case_cypherErrorInTransaction = withConnection host port $ do+        res <- TC.runTransaction $ do+            -- query with wrong syntax+            void $ TC.cypher "i" M.empty+            TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+        neo4jBool $ not $ TC.isSuccess res+        neo4jEqual (Left ("Neo.ClientError.Statement.InvalidSyntax",+                            "Invalid input 'i': expected <init> (line 1, column 1)\n\"i\"\n ^")) res++-- | Test a cypher rollback transaction+case_cypherTransactionRollback :: Assertion+case_cypherTransactionRollback = withConnection host port $ do+         void $ TC.runTransaction $ do+            void $ TC.cypher "CREATE (pepe: PERSON {age: 55})" M.empty+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            TC.rollback+            return result++-- | Test a cypher rollback and leave transaction+case_cypherTransactionRollbackAndLeave :: Assertion+case_cypherTransactionRollbackAndLeave = withConnection host port $ do+         res <- TC.runTransaction $ do+            void $ TC.cypher "CREATE (pepe: PERSON {age: 55})" M.empty+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            TC.rollbackAndLeave "My message"+            TC.commit+            TC.rollback+            return result+         neo4jEqual (Left ("Rollback", "My message")) res++-- | Test issuing a commits after a rollback+case_cypherTransactionEnded :: Assertion+case_cypherTransactionEnded = assertException expException $ withConnection host port $ do+     void $ TC.runTransaction $ do+            void $ TC.cypher "CREATE (pepe: PERSON {age: 55})" M.empty+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            TC.rollback+            TC.commit+            return result+    where expException = TransactionEndedExc++-- | Test graph union op+case_graphUnion :: Assertion+case_graphUnion = withConnection host port $ do+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    void $ B.addLabels ["a"] n1+                    _ <- B.createRelationship "type1" someOtherProperties n1 n2+                    B.createRelationship "type2" someProperties n2 n1+                g2 <- B.runBatch $ do+                    n1 <- B.createNode someOtherProperties+                    n2 <- B.createNode anotherProperties+                    void $ B.addLabels ["b"] n1+                    _ <- B.createRelationship "type1" someOtherProperties n1 n2+                    B.createRelationship "type2" someProperties n2 n1+                let g3 = g `G.union` g2+                neo4jEqual 4 (length $ G.getNodes g3)+                neo4jEqual 4 (length $ G.getRelationships g3)+                neo4jBool $ someOtherProperties `elem` map getRelProperties (G.getRelationships g3)+                neo4jBool $ someProperties `elem` map getRelProperties (G.getRelationships g3)+                neo4jBool $ someOtherProperties `elem` map getNodeProperties (G.getNodes g3)+                neo4jBool $ someProperties `elem` map getNodeProperties (G.getNodes g3)+                neo4jBool $ "type1" `elem` map getRelType (G.getRelationships g3)+                neo4jBool $ "type2" `elem` map getRelType (G.getRelationships g3)+                neo4jBool $ "a" `elem` (join $ map (HS.toList . (flip G.getNodeLabels g3)) (G.getNodes g3))+                neo4jBool $ "b" `elem` (join $ map (HS.toList . (flip G.getNodeLabels g3)) (G.getNodes g3))+                mapM_ deleteRelationship (G.getRelationships g3)+                mapM_ deleteNode (G.getNodes g3)++-- | Test graph difference op+case_graphDifference :: Assertion+case_graphDifference = withConnection host port $ do+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    void $ B.addLabels ["a"] n1+                    _ <- B.createRelationship "type1" someOtherProperties n1 n2+                    B.createRelationship "type2" someProperties n2 n1+                let g2 = g `G.difference` g+                neo4jEqual 0 (length $ G.getRelationships g2)+                neo4jEqual 0 (length $ G.getNodes g2)+                let subGraph = G.deleteNode (head $ G.getNodes g) g+                let g3 = g `G.difference` (G.deleteRelationship (head $ G.getRelationships subGraph) subGraph)+                neo4jEqual 1 (length $ G.getRelationships g3)+                neo4jEqual 1 (length $ G.getNodes g3)++-- | Test graph intersection op+case_graphIntersection :: Assertion+case_graphIntersection = withConnection host port $ do+                g <- B.runBatch $ do+                    n1 <- B.createNode someProperties+                    n2 <- B.createNode anotherProperties+                    void $ B.addLabels ["a"] n1+                    _ <- B.createRelationship "type1" someOtherProperties n1 n2+                    B.createRelationship "type2" someProperties n2 n1+                g2 <- B.runBatch $ do+                    B.createNode someProperties+                let g3 = G.addNode (head $ G.getNodes g) g2+                let g4 = g `G.intersection` (G.addRelationship (head $ G.getRelationships g) g3)+                neo4jEqual 1 (length $ G.getRelationships g4)+                neo4jEqual 1 (length $ G.getNodes g4)+                neo4jEqual (head $ G.getRelationships g) (head $ G.getRelationships g4)+                neo4jEqual (head $ G.getNodes g) (head $ G.getNodes g4)