haskell-neo4j-client 0.3.1.0 → 0.3.1.1

raw patch · 2 files changed

+271/−2 lines, 2 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• haskell-neo4j-client.cabal +2/−2
• src/Database/Neo4j/Traversal.hs +269/−0

@@ -1,5 +1,5 @@ name:                haskell-neo4j-client-version:             0.3.1.0+version:             0.3.1.1 synopsis:            A Haskell neo4j client description:              Library to interact with Neo4j databases. @@ -67,7 +67,7 @@ library   hs-source-dirs:      src   exposed-modules:     Database.Neo4j, Database.Neo4j.Graph, Database.Neo4j.Batch, Database.Neo4j.Cypher,-                       Database.Neo4j.Transactional.Cypher, Database.Neo4j.Types+                       Database.Neo4j.Transactional.Cypher, Database.Neo4j.Types, Database.Neo4j.Traversal   other-modules:       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,

@@ -0,0 +1,269 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE TypeSynonymInstances  #-}+{-# LANGUAGE FlexibleInstances  #-}++-- | Module to manage traversal operations++module Database.Neo4j.Traversal (+    -- * Types for configuring the traversal+    Uniqueness(..), TraversalOrder(..), ReturnFilter(..), RelFilter, TraversalDesc(..),+    -- * Additional types for configuring a paged traversal+    TraversalPaging(..),+    -- * Types used when returning paths+    ConcreteDirection(..), Path(..), IdPath, FullPath,+    -- * Types used when returning paged results+    PagedTraversal, pathNodes, pathRels, +    -- * Traversal operations+    traverseGetNodes, traverseGetRels, traverseGetPath, traverseGetFullPath,+    -- * Paged traversal operations+    pagedTraverseGetNodes, pagedTraverseGetRels, pagedTraverseGetPath, pagedTraverseGetFullPath,+    -- * Operations to handle paged results+    getPagedValues, nextTraversalPage, pagedTraversalDone) where++import Data.Default++import Control.Applicative+import Control.Exception.Base (throw, catch)+import Control.Monad (mzero)+import Data.Aeson ((.=), (.:), (.:?))+import Data.List (find)+import Data.Maybe (fromMaybe)+import Data.String (fromString)++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 qualified Network.HTTP.Types as HT+import qualified Network.URI as NU++import Database.Neo4j.Types+import Database.Neo4j.Http++-- | Different types of uniqueness calculations for a traversal+data Uniqueness = NodeGlobal | RelationshipGlobal | NodePathUnique | RelationshipPath deriving (Eq, Show)++-- | Traversal mode+data TraversalOrder = BreadthFirst | DepthFirst deriving (Eq, Show)++-- | Built-in return filters+data ReturnFilter = ReturnAll | ReturnAllButStartNode deriving (Eq, Show)++type RelFilter = (RelationshipType, Direction)++-- | Type containing all info describing a traversal request+data TraversalDesc = TraversalDesc {+    travOrder :: TraversalOrder,+    travRelFilter :: [RelFilter],+    travUniqueness :: Maybe Uniqueness,+    travDepth :: Either Integer T.Text,+    travNodeFilter :: Either ReturnFilter T.Text} deriving (Eq, Show)++-- | Get the body for a traversal request+traversalReqBody :: TraversalDesc -> L.ByteString+traversalReqBody (TraversalDesc ord relfilt uniq depth nodefilt) = J.encode $ J.object [+        "order" .= J.toJSON ord,+        "relationships" .= relfilt,+        "uniqueness" .= uniq,+        depthField depth,+        "return_filter" .= returnField nodefilt+        ]+    where depthField (Left lvl) = "max_depth" .= lvl+          depthField (Right desc) = "prune_evaluator" .= J.object ["language" .= ("javascript" :: T.Text),+                                                                   "body" .= desc]+          returnField (Left filt) = J.object ["language" .= ("builtin" :: T.Text), "name" .= filt]+          returnField (Right desc) = J.object ["language" .= ("javascript" :: T.Text), "body" .= desc]++-- | How to codify traversalDesc values into JSON+instance J.ToJSON TraversalOrder where+    toJSON BreadthFirst = J.String "breadth_first"+    toJSON DepthFirst = J.String "depth_first"++-- | How to codify ReturnFilter values into JSON+instance J.ToJSON ReturnFilter where+    toJSON ReturnAll = J.String "all"+    toJSON ReturnAllButStartNode = J.String "all_but_start_node"++-- | How to codify RelFilter values into JSON+instance J.ToJSON RelFilter where+    toJSON (rType, dir) = J.object ["direction" .= dirToJson dir, "type" .= J.toJSON rType]+        where dirToJson Outgoing = J.String "out"+              dirToJson Incoming = J.String "in"+              dirToJson Any = J.String "all"++-- | How to codify uniqueness values into JSON+instance J.ToJSON (Maybe Uniqueness) where+    toJSON Nothing = J.String "none"+    toJSON (Just NodeGlobal) = J.String "node_global"+    toJSON (Just RelationshipGlobal) = J.String "relationship_global"+    toJSON (Just NodePathUnique) = J.String "node_path"+    toJSON (Just RelationshipPath) = J.String "relationship_path"++instance Default TraversalDesc where+    def = TraversalDesc {travOrder = BreadthFirst, travRelFilter = [], travUniqueness = Nothing,+                         travDepth = Left 1, travNodeFilter = Left ReturnAll}++-- | Description of a traversal paging+data TraversalPaging = TraversalPaging {+    pageSize :: Integer,+    pageLeaseSecs :: Integer+    } deriving (Eq, Show)++instance Default TraversalPaging where+    def = TraversalPaging {pageSize = 50, pageLeaseSecs = 60}++-- | Direction without possibility of ambiguity+data ConcreteDirection = In | Out deriving (Eq, Show, Ord)++instance J.FromJSON ConcreteDirection where+    parseJSON (J.String "->" ) =  return Out+    parseJSON (J.String "<-" ) =  return In+    parseJSON _ = mzero++-- | Data type to describe a path in a graph, that is a single node or nodes interleaved with relationships+data Path a b = PathEnd !a | PathLink !a !b !(Path a b) deriving (Eq, Ord, Show)++-- | Get all the nodes of a path+pathNodes :: Path a b -> [a]+pathNodes (PathEnd n) = [n]+pathNodes (PathLink n _ p) = n : pathNodes p++-- | Get all the relationships of a path+pathRels :: Path a b -> [b]+pathRels (PathEnd _) = []+pathRels (PathLink _ r p) = r : pathRels p++-- | Path that its data are id's+type IdPath = Path NodePath (RelPath, ConcreteDirection)++-- | How to decodify an IdPath from JSON+instance J.FromJSON IdPath where+    parseJSON (J.Object v) =  do+                  nodes <- (map (getNodePath . NodeUrl)) <$> (v .: "nodes")+                  rels <- (map (getRelPath . RelUrl)) <$> (v .: "relationships")+                  -- Pre 2.2 neo4j versions don't provide the directions field, so we put a default value...+                  dirs <- fromMaybe (take (length rels) $ repeat Out) <$> v .:? "directions"+                  let correctPath = (length nodes) == (length rels + 1) && (length rels == length dirs) +                  if correctPath+                    then return $ buildPath nodes rels dirs+                    else fail $ "Wrong path nodes: " <> show nodes <> " rels: " <> show rels <> " dirs: " <> show dirs+        where buildPath [n] [] [] = PathEnd n+              buildPath (n:ns) (r:rs) (d:ds) = PathLink n (r, d) (buildPath ns rs ds)+              buildPath _ _ _ = undefined+    parseJSON _ = fail "wrong type for path"++-- | Path that its data are full nodes and relationships, not only their id's+type FullPath = Path Node Relationship++-- | How to decodify an IdPath from JSON+instance J.FromJSON FullPath where+    parseJSON (J.Object v) =  do+                  nodes <- v .: "nodes"+                  rels <- v .: "relationships"+                  let correctPath = length nodes == length rels + 1+                  if correctPath+                    then return $ buildPath nodes rels+                    else fail $ "Wrong path nodes: " <> show nodes <> " rels: " <> show rels+        where buildPath [n] [] = PathEnd n+              buildPath (n:ns) (r:rs) = PathLink n r (buildPath ns rs)+              buildPath _ _ = undefined+    parseJSON _ = fail "wrong type for path"++-- | Data type that holds a result for a paged traversal with the URI to get the rest of the pages+data PagedTraversal a = Done | More S.ByteString [a] deriving (Eq, Ord, Show)++-- | Get the path of a node in simple text+bsNodePath :: NodeIdentifier a => a -> S.ByteString+bsNodePath n = TE.encodeUtf8 $ (runNodePath $ getNodePath n)++-- | Get the path for a traversal starting from a node+traversalApi :: NodeIdentifier a => a -> S.ByteString+traversalApi n = bsNodePath n <> "/traverse"++-- | Get the path for a paged traversal starting from a node+pagedApi :: NodeIdentifier a => a -> S.ByteString+pagedApi n = bsNodePath n <> "/paged/traverse"++-- | Wrap 404 exception into Neo4jNoEntity exceptions+proc404 :: NodeIdentifier n => n -> Neo4jException -> a+proc404 n exc@(Neo4jUnexpectedResponseException s)+        | s == HT.status404 = throw (Neo4jNoEntityException $ bsNodePath n)+        | otherwise = throw exc+proc404 _ exc = throw exc++-- | Perform a traversal operation+traverse :: (NodeIdentifier a, J.FromJSON b) => S.ByteString -> TraversalDesc -> a -> Neo4j [b]+traverse path desc start = Neo4j $ \conn ->+                             httpCreate conn (traversalApi start <> path) (traversalReqBody desc) `catch` proc404 start++-- | Perform a traversal and get the resulting nodes+traverseGetNodes :: NodeIdentifier a => TraversalDesc -> a -> Neo4j [Node]+traverseGetNodes = traverse "/node"++-- | Perform a traversal and get the resulting relationship entities+traverseGetRels :: NodeIdentifier a => TraversalDesc -> a -> Neo4j [Relationship]+traverseGetRels = traverse "/relationship"++-- | Perform a traversal and get the resulting node and relationship paths+--   IMPORTANT! In pre 2.2 Neo4j versions the directions in each relationship ID returned have a default value+--   (The API does not provide them)+traverseGetPath :: NodeIdentifier a => TraversalDesc -> a -> Neo4j [IdPath]+traverseGetPath = traverse "/path"++-- | Perform a traversal and get the resulting node and relationship entities+traverseGetFullPath :: NodeIdentifier a => TraversalDesc -> a -> Neo4j [FullPath]+traverseGetFullPath = traverse "/fullpath"++-- | Get the values of a paged traversal result+getPagedValues :: PagedTraversal a -> [a]+getPagedValues Done = []+getPagedValues (More _ r)  = r++-- | Get the next page of values from a traversal result+nextTraversalPage :: J.FromJSON a => PagedTraversal a -> Neo4j (PagedTraversal a)+nextTraversalPage Done = return Done+nextTraversalPage (More pagingUri _) = Neo4j $ \conn -> do+    mr <- httpRetrieve conn pagingUri+    return $ case mr of+               Nothing -> Done+               Just r -> More pagingUri r++-- | Whether a paged traversal is done+pagedTraversalDone :: PagedTraversal a -> Bool+pagedTraversalDone Done = True+pagedTraversalDone _ = False++-- | Generate the query string associated to a paging description+pagingQs :: TraversalPaging -> S.ByteString+pagingQs (TraversalPaging pSize leaseSecs) = "?pageSize=" <> showBs pSize <> "&leaseTime=" <> showBs leaseSecs+    where showBs = fromString . show++-- | Perform a paged traversal and get the resulting nodes+pagedTraversal :: (NodeIdentifier a, J.FromJSON b) => S.ByteString -> TraversalDesc -> TraversalPaging -> a+               -> Neo4j (PagedTraversal b)+pagedTraversal path desc paging start = Neo4j $ \conn -> do+    (r, headers) <- httpCreateWithHeaders conn (pagedApi start <> path <> pagingQs paging) (+        traversalReqBody desc) `catch` proc404 start+    let location = fromMaybe "" $ do+        loc <- (S.unpack . snd) <$> find ((==HT.hLocation) . fst) headers+        (S.pack . NU.uriPath) <$> NU.parseURI loc+    return (More location r)++-- | Perform a paged traversal and get the resulting nodes+pagedTraverseGetNodes :: NodeIdentifier a => TraversalDesc -> TraversalPaging -> a -> Neo4j (PagedTraversal Node)+pagedTraverseGetNodes = pagedTraversal "/node"++-- | Perform a paged traversal and get the resulting relationships +pagedTraverseGetRels :: NodeIdentifier a => TraversalDesc -> TraversalPaging -> a -> Neo4j(PagedTraversal Relationship)+pagedTraverseGetRels = pagedTraversal "/relationship"++-- | Perform a paged traversal and get the resulting id paths,+--   IMPORTANT! In pre 2.2 Neo4j versions the directions in each relationship ID returned have a default value+--   (The API does not provide them)+pagedTraverseGetPath :: NodeIdentifier a => TraversalDesc -> TraversalPaging -> a -> Neo4j (PagedTraversal IdPath)+pagedTraverseGetPath = pagedTraversal "/path"++-- | Perform a paged traversal and get the resulting paths with full entities+pagedTraverseGetFullPath :: NodeIdentifier a => TraversalDesc -> TraversalPaging -> a -> Neo4j(PagedTraversal FullPath)+pagedTraverseGetFullPath = pagedTraversal "/fullpath"