haskell-neo4j-client 0.2.4.0 → 0.3.0.0

raw patch · 10 files changed

+633/−83 lines, 10 filesdep +monad-controldep +transformers-basedep ~aesondep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-control, transformers-base

Dependency ranges changed: aeson, text

API changes (from Hackage documentation)

Files

• haskell-neo4j-client.cabal +18/−10
• src/Database/Neo4j/Batch/Node.hs +1/−1
• src/Database/Neo4j/Batch/Relationship.hs +3/−3
• src/Database/Neo4j/Cypher.hs +4/−1
• src/Database/Neo4j/Graph.hs +60/−23
• src/Database/Neo4j/Http.hs +30/−20
• src/Database/Neo4j/Relationship.hs +1/−1
• src/Database/Neo4j/Transactional/Cypher.hs +323/−0
• src/Database/Neo4j/Types.hs +46/−23
• tests/IntegrationTests.hs +147/−1

@@ -1,13 +1,16 @@ name:                haskell-neo4j-client-version:             0.2.4.0+version:             0.3.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.+    Library to interact with Neo4j databases.      .-    Basic support for Cypher implemented+    This library covers: +        -Cypher transactions+        -CRUD operations for nodes, relationships, labels and indexes+        -Batch calls for CRUD operations.     .-    All code has been tested with Neo4j version 2.0.3+    .+    All code has been tested with Neo4j versions 2.0.3 and 2.1.5 homepage:            https://github.com/asilvestre/haskell-neo4j-rest-client license:             MIT license-file:        LICENSE@@ -36,42 +39,47 @@                      test-framework-th ==0.2.*,                      HUnit ==1.2.*,                      Cabal,-                     text ==1.1.*,+                     text >= 1.1 && < 1.3,                      http-conduit ==2.1.*,                      http-types ==0.8.*,                      resourcet ==1.1.*,                      data-default ==0.5.*,                      transformers ==0.4.*,-                     aeson ==0.7.*,+                     aeson >= 0.7 && < 0.9,                      vector ==0.10.*,                      scientific ==0.3.*,                      unordered-containers ==0.2.*,+                     transformers-base ==0.4.*,                      HTTP ==4000.2.*,                      lifted-base ==0.2.*,                      hashable ==1.2.*,+                     monad-control ==0.3.*,                      mtl ==2.2.*  library   hs-source-dirs:      src-  exposed-modules:     Database.Neo4j, Database.Neo4j.Graph, Database.Neo4j.Batch, Database.Neo4j.Cypher+  exposed-modules:     Database.Neo4j, Database.Neo4j.Graph, Database.Neo4j.Batch, Database.Neo4j.Cypher,+                       Database.Neo4j.Transactional.Cypher   other-modules:       Database.Neo4j.Types, Database.Neo4j.Http, Database.Neo4j.Node, Database.Neo4j.Relationship,                        Database.Neo4j.Property, Database.Neo4j.Label, Database.Neo4j.Index, Database.Neo4j.Batch.Node,                        Database.Neo4j.Batch.Relationship, Database.Neo4j.Batch.Property, Database.Neo4j.Types,                        Database.Neo4j.Batch.Label, Database.Neo4j.Batch.Types   build-depends:       base >=4.6 && <4.8,                        containers ==0.5.*,-                       text ==1.1.*,+                       text >= 1.1 && < 1.3,                        http-conduit ==2.1.*,                        http-types ==0.8.*,                        bytestring ==0.10.*,                        resourcet ==1.1.*,                        data-default ==0.5.*,                        transformers ==0.4.*,-                       aeson ==0.7.*,+                       aeson >= 0.7 && < 0.9,                        vector ==0.10.*,                        scientific ==0.3.*,                        unordered-containers ==0.2.*,                        HTTP ==4000.2.*,                        lifted-base ==0.2.*,                        hashable ==1.2.*,+                       transformers-base ==0.4.*,+                       monad-control ==0.3.*,                        mtl ==2.2.*

@@ -18,7 +18,7 @@     getNodeBatchId :: a -> T.Text  instance NodeBatchIdentifier Node where-    getNodeBatchId = urlMinPath . runNodeUrl . nodeUrl+    getNodeBatchId = urlMinPath . runNodePath . nodePath  instance NodeBatchIdentifier NodeUrl where     getNodeBatchId = urlMinPath . runNodeUrl

@@ -20,7 +20,7 @@     getRelBatchId :: a -> T.Text  instance RelBatchIdentifier Relationship where-    getRelBatchId = urlMinPath . runRelUrl . relUrl+    getRelBatchId = urlMinPath . runRelPath . relPath  instance RelBatchIdentifier RelUrl where     getRelBatchId = urlMinPath . runRelUrl@@ -65,9 +65,9 @@ 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)+          parser jr g = foldl (flip G.addRelationship) g (tryParseBody jr)           dirStr Outgoing = "out"           dirStr Incoming = "in"           dirStr Any = "all"           filterStr [] = ""-          filterStr f = "/" <> (T.intercalate "%26" f)+          filterStr f = "/" <> T.intercalate "%26" f

@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings  #-} --- | Module to provide Cypher support.+-- | IMPORTANT! MODULE DEPRECATED, better use the code in this same library that uses the Neo4j transactional endpoint+--   in "Database.Neo4j.Transactional.Cypher"+--  Module to provide Cypher support. --  Currently we allow sending queries with parameters, the result is a collection of column headers --  and JSON data values, the Graph object has the function addCypher that tries to find --  nodes and relationships in a cypher query result and insert them in a "Database.Neo4j.Graph" object@@ -86,3 +88,4 @@ isSuccess (Left _) = False isSuccess (Right _) = True +{-# DEPRECATED cypher, fromResult, fromSuccess, isSuccess "Use Database.Neo4j.Transactional.Cypher instead" #-} 

@@ -2,8 +2,6 @@  -- | 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.@@ -11,10 +9,10 @@     -- * General objects     Graph, LabelSet, empty,     -- * Handling nodes in the graph object-    addNode, hasNode, deleteNode, getNodes,+    addNode, hasNode, deleteNode, getNodes, getNode, getNodeFrom, getNodeTo,     -- * Handling properties in the graph object     getRelationships, hasRelationship, addRelationship, deleteRelationship, getRelationshipNodeFrom,-    getRelationshipNodeTo,+    getRelationshipNodeTo, getRelationship,     -- ** Handling orphaned relationships #orphan#     getOrphansFrom, getOrphansTo, cleanOrphanRelationships,     -- * Handling properties@@ -31,7 +29,8 @@  import Data.Maybe (fromMaybe) -import Control.Applicative ((<$>), (<*>))+import Control.Applicative ((<$>))+import Control.Monad (join) import qualified Data.Aeson as J import qualified Data.HashMap.Lazy as M import qualified Data.HashSet as HS@@ -47,13 +46,17 @@ type LabelNodeIndex = M.HashMap Label NodeSet type LabelSet = HS.HashSet Label type NodeLabelIndex = M.HashMap NodePath LabelSet+type RelSet = HS.HashSet RelPath+type NodeRelIndex = M.HashMap NodePath RelSet  data Graph = Graph {nodes :: NodeIndex, labels :: LabelNodeIndex, rels :: RelIndex,-                        nodeLabels :: NodeLabelIndex} deriving (Eq, Show)+                    nodeLabels :: NodeLabelIndex, nodeFromRels :: NodeRelIndex, nodeToRels :: NodeRelIndex+                    } deriving (Eq, Show)  -- | Create an empty graph empty :: Graph-empty = Graph {nodes = M.empty, labels = M.empty, rels = M.empty, nodeLabels = M.empty}+empty = Graph {nodes = M.empty, labels = M.empty, rels = M.empty, nodeLabels = M.empty, nodeFromRels = M.empty,+               nodeToRels = M.empty}  -- | Add a node to the graph addNode :: Node -> Graph -> Graph@@ -61,11 +64,11 @@  -- | 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+setProperties ei props g = fromMaybe g $ (addEntity . newEntity) <$> entity     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+                    (EntityNodePath p) -> entityObj <$> M.lookup p (nodes g)+                    (EntityRelPath p) -> entityObj <$> M.lookup p (rels g)           newEntity e = setEntityProperties e props           addEntity e = case e of                             (EntityNode n) -> g{nodes = M.insert (getNodePath n) n (nodes g)}@@ -73,11 +76,11 @@  -- | 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+setProperty ei name value g = fromMaybe g $ (addEntity . newEntity) <$> entity     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+                    (EntityNodePath p) -> entityObj <$> M.lookup p (nodes g)+                    (EntityRelPath p) -> entityObj <$> M.lookup p (rels g)           newEntity e = setEntityProperties e $ M.insert name value (getEntityProperties e)           addEntity e = case e of                             (EntityNode n) -> g{nodes = M.insert (getNodePath n) n (nodes g)}@@ -85,11 +88,11 @@  -- | 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+deleteProperties ei g = fromMaybe g $ (addEntity . newEntity) <$> entity     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+                    (EntityNodePath p) -> entityObj <$> M.lookup p (nodes g)+                    (EntityRelPath p) -> entityObj <$> M.lookup p (rels g)           newEntity e = setEntityProperties e emptyProperties           addEntity e = case e of                             (EntityNode n) -> g{nodes = M.insert (getNodePath n) n (nodes g)}@@ -97,11 +100,11 @@  -- | 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+deleteProperty ei key g = fromMaybe g $ (addEntity . newEntity) <$> entity     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+                    (EntityNodePath p) -> entityObj <$> M.lookup p (nodes g)+                    (EntityRelPath p) -> entityObj <$> M.lookup p (rels g)           newEntity e = setEntityProperties e $ M.delete key (getEntityProperties e)           addEntity e = case e of                             (EntityNode n) -> g{nodes = M.insert (getNodePath n) n (nodes g)}@@ -111,11 +114,27 @@ hasNode :: NodeIdentifier a => a -> Graph -> Bool hasNode n g = getNodePath n `M.member` nodes g +-- | Get a node in the graph+getNode :: NodeIdentifier a => a -> Graph -> Maybe Node+getNode n g = getNodePath n `M.lookup` nodes g++-- | Get outgoing relationships from a node+getNodeFrom :: NodeIdentifier a => a -> Graph -> Maybe [Relationship]+getNodeFrom n g = join $ sequence <$> filter (/=Nothing) <$> map getRel <$> fromrels+    where getRel = flip getRelationship g+          fromrels = HS.toList <$> getNodePath n `M.lookup` nodeFromRels g++-- | Get incoming relationships from a node+getNodeTo :: NodeIdentifier a => a -> Graph -> Maybe [Relationship]+getNodeTo n g = join $ sequence <$> filter (/=Nothing) <$> map getRel <$> torels+    where getRel = flip getRelationship g+          torels = HS.toList <$> getNodePath n `M.lookup` nodeToRels g+ -- | Get a list with all the nodes in the graph getNodes :: Graph -> [Node] getNodes g = M.elems $ nodes g --- | Whether a node is present in the graph+-- | Whether a relationship is present in the graph hasRelationship :: RelIdentifier a => a -> Graph -> Bool  hasRelationship r g = getRelPath r `M.member` rels g @@ -131,12 +150,21 @@  -- | Add a relationship to the graph addRelationship :: Relationship -> Graph -> Graph-addRelationship r g = g {rels = M.insert (getRelPath r) r (rels g)}+addRelationship r g = g {rels = M.insert (getRelPath r) r (rels g),+                         nodeFromRels = M.insertWith HS.union (pathFrom r) (HS.singleton relpath) (nodeFromRels g),+                         nodeToRels = M.insertWith HS.union (pathTo r) (HS.singleton relpath) (nodeToRels g)}+    where pathFrom = getNodePath . relFrom+          pathTo = getNodePath . relTo+          relpath = getRelPath r  -- | Get a list with all the relationships in the graph getRelationships :: Graph -> [Relationship] getRelationships g = M.elems $ rels g +-- | Get a relationship in the graph+getRelationship :: RelIdentifier a => a -> Graph -> Maybe Relationship+getRelationship r g = getRelPath r `M.lookup` rels g+ -- | Get relationships missing their "from" node getOrphansFrom :: Graph -> [Relationship] getOrphansFrom g = M.elems $ M.filter noNode (rels g)@@ -153,8 +181,17 @@  -- | Delete a relationship from the graph deleteRelationship :: RelIdentifier a => a -> Graph -> Graph-deleteRelationship r g = g {rels = M.delete (getRelPath r) (rels g)}+deleteRelationship r g = g {rels = M.delete (getRelPath r) (rels g),+                            nodeFromRels = removeNodeRef (nodeFromRels g) pathFrom,+                            nodeToRels = removeNodeRef (nodeToRels g) pathTo}+    where updNodeRel = const $ HS.delete (getRelPath r)+          rel = M.lookup (getRelPath r) (rels g)+          pathFrom = (getNodePath . relFrom) <$> rel+          pathTo = (getNodePath . relTo) <$> rel+          removeNodeRef nodeRel (Just nodepath) = M.insertWith updNodeRel nodepath HS.empty nodeRel+          removeNodeRef nodeRel Nothing = nodeRel + -- | Get the "node from" from a relationship getRelationshipNodeFrom :: Relationship -> Graph -> Maybe Node getRelationshipNodeFrom r g = M.lookup (getNodePath (relFrom r)) (nodes g) @@ -220,7 +257,7 @@     where relFilterFunc r = hasRelationship r gb           nodeFilterFunc n = hasNode n gb --- | Feed a cypher result into a graph (looks for nodes and relationships and inserts them)+-- | Feed a cypher result (from the old API) into a graph (looks for nodes and relationships and inserts them) addCypher :: C.Response -> Graph -> Graph addCypher (C.Response _ vals) ginit = foldl tryAdd ginit (concat vals)     where tryAdd :: Graph -> J.Value -> Graph

@@ -4,7 +4,7 @@  import Control.Exception.Base (Exception, throw, catch, toException) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Resource (runResourceT, ResourceT)+import Control.Monad.Trans.Resource (runResourceT) import Data.Default (def) import Data.Maybe (fromMaybe) @@ -22,20 +22,19 @@   -- | Create a new connection that can be manually closed with runResourceT-newConnection :: Hostname -> Port -> ResourceT IO Connection+newConnection :: Hostname -> Port -> IO Connection newConnection hostname port = do-        mgr <- liftIO $ HC.newManager HC.conduitManagerSettings+        mgr <- HC.newManager HC.conduitManagerSettings         return $ Connection hostname port mgr  -- | Run a set of Neo4j commands in a single connection withConnection :: Hostname -> Port -> Neo4j a -> IO a -withConnection hostname port cmds = runResourceT $ do-        conn <- newConnection hostname port-        runNeo4j cmds conn+withConnection hostname port cmds = runResourceT $ HC.withManager $+         \mgr -> liftIO $ runNeo4j cmds $ Connection hostname port mgr          -- | General function for HTTP requests httpReq :: Connection -> HT.Method -> S.ByteString -> L.ByteString -> (HT.Status -> Bool) ->-     ResourceT IO (HC.Response L.ByteString)+     IO (HC.Response L.ByteString) httpReq (Connection h p m) method path body statusCheck = do             let request = def {                     HC.host = h,@@ -60,8 +59,8 @@                 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+-- | Launch a POST request, this will raise an exception if 201 or 200 is not received+httpCreate :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString -> IO a httpCreate conn path body = do             res <- httpReq conn HT.methodPost path body (`elem` [HT.status200, HT.status201])             let resBody = J.eitherDecode $ HC.responseBody res@@ -69,9 +68,20 @@                         Right entity -> entity                         Left e -> throw $ Neo4jParseException ("Error parsing created entity: " ++ e) +-- | Launch a POST request and get some headers+httpCreateWithHeaders :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString -> IO (a, HT.ResponseHeaders)+httpCreateWithHeaders conn path body = do+            res <- httpReq conn HT.methodPost path body (`elem` [HT.status200, HT.status201])+            let resBody = J.eitherDecode $ HC.responseBody res+            let result = case resBody of+                            Right entity -> entity+                            Left e -> throw $ Neo4jParseException ("Error parsing created entity: " ++ e)+            let headers = HC.responseHeaders res+            return (result, headers)+ -- | Launch a POST request, this will raise an exception if 201 or 204 is not received, explain 500 httpCreate500Explained :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString ->-                                             ResourceT IO (Either L.ByteString a)+                                             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@@ -83,7 +93,7 @@  -- | 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 :: J.FromJSON a => Connection -> S.ByteString -> L.ByteString -> IO (Either T.Text a) httpCreate4XXExplained conn path body = do             res <- httpReq conn HT.methodPost path body (\s -> s `elem` validcodes ++ errcodes)             let status = HC.responseStatus res@@ -95,13 +105,13 @@           errcodes = [HT.status404, HT.status400]  -- | Launch a POST request that doesn't expect response body, this will raise an exception if 204 is not received-httpCreate_ :: Connection -> S.ByteString -> L.ByteString -> ResourceT IO ()+httpCreate_ :: Connection -> S.ByteString -> L.ByteString -> IO () httpCreate_ conn path body = do             _ <- httpReq conn HT.methodPost path body (\s -> s == HT.status201 || s == HT.status204)             return ()  -- | Launch a GET request, this will raise an exception if 200 or 404 is not received-httpRetrieve :: J.FromJSON a => Connection -> S.ByteString -> ResourceT IO (Maybe a)+httpRetrieve :: J.FromJSON a => Connection -> S.ByteString -> IO (Maybe a) httpRetrieve conn path = do             res <- httpReq conn HT.methodGet path "" (\s -> s == HT.status200 || s == HT.status404)             let status = HC.responseStatus res@@ -114,7 +124,7 @@                         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 :: J.FromJSON a => Connection -> S.ByteString -> IO a httpRetrieveSure conn path = do             res <- httpReq conn HT.methodGet path "" (==HT.status200)             let body = J.eitherDecode $ HC.responseBody res@@ -125,7 +135,7 @@ -- | 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 :: J.FromJSON a => Connection -> S.ByteString -> IO (Either T.Text a) httpRetrieveValue conn path = do             res <- httpReq conn HT.methodGet path "" (\s -> s == HT.status200 || s == HT.status404)             let status = HC.responseStatus res@@ -139,35 +149,35 @@  -- | 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 :: Connection -> S.ByteString -> IO ()  httpDelete c pth = do             _ <- httpReq c HT.methodDelete pth "" (\s -> s == HT.status204 || s == HT.status404)             return ()  -- | Launch a DELETE request, this will raise an exception if 204 is not received --   We don't accept 404-httpDeleteNo404 :: Connection -> S.ByteString -> ResourceT IO () +httpDeleteNo404 :: Connection -> S.ByteString -> IO ()  httpDeleteNo404 c pth = do             _ <- httpReq c HT.methodDelete pth "" (==HT.status204)             return ()  -- | Launch a DELETE request, this will raise an exception if 204 is not received --   If we receive 404, we will return the server explanation-httpDelete404Explained :: Connection -> S.ByteString -> ResourceT IO (Either T.Text ())+httpDelete404Explained :: Connection -> S.ByteString -> IO (Either T.Text ()) httpDelete404Explained c pth = do             res <- httpReq c HT.methodDelete pth "" (\s -> s == HT.status204 || s == HT.status404)             let status = HC.responseStatus res             return $ if status /= HT.status404 then Right () else Left $ extractException res  -- | Launch a PUT request, this will raise an exception if 200 or 204 is not received-httpModify :: Connection -> S.ByteString -> L.ByteString -> ResourceT IO ()+httpModify :: Connection -> S.ByteString -> L.ByteString -> IO () httpModify c path body = do             _ <- httpReq c HT.methodPut path body (\s -> s == HT.status200 || s == HT.status204)             return ()  -- | Launch a PUT request, this will raise an exception if 200 or 204 is not received --   If we receive 404, we will return the server explanation-httpModify404Explained :: Connection -> S.ByteString -> L.ByteString -> ResourceT IO (Either T.Text ())+httpModify404Explained :: Connection -> S.ByteString -> L.ByteString -> IO (Either T.Text ()) httpModify404Explained c path body = do             res <- httpReq c HT.methodPut path body (\s -> s == HT.status200 || s == HT.status204 || s == HT.status404)             let status = HC.responseStatus res

@@ -35,7 +35,7 @@                         Right rel -> return rel                         Left expl -> wrapExc expl     where reqPath = runNodeIdentifier nodefrom <> "/relationships"-          reqBody = J.encode $ J.object ["to" .= runNodeUrl (nodeUrl nodeto), "type" .= t,+          reqBody = J.encode $ J.object ["to" .= runNodePath (nodePath nodeto), "type" .= t,                                          "data" .= J.toJSON props]           wrapExc msg             | msg == "StartNodeNotFoundException" = throw (Neo4jNoEntityException $ runNodeIdentifier nodefrom)

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

@@ -1,7 +1,10 @@-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}  module Database.Neo4j.Types where @@ -11,11 +14,14 @@ import Data.Monoid (Monoid, mappend) import Data.String (fromString) import Data.Typeable (Typeable)+import Control.Exception (throw) import Control.Exception.Base (Exception)-import Control.Applicative ((<$>), (<*>))-import Control.Monad (mzero)+import Control.Applicative+import Control.Monad (mzero, ap, liftM)+import Control.Monad.Base (MonadBase, liftBase) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Resource (ResourceT)+--import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith, restoreM, StM)+import Control.Monad.Trans.Resource (MonadThrow, throwM) import GHC.Generics (Generic)  import Data.Aeson ((.:))@@ -109,7 +115,7 @@  -- | 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 (/='/')+urlPath url = fromMaybe url $ T.dropWhile (/='/') <$> T.stripPrefix "http://" url  -- | Path without the /db/data part, useful for batch paths and such urlMinPath :: T.Text -> T.Text@@ -126,15 +132,11 @@     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)+data Node = Node {nodePath :: NodePath, nodeProperties :: Properties} deriving (Show, Eq)  -- | Get the properties of a node getNodeProperties :: Node -> Properties@@ -142,7 +144,7 @@  -- | JSON to Node instance J.FromJSON Node where-    parseJSON (J.Object v) = Node <$> (NodeUrl <$> (v .: "self")) <*> (v .: "data" >>= J.parseJSON)+    parseJSON (J.Object v) = Node <$> (getNodePath . NodeUrl <$> (v .: "self")) <*> (v .: "data" >>= J.parseJSON)     parseJSON _ = mzero  instance Entity Node where@@ -188,20 +190,16 @@ -- | 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,+data Relationship = Relationship {relPath :: RelPath,                                   relType :: RelationshipType,                                   relProperties :: Properties,-                                  relFrom :: NodeUrl,-                                  relTo :: NodeUrl} deriving (Show, Eq)+                                  relFrom :: NodePath,+                                  relTo :: NodePath} deriving (Show, Eq)  -- | Get the properties of a relationship getRelProperties :: Relationship -> Properties@@ -213,9 +211,9 @@  -- | 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 (J.Object v) = Relationship <$> (getRelPath . RelUrl <$> v .: "self") <*> v .: "type" <*>+                                (v .: "data" >>= J.parseJSON) <*> (getNodePath . NodeUrl <$> v .: "start") <*>+                                (getNodePath . NodeUrl <$> v .: "end")     parseJSON _ = mzero  instance Entity Relationship where@@ -321,7 +319,7 @@ 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 }+newtype Neo4j a = Neo4j { runNeo4j :: Connection -> IO a }  instance Monad Neo4j where     return x = Neo4j (const (return x))@@ -329,5 +327,30 @@                             a <- cmd con                             runNeo4j (f a) con +instance Functor Neo4j where+    fmap = liftM++instance Applicative Neo4j where+    pure = return+    (<*>) = ap+ instance MonadIO Neo4j where 	liftIO f = Neo4j $ const (liftIO f)++instance MonadThrow Neo4j where+    throwM e = Neo4j $ const (throw e)++instance MonadBase (Neo4j) (Neo4j) where+    liftBase = id++--instance MonadTransControl Neo4j where+--    newtype StT Neo4j a = StReader {unStReader :: a}+--    liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r+--    restoreT = ResourceT . const . liftM unStReader++--instance MonadBaseControl b IO => MonadBaseControl b (Neo4j) where+--    newtype StM Neo4j a = StNeo4j a+--    liftBaseWith f = Neo4j $ \conn ->+--         liftBaseWith $ \runInBase ->+--             f $ liftM StNeo4j . runInBase . (\(Neo4j r) -> r conn)+--    restoreM (StNeo4j x) = Neo4j $ const $ restoreM x

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances, TemplateHaskell #-} module Main where +import Control.Monad (void) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Monoid (Monoid, mappend) import Data.Int (Int64)@@ -24,6 +25,7 @@ import qualified Database.Neo4j.Batch as B import qualified Database.Neo4j.Cypher as C import qualified Database.Neo4j.Graph as G+import qualified Database.Neo4j.Transactional.Cypher as TC  (<>) :: Monoid a => a -> a -> a (<>) = mappend@@ -1343,9 +1345,153 @@             B.createNode $ M.fromList ["age" |: (26 :: Int64)]         -- actual test         res <- C.cypher query params-        neo4jEqual (Left "BadInputException") res+        neo4jBool $ res `elem` [Left "BadInputException", Left "ArithmeticException"]         -- cleanup         _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)         return ()     where query = "MATCH (x) WHERE has(x.age) RETURN x.age / 0"           params = M.empty++-- | Test lone transaction cypher basic query+case_loneTransactionBasicQuery :: Assertion+case_loneTransactionBasicQuery = withConnection host port $ do+        -- create initial data+        gp <- B.runBatch $ do+            n1 <- B.createNode $ M.fromList ["name" |: ("I" :: T.Text)]+            n2 <- B.createNode $ M.fromList ["name" |: ("you" :: T.Text)]+            n3 <- B.createNode $ M.fromList ["name" |: ("him" :: T.Text), "age" |: (25 :: Int64)]+            _ <- B.createRelationship "know" M.empty n1 n2+            B.createRelationship "know" M.empty n1 n3+        -- actual test+        res <- TC.loneQuery query params+        neo4jBool $ TC.isSuccess res+        neo4jEqual ["type(r)", "n.name", "n.age"] (TC.cols $ TC.fromSuccess res)+        neo4jBool $ ["know", "him", J.Number 25] `elem` (TC.vals $ TC.fromSuccess res)+        neo4jBool $ ["know", "you", J.Null] `elem` (TC.vals $ TC.fromSuccess res)+        neo4jEqual TC.emptyStats (TC.stats $ TC.fromSuccess res)+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "MATCH (x {name: 'I'})-[r]->(n) RETURN type(r), n.name, n.age"+          params = M.empty++-- | Test cypher errors in a transaction+case_cypherTransactionError :: Assertion+case_cypherTransactionError = withConnection host port $ do+        -- create initial data+        gp <- B.runBatch $ B.createNode $ M.fromList ["age" |: (26 :: Int64)]+        -- actual test+        res <- TC.loneQuery query params+        neo4jEqual (Left ("Neo.ClientError.Statement.ArithmeticError","/ by zero")) res+        -- cleanup+        _ <- B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+        return ()+    where query = "MATCH (x) WHERE has(x.age) RETURN x.age / 0"+          params = M.empty++-- | Test a cypher transaction+case_cypherTransaction :: Assertion+case_cypherTransaction = withConnection host port $ do+        res <- TC.runTransaction $ do+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            voidIO $ assertEqual "" ["pere", "pau", "p1", "pere.age"] (TC.cols result)+            voidIO $ assertEqual "" (TC.Stats True 2 0 2 1 0 2 0 0 0 0 0) (TC.stats result)+            let vals = TC.vals result+            voidIO $ assertEqual "" 1 (length vals)+            voidIO $ assertEqual "" 4 (length $ head vals)+            voidIO $ assertEqual "" (J.Number 78.0) (head vals !! 3)+            voidIO $ assertEqual "" 1 (length $ TC.graph result)+            voidIO $ assertEqual "" 1 (length $ G.getRelationships (head $ TC.graph result))+            voidIO $ assertEqual "" 2 (length $ G.getNodes (head $ TC.graph result))+            return result+        neo4jBool $ TC.isSuccess res+        let (Right tresult) = res+        let gp = head $ TC.graph tresult+        void $ B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        void $ B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+    where voidIO x = void $ liftIO x++-- | Test a cypher transaction with a explicit commit+case_cypherTransactionExplicitCommit :: Assertion+case_cypherTransactionExplicitCommit = withConnection host port $ do+        res <- TC.runTransaction $ do+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            void $ TC.cypher "CREATE (pep: PERSON {age: 55})" M.empty+            TC.commit+            return result+        neo4jBool $ TC.isSuccess res+        let (Right result) = res+        voidIO $ assertEqual "" ["pere", "pau", "p1", "pere.age"] (TC.cols result)+        voidIO $ assertEqual "" (TC.Stats True 2 0 2 1 0 2 0 0 0 0 0) (TC.stats result)+        let vals = TC.vals result+        voidIO $ assertEqual "" 1 (length vals)+        voidIO $ assertEqual "" 4 (length $ head vals)+        voidIO $ assertEqual "" (J.Number 78.0) (head vals !! 3)+        voidIO $ assertEqual "" 1 (length $ TC.graph result)+        voidIO $ assertEqual "" 1 (length $ G.getRelationships (head $ TC.graph result))+        voidIO $ assertEqual "" 2 (length $ G.getNodes (head $ TC.graph result))+        let gp = head $ TC.graph result+        void $ B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        void $ B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+    where voidIO x = void $ liftIO x++-- | Test a cypher transaction with a keepalive+case_cypherTransactionKeepAlive :: Assertion+case_cypherTransactionKeepAlive = withConnection host port $ do+        res <- TC.runTransaction $ do+            TC.keepalive+            void $ TC.cypher "CREATE (pep: PERSON {age: 55})" M.empty+            TC.keepalive+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            return result+        neo4jBool $ TC.isSuccess res+        let (Right result) = res+        voidIO $ assertEqual "" ["pere", "pau", "p1", "pere.age"] (TC.cols result)+        voidIO $ assertEqual "" (TC.Stats True 2 0 2 1 0 2 0 0 0 0 0) (TC.stats result)+        let vals = TC.vals result+        voidIO $ assertEqual "" 1 (length vals)+        voidIO $ assertEqual "" 4 (length $ head vals)+        voidIO $ assertEqual "" (J.Number 78.0) (head vals !! 3)+        voidIO $ assertEqual "" 1 (length $ TC.graph result)+        voidIO $ assertEqual "" 1 (length $ G.getRelationships (head $ TC.graph result))+        voidIO $ assertEqual "" 2 (length $ G.getNodes (head $ TC.graph result))+        let gp = head $ TC.graph result+        void $ B.runBatch $ mapM_ B.deleteRelationship (G.getRelationships gp)+        void $ B.runBatch $ mapM_ B.deleteNode (G.getNodes gp)+    where voidIO x = void $ liftIO x++-- | Test a cypher transaction with an error+case_cypherErrorInTransaction :: Assertion+case_cypherErrorInTransaction = withConnection host port $ do+        res <- TC.runTransaction $ do+            -- query with wrong syntax+            void $ TC.cypher "i" M.empty+            TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+        neo4jBool $ not $ TC.isSuccess res+        neo4jEqual (Left ("Neo.ClientError.Statement.InvalidSyntax",+                            "Invalid input 'i': expected <init> (line 1, column 1)\n\"i\"\n ^")) res++-- | Test a cypher rollback transaction+case_cypherTransactionRollback :: Assertion+case_cypherTransactionRollback = withConnection host port $ do+         void $ TC.runTransaction $ do+            void $ TC.cypher "CREATE (pepe: PERSON {age: 55})" M.empty+            result <- TC.cypher "CREATE (pere: PERSON {age: {age}}) CREATE (pau: PERSON {props}) \+                              \CREATE p1 = (pere)-[:KNOWS]->(pau) RETURN pere, pau, p1, pere.age" $+                                M.fromList [("age", TC.newparam (78 :: Int64)),+                                            ("props", TC.ParamProperties $ M.fromList["age" |: (99 :: Int64)])]+            TC.rollback+            return result