haskell-neo4j-client (empty) → 0.1.0.0

raw patch · 18 files changed

+2665/−0 lines, 18 filesdep +Cabaldep +HTTPdep +HUnitsetup-changed

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

Files

• LICENSE +21/−0
• Setup.hs +2/−0
• haskell-neo4j-client.cabal +71/−0
• src/Database/Neo4j.hs +109/−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/Graph.hs +215/−0
• src/Database/Neo4j/Http.hs +180/−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/Types.hs +320/−0
• tests/IntegrationTests.hs +1177/−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,71 @@+name:                haskell-neo4j-client+version:             0.1.0.0+synopsis:            A Haskell neo4j client+description:         +    Library to interact with Neo4j databases. For now, its API covers basic operations for nodes, relationships, labels+    and indexes and provides calls to use these in batch mode.+    .+    Cypher is not yet supported, but it hopefully will be very soon.+    .+    All code has been tested with Neo4j version 2.0.3+homepage:            https://github.com/asilvestre/haskell-neo4j-rest-client+license:             MIT+license-file:        LICENSE+author:              Antoni Silvestre+maintainer:          antoni.silvestre@gmail.com+copyright:           (c) 2014 Antoni Silvestre+category:            Database+build-type:          Simple+cabal-version:       >=1.8++Test-Suite test-haskell-neo4j-rest-client+     Type:           exitcode-stdio-1.0+     Hs-Source-Dirs: src, tests+     Main-is:        IntegrationTests.hs+     Build-Depends:  base ==4.6.*,+                     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.*,+                     http-conduit ==2.1.*,+                     http-types ==0.8.*,+                     resourcet ==1.1.*,+                     data-default ==0.5.*,+                     transformers ==0.4.*,+                     aeson ==0.7.*,+                     vector ==0.10.*,+                     scientific ==0.3.*,+                     unordered-containers ==0.2.*,+                     HTTP ==4000.2.*,+                     lifted-base ==0.2.*,+                     hashable ==1.2.*,+                     mtl ==2.2.*+library+  hs-source-dirs:      src+  exposed-modules:     Database.Neo4j, Database.Neo4j.Graph, Database.Neo4j.Batch+  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+  build-depends:       base ==4.6.*,+                       containers ==0.5.*,+                       text ==1.1.*,+                       http-conduit ==2.1.*,+                       http-types ==0.8.*,+                       bytestring ==0.10.*,+                       resourcet ==1.1.*,+                       data-default ==0.5.*,+                       transformers ==0.4.*,+                       aeson ==0.7.*,+                       vector ==0.10.*,+                       scientific ==0.3.*,+                       unordered-containers ==0.2.*,+                       HTTP ==4000.2.*,+                       lifted-base ==0.2.*,+                       hashable ==1.2.*,+                       mtl ==2.2.*

@@ -0,0 +1,109 @@+{-# 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,+    -- * Managing relationships+    Relationship, Direction(..), RelationshipType, createRelationship, getRelationship, deleteRelationship,+        getRelationships, relId, relPath, allRelationshipTypes, getRelProperties, getRelType, runRelIdentifier,+        getRelationshipFrom, getRelationshipTo,+    -- * Managing labels and getting nodes by label+    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)

@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances  #-}++module Database.Neo4j.Batch (+    -- * Usage+    -- $use    ++    -- * General+    Batch, runBatch,+    -- * 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 . runNodeUrl . nodeUrl++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 . runRelUrl . relUrl++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 (\gacc r ->  G.addRelationship r gacc) g (tryParseBody jr)+          dirStr Outgoing = "out"+          dirStr Incoming = "in"+          dirStr Any = "all"+          filterStr [] = ""+          filterStr f = "/" <> (T.intercalate "%26" f)

@@ -0,0 +1,215 @@+{-# 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.+--  'Graph' objects for now are returned by "Database.Neo4j.Batch" operations and in the future hopefully after+--  adding cypher support they will be part of their result+--  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,+    -- * Handling properties in the graph object+    getRelationships, hasRelationship, addRelationship, deleteRelationship, getRelationshipNodeFrom,+    getRelationshipNodeTo,+    -- ** Handling orphaned relationships #orphan#+    getOrphansFrom, getOrphansTo, cleanOrphanRelationships,+    -- * Handling properties+    setProperties, setProperty, deleteProperties, deleteProperty,+    -- * Handling labels+    setNodeLabels, addNodeLabel, getNodeLabels, deleteNodeLabel,+    -- * Graph filtering functions+    nodeFilter, relationshipFilter,+    -- * Graph operations+    union, difference, intersection+    )where++import Data.Maybe (fromMaybe)++import qualified Data.HashMap.Lazy as M+import qualified Data.HashSet as HS+import qualified Data.Text as T++import Database.Neo4j.Types++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++data Graph = Graph {nodes :: NodeIndex, labels :: LabelNodeIndex, rels :: RelIndex,+                        nodeLabels :: NodeLabelIndex} deriving (Eq, Show)++-- | Create an empty graph+empty :: Graph+empty = Graph {nodes = M.empty, labels = M.empty, rels = M.empty, nodeLabels = 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 $ entity >>= return . newEntity >>= return . addEntity+    where path = getEntityPath ei+          entity = case path of +                    (EntityNodePath p) -> M.lookup p (nodes g) >>= return . entityObj+                    (EntityRelPath p) -> M.lookup p (rels g) >>= return . entityObj+          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 $ entity >>= return . newEntity >>= return . addEntity+    where path = getEntityPath ei+          entity = case path of +                    (EntityNodePath p) -> M.lookup p (nodes g) >>= return . entityObj+                    (EntityRelPath p) -> M.lookup p (rels g) >>= return . entityObj+          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 $ entity >>= return . newEntity >>= return . addEntity+    where path = getEntityPath ei+          entity = case path of +                    (EntityNodePath p) -> M.lookup p (nodes g) >>= return . entityObj+                    (EntityRelPath p) -> M.lookup p (rels g) >>= return . entityObj+          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 $ entity >>= return . newEntity >>= return . addEntity+    where path = getEntityPath ei+          entity = case path of +                    (EntityNodePath p) -> M.lookup p (nodes g) >>= return . entityObj+                    (EntityRelPath p) -> M.lookup p (rels g) >>= return . entityObj+          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 list with all the nodes in the graph+getNodes :: Graph -> [Node]+getNodes g = M.elems $ nodes g++-- | Whether a node 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)}++-- | Get a list with all the relationships in the graph+getRelationships :: Graph -> [Relationship]+getRelationships g = M.elems $ 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)}++-- | 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 deleteNode n gacc else 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 deleteRelationship r gacc else 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 = addRels ga (addNodes ga gb)+    where addRels g1 g2 = foldl (flip addRelationship) g1 (M.elems $ rels g2)+          addNodes g1 g2 = foldl (flip addNode) g1 (M.elems $ nodes 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

@@ -0,0 +1,180 @@+{-# 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, ResourceT)+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 -> ResourceT IO Connection+newConnection hostname port = do+        mgr <- liftIO $ 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 $ do+        conn <- newConnection hostname port+        runNeo4j cmds conn+        +-- | General function for HTTP requests+httpReq :: Connection -> HT.Method -> S.ByteString -> L.ByteString -> (HT.Status -> Bool) ->+     ResourceT 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 204 is not received+httpCreate :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString -> ResourceT 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, this will raise an exception if 201 or 204 is not received, explain 500+httpCreate500Explained :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString ->+                                             ResourceT 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 -> ResourceT IO (Either T.Text a)+httpCreate4XXExplained conn path body = do+            res <- httpReq conn HT.methodPost path body (\s -> s `elem` [HT.status201, HT.status404, HT.status400])+            let status = HC.responseStatus res+            return $ if status == HT.status201 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)++-- | 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 -> ResourceT 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 -> ResourceT 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 -> ResourceT 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 -> ResourceT 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 -> ResourceT 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 -> ResourceT 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 -> ResourceT 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 -> ResourceT 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 -> ResourceT 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" .= runNodeUrl (nodeUrl 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,320 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-}++module Database.Neo4j.Types where++import Data.Hashable (Hashable)+import Data.Int (Int64)+import Data.Maybe (fromMaybe)+import Data.Monoid (Monoid, mappend)+import Data.Typeable (Typeable)+import Control.Exception.Base (Exception)+import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Resource (ResourceT)+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.stripPrefix "http://" url >>= return . T.dropWhile (/='/')++-- | 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+    +-- | Get the path for a node entity without host and port+nodePath :: Node -> NodePath+nodePath = NodePath . urlPath . runNodeUrl . nodeUrl++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 {nodeUrl :: NodeUrl, 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 <$> (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"++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 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++-- | Get the path for a node entity without host and port+relPath :: Relationship -> RelPath+relPath = RelPath . urlPath . runRelUrl . relUrl++-- | 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 {relUrl :: RelUrl,+                                  relType :: RelationshipType,+                                  relProperties :: Properties,+                                  relFrom :: NodeUrl,+                                  relTo :: NodeUrl} 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 <$> (RelUrl <$> v .: "self") <*> v .: "type" <*>+                                (v .: "data" >>= J.parseJSON) <*> (NodeUrl <$> v .: "start") <*>+                                (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"++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++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 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 -> ResourceT 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 MonadIO Neo4j where+	liftIO f = Neo4j $ const (liftIO f)

@@ -0,0 +1,1177 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}+module Main where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Monoid (Monoid, mappend)+import Data.Int (Int64)+import Data.Maybe (fromJust)++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 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.Graph as G+import qualified Database.Neo4j.Batch as B++(<>) :: 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"++-- | 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"++someOtherProperties :: Properties+someOtherProperties = M.fromList ["hola" |: ("adeu" :: T.Text), "proparray" |: ["a" :: T.Text, "", "adeu"]]++anotherProperties :: Properties+anotherProperties = M.empty++myRelType :: T.Text+myRelType = "MYREL"++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"