| Safe Haskell | Safe-Inferred | 
|---|---|
| Language | Haskell2010 | 
Database.Bolt.Extras.Graph
Description
This module defines everything needed to make template graph requests to Neo4j.
There are two types of queries that you can run: queries that return something from the
database (Get) and queries that save new data to it (Put). Both types are abstracted via type class
GraphQuery. Most of the time you will need only its makeRequest method.
Get and Put queries are simply two instances of GraphQuery, differentiated by empty data
types GetRequest and PutRequest. This means that you will have to use TypeApplications
to call GraphQuery methods, like this:
makeRequest @GetRequest ...
All queries are built from simple templates that can be customized with endomorphisms
(things of type a -> a, like the Builder pattern in OOP).
Endomorphisms can be conveniently applied using & operator.
A complete example of running Get and Put queries can be found in "example/Main.hs" file in this
repository.
Synopsis
- data Graph n a b = Graph {- _vertices :: Map n a
- _relations :: Map (n, n) b
 
- vertices :: forall n a b a. Lens (Graph n a b) (Graph n a b) (Map n a) (Map n a)
- relations :: forall n a b b. Lens (Graph n a b) (Graph n a b) (Map (n, n) b) (Map (n, n) b)
- emptyGraph :: Ord n => Graph n a b
- addNode :: (Show n, Ord n) => n -> a -> Graph n a b -> Graph n a b
- addRelation :: (Show n, Ord n) => n -> n -> b -> Graph n a b -> Graph n a b
- data GetRequest
- class GetterLike a where- withBoltId :: BoltId -> a -> a
- withLabel :: Label -> a -> a
- withLabelQ :: Name -> a -> a
- withProp :: (Text, Value) -> a -> a
- withReturn :: [Text] -> a -> a
- isReturned :: a -> a
 
- data NodeGetter = NodeGetter {}
- data RelGetter = RelGetter {}
- type GraphGetRequest = Graph NodeName NodeGetter RelGetter
- defaultNode :: Bool -> NodeGetter
- defaultNodeReturn :: NodeGetter
- defaultNodeNotReturn :: NodeGetter
- defaultRel :: Bool -> RelGetter
- defaultRelReturn :: RelGetter
- defaultRelNotReturn :: RelGetter
- allProps :: [Text]
- data NodeResult = NodeResult {}
- data RelResult = RelResult {}
- type GraphGetResponse = Graph NodeName NodeResult RelResult
- extractNode :: NodeLike a => NodeName -> GraphGetResponse -> a
- extractRelation :: URelationLike a => NodeName -> NodeName -> GraphGetResponse -> a
- extractNodeId :: NodeName -> GraphGetResponse -> BoltId
- extractRelationId :: NodeName -> NodeName -> GraphGetResponse -> BoltId
- extractNodeAeson :: NodeName -> GraphGetResponse -> NodeResult
- extractRelationAeson :: NodeName -> NodeName -> GraphGetResponse -> RelResult
- mergeGraphs :: GetBoltId a => [Graph NodeName a b] -> Graph NodeName a b
- data PutRequest
- data PutNode
- data PutRelationship
- type GraphPutRequest = Graph NodeName PutNode PutRelationship
- type GraphPutResponse = Graph NodeName BoltId BoltId
- class GraphQuery a where- type NodeReq a :: *
- type RelReq a :: *
- type NodeRes a :: *
- type RelRes a :: *
- requestEntities :: (Requestable (NodeName, NodeReq a), Requestable ((NodeName, NodeName), RelReq a)) => [(NodeName, NodeReq a)] -> [((NodeName, NodeName), RelReq a)] -> (Text, [Text])
- formQuery :: (Requestable (NodeName, NodeReq a), Requestable ((NodeName, NodeName), RelReq a), Returnable (NodeName, NodeReq a), Returnable ((NodeName, NodeName), RelReq a)) => [Text] -> Graph NodeName (NodeReq a) (RelReq a) -> Text
- extractGraphs :: (Extractable (NodeRes a), Extractable (RelRes a), MonadIO m) => [NodeName] -> [(NodeName, NodeName)] -> [Record] -> BoltActionT m [Graph NodeName (NodeRes a) (RelRes a)]
- makeRequest :: (Requestable (NodeName, NodeReq a), Requestable ((NodeName, NodeName), RelReq a), Returnable (NodeName, NodeReq a), Returnable ((NodeName, NodeName), RelReq a), Extractable (NodeRes a), Extractable (RelRes a), MonadIO m) => [Text] -> Graph NodeName (NodeReq a) (RelReq a) -> BoltActionT m [Graph NodeName (NodeRes a) (RelRes a)]
 
- class Requestable a where
- class Returnable a where- isReturned' :: a -> Bool
- return' :: a -> Text
 
- class Extractable a where- extract :: MonadIO m => Text -> [Record] -> BoltActionT m [a]
 
- type NodeName = Text
- relationName :: (NodeName, NodeName) -> Text
- requestGetters :: [(NodeName, NodeGetter)] -> [((NodeName, NodeName), RelGetter)] -> (Text, [Text])
- requestPut :: [(NodeName, PutNode)] -> [((NodeName, NodeName), PutRelationship)] -> (Text, [Text])
- (#) :: a -> (a -> b) -> b
Graph template construction
Both query types require a Graph type. Preffered way to create a variable of this type
 is to start with emptyGraph and add required nodes and relations with addNode and
 addRelation function.
For example (using Text as node data for simplicity):
queryG :: Graph Text Text Text queryG = emptyGraph & addNode "a" "node a" & addNode "b" "node b & addRelation "a" "b" "relation a -> b"
Representation of Graph that is used for requests and responses. It is parameterized by three types:
- n: type of node names
- a: type of nodes
- b: type of relations
Relations are described by a pair of nodes - start and end.
Constructors
| Graph | |
| Fields 
 | |
Instances
| Generic (Graph n a b) Source # | |
| (Show n, Show a, Show b) => Show (Graph n a b) Source # | |
| type Rep (Graph n a b) Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.AbstractGraph type Rep (Graph n a b) = D1 ('MetaData "Graph" "Database.Bolt.Extras.Graph.Internal.AbstractGraph" "hasbolt-extras-0.0.2.0-LlsBPfU8Ggs1Zvm48yF6Qb" 'False) (C1 ('MetaCons "Graph" 'PrefixI 'True) (S1 ('MetaSel ('Just "_vertices") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map n a)) :*: S1 ('MetaSel ('Just "_relations") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map (n, n) b)))) | |
relations :: forall n a b b. Lens (Graph n a b) (Graph n a b) (Map (n, n) b) (Map (n, n) b) Source #
emptyGraph :: Ord n => Graph n a b Source #
An empty graph.
Adds node to graph by its name and data.
 If graph already contains node with given name, error will be thrown.
Arguments
| :: (Show n, Ord n) | |
| => n | Name of start node | 
| -> n | Name of end node | 
| -> b | Relation data | 
| -> Graph n a b | |
| -> Graph n a b | 
Adds relation to graph by startName of node, endName of node, and rel with relation data.
 If graph already contains relation with given (startName, endName), error will be thrown.
Get queries
Get queries are represented by GraphGetRequest type - it is a Graph filled with templates
 for nodes and relations: NodeGetter and RelGetter.
To make a query, you need to build a template of graph that you want to find in the DB.
 For that, start with empty nodes and relations like defaultNodeReturn and defaultRelReturn.
 Customize them with endomorphisms in GetterLike class and combine into template
 graph Graph using emptyGraph, addNode and addRelation.
Typically, a node template is constructed like this:
defaultNodeReturn & withLabelQ ''NodeType & withBoltId nodeId & withReturn allProps
The result of running Get query will be represented as a Graph as well, with GraphGetResponse
 alias. You can then use convenient functions like extractNode and extractRelation to get
 your datatypes (that are instances of NodeLike
 or URelationshipLike) from the result.
Getter types
data GetRequest Source #
Get request with graph result.
Instances
class GetterLike a where Source #
Endomorphisms to set up NodeGetter and RelGetter.
Methods
Arguments
| :: Label | |
| -> a | |
| -> a | set known label | 
Arguments
| :: [Text] | |
| -> a | |
| -> a | add list of properties to return | 
Arguments
| :: a | |
| -> a | set that entity should be returned | 
Instances
| GetterLike NodeGetter Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get Methods withBoltId :: BoltId -> NodeGetter -> NodeGetter Source # withLabel :: Label -> NodeGetter -> NodeGetter Source # withLabelQ :: Name -> NodeGetter -> NodeGetter Source # withProp :: (Text, Value) -> NodeGetter -> NodeGetter Source # withReturn :: [Text] -> NodeGetter -> NodeGetter Source # isReturned :: NodeGetter -> NodeGetter Source # | |
| GetterLike RelGetter Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get Methods withBoltId :: BoltId -> RelGetter -> RelGetter Source # withLabel :: Label -> RelGetter -> RelGetter Source # withLabelQ :: Name -> RelGetter -> RelGetter Source # withProp :: (Text, Value) -> RelGetter -> RelGetter Source # withReturn :: [Text] -> RelGetter -> RelGetter Source # isReturned :: RelGetter -> RelGetter Source # | |
data NodeGetter Source #
Helper to find Nodes.
Constructors
| NodeGetter | |
Instances
| Show NodeGetter Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get Methods showsPrec :: Int -> NodeGetter -> ShowS # show :: NodeGetter -> String # showList :: [NodeGetter] -> ShowS # | |
| Eq NodeGetter Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get | |
| GetterLike NodeGetter Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get Methods withBoltId :: BoltId -> NodeGetter -> NodeGetter Source # withLabel :: Label -> NodeGetter -> NodeGetter Source # withLabelQ :: Name -> NodeGetter -> NodeGetter Source # withProp :: (Text, Value) -> NodeGetter -> NodeGetter Source # withReturn :: [Text] -> NodeGetter -> NodeGetter Source # isReturned :: NodeGetter -> NodeGetter Source # | |
| Requestable (NodeName, NodeGetter) Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get | |
| Returnable (NodeName, NodeGetter) Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get Methods isReturned' :: (NodeName, NodeGetter) -> Bool Source # | |
Helper to find URelationships.
Constructors
| RelGetter | |
Instances
| Show RelGetter Source # | |
| Eq RelGetter Source # | |
| GetterLike RelGetter Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get Methods withBoltId :: BoltId -> RelGetter -> RelGetter Source # withLabel :: Label -> RelGetter -> RelGetter Source # withLabelQ :: Name -> RelGetter -> RelGetter Source # withProp :: (Text, Value) -> RelGetter -> RelGetter Source # withReturn :: [Text] -> RelGetter -> RelGetter Source # isReturned :: RelGetter -> RelGetter Source # | |
| Requestable ((NodeName, NodeName), RelGetter) Source # | |
| Returnable ((NodeName, NodeName), RelGetter) Source # | |
type GraphGetRequest = Graph NodeName NodeGetter RelGetter Source #
The combinations of getters to load graph from the database.
Default getters
Arguments
| :: Bool | Whether to return the node | 
| -> NodeGetter | 
NodeGetter that matches any node.
defaultNodeReturn :: NodeGetter Source #
NodeGetter that matches any node and returns it.
defaultNodeNotReturn :: NodeGetter Source #
NodeGetter that matches any node and does not return it.
RelGetter that matches any relation.
defaultRelReturn :: RelGetter Source #
RelGetter that matches any relation and returns it.
defaultRelNotReturn :: RelGetter Source #
RelGetter that matches any relation and does not return it.
Return all properties of a node or relation. To be used with withReturn.
Result types
data NodeResult Source #
Result for node where properties are represented as aeson Value.
Constructors
| NodeResult | |
Instances
Result for relation where properties are represented as aeson Value.
Instances
| FromJSON RelResult Source # | |
| ToJSON RelResult Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get | |
| Generic RelResult Source # | |
| Show RelResult Source # | |
| Eq RelResult Source # | |
| Extractable RelResult Source # | |
| GetBoltId RelResult Source # | |
| URelationLike RelResult Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get Methods toURelation :: RelResult -> URelationship Source # | |
| type Rep RelResult Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get type Rep RelResult = D1 ('MetaData "RelResult" "Database.Bolt.Extras.Graph.Internal.Get" "hasbolt-extras-0.0.2.0-LlsBPfU8Ggs1Zvm48yF6Qb" 'False) (C1 ('MetaCons "RelResult" 'PrefixI 'True) (S1 ('MetaSel ('Just "rresId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 BoltId) :*: (S1 ('MetaSel ('Just "rresLabel") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Label) :*: S1 ('MetaSel ('Just "rresProps") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map Text Value))))) | |
type GraphGetResponse = Graph NodeName NodeResult RelResult Source #
The graph of Nodes and URelationships which we got from the database using GraphGetRequest.
Extracting result
These functions are for extracting nodes and relations in various formats.
 If an entity does not exist in given GraphGetResponse or is of invalid type,
 an error will be thrown.
For example, assume you have this query:
  queryG :: GraphGetRequest
  queryG = emptyGraph
    & addNode "exNode"
      (defaultNodeReturn
         & withLabelQ ''ExampleNode
         & withProp   ("exampleFieldT", T A)
         & withReturn allProps
      )
And run it:
result <- makeRequest @GetRequest [] queryG
Then you can get ExampleNode value from the result
let nodes = map extractNode "exNode" result :: [ExampleNode]
You can also just ask for an id of node:
let nodeIds = map extractNodeId "exNode" result
Or, if you did not use withReturn allProps, you can use extractNodeAeson to get raw
 NodeResult value and inspect its properties.
extractNode :: NodeLike a => NodeName -> GraphGetResponse -> a Source #
Extract a node by its name from GraphGetResponse and convert it to user type
 with fromNode.
extractRelation :: URelationLike a => NodeName -> NodeName -> GraphGetResponse -> a Source #
Extract a relation by name of it start and end nodes and convert to user type with fromURelation.
extractNodeId :: NodeName -> GraphGetResponse -> BoltId Source #
Extract just node's BoltId.
extractRelationId :: NodeName -> NodeName -> GraphGetResponse -> BoltId Source #
Extract just relation's BoltId.
extractNodeAeson :: NodeName -> GraphGetResponse -> NodeResult Source #
Extract NodeResult.
extractRelationAeson :: NodeName -> NodeName -> GraphGetResponse -> RelResult Source #
Extract RelResult.
mergeGraphs :: GetBoltId a => [Graph NodeName a b] -> Graph NodeName a b Source #
Helper function to merge graphs of results, i.e.
 if you requested graph A -> B -> C
 and in the database there were two B entities connected to the same entity A
 and four C entities connected to the same two entities B,
 Cypher query will return four graphs which satisfy this path,
 despite the fact that A was present only once in the database
 and B was present only two times in the database.
This function will merge these four graphs in one
 and return nodes by node names with suffixes equal to their BoltIds.
For example, if there were four graphs:
nodes: [A (boltId = 0), B (boltId = 1), C (boltId = 3)], relations: [A -> B, B -> C]; nodes: [A (boltId = 0), B (boltId = 1), C (boltId = 4)], relations: [A -> B, B -> C]; nodes: [A (boltId = 0), B (boltId = 2), C (boltId = 5)], relations: [A -> B, B -> C]; nodes: [A (boltId = 0), B (boltId = 2), C (boltId = 6)], relations: [A -> B, B -> C].
this function will merge them into new graph:
  nodes: [A0 (boltId = 0), B1 (boltId = 1), B2 (boltId = 2),
          C3 (boltId = 3), C4 (boltId = 4), C5 (boltId = 5), C6 (boltId = 6)],
  relations: [A0 -> B1, A0 -> B2, B1 -> C3, B1 -> C4, B2 -> C5, B2 -> C6].
Put queries
Put queries are represented with GraphPutRequest - a Graph of PutNode and PutRelationship.
 Build your graph the same way as with Get queryб representing new nodes and relations as
 PutNode and PutRelationship. The query graph may also describe existing
 nodes and relations, for example if you need to find a specific node in graph and attach a new one to
 it, or update an existing node with new data.
Result of Put query will be graph with Neo4j ids of inserted data.
data PutRequest Source #
Put request in Bolt format with BoltIds of uploaded entities as result.
Instances
Constructors
| BoltId BoltId | Describe existing node by its  | 
| MergeN Node | Merge the  | 
| CreateN Node | Create an entirely new node. Corresponds to  | 
data PutRelationship Source #
PutRelationship is the wrapper for URelationship where we can specify
 if we want to merge or create it.
Meaning of constructors is the same as for PutNode.
Constructors
| MergeR URelationship | |
| CreateR URelationship | 
Instances
| Show PutRelationship Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Put Methods showsPrec :: Int -> PutRelationship -> ShowS # show :: PutRelationship -> String # showList :: [PutRelationship] -> ShowS # | |
| Requestable ((NodeName, NodeName), PutRelationship) Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Put | |
| Returnable ((NodeName, NodeName), PutRelationship) Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Put Methods isReturned' :: ((NodeName, NodeName), PutRelationship) -> Bool Source # return' :: ((NodeName, NodeName), PutRelationship) -> Text Source # | |
type GraphPutRequest = Graph NodeName PutNode PutRelationship Source #
The graph of Nodes with specified uploading type and URelationships.
type GraphPutResponse = Graph NodeName BoltId BoltId Source #
The graph of BoltIds corresponding to the nodes and relationships
 which we get after putting GraphPutRequest.
Internal machinery for forming Cypher queries
class GraphQuery a where Source #
Type class used to perform requests to the Neo4j based on graphs.
Minimal complete definition
Associated Types
Type of entity describing node for request.
Type of entity describing relationship for request.
Type of node entity which will be extracted from result.
Type of relationship entity which will be extracted from result.
Methods
requestEntities :: (Requestable (NodeName, NodeReq a), Requestable ((NodeName, NodeName), RelReq a)) => [(NodeName, NodeReq a)] -> [((NodeName, NodeName), RelReq a)] -> (Text, [Text]) Source #
Convert requestable entities to text in the query.
Arguments
| :: (Requestable (NodeName, NodeReq a), Requestable ((NodeName, NodeName), RelReq a), Returnable (NodeName, NodeReq a), Returnable ((NodeName, NodeName), RelReq a)) | |
| => [Text] | Custom conditions that will be added to  | 
| -> Graph NodeName (NodeReq a) (RelReq a) | Request graph template. | 
| -> Text | Cypher query as text. | 
Abstract function to form query for request.
extractGraphs :: (Extractable (NodeRes a), Extractable (RelRes a), MonadIO m) => [NodeName] -> [(NodeName, NodeName)] -> [Record] -> BoltActionT m [Graph NodeName (NodeRes a) (RelRes a)] Source #
Abstract function which exctracts graph from records if nodes and relations can be extracted.
makeRequest :: (Requestable (NodeName, NodeReq a), Requestable ((NodeName, NodeName), RelReq a), Returnable (NodeName, NodeReq a), Returnable ((NodeName, NodeName), RelReq a), Extractable (NodeRes a), Extractable (RelRes a), MonadIO m) => [Text] -> Graph NodeName (NodeReq a) (RelReq a) -> BoltActionT m [Graph NodeName (NodeRes a) (RelRes a)] Source #
For given query graph, perform query and extract results graph.
Instances
class Requestable a where Source #
Entity which can be requested from Neo4j in MATCH operator.
Instances
| Requestable (NodeName, NodeGetter) Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get | |
| Requestable (NodeName, PutNode) Source # | |
| Requestable ((NodeName, NodeName), RelGetter) Source # | |
| Requestable ((NodeName, NodeName), PutRelationship) Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Put | |
class Returnable a where Source #
Entity  which can be returned from Neo4j in RETURN operator.
Methods
isReturned' :: a -> Bool Source #
If the entity should be returned.
How to return entity in the Cypher.
Instances
| Returnable (NodeName, NodeGetter) Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get Methods isReturned' :: (NodeName, NodeGetter) -> Bool Source # | |
| Returnable (NodeName, PutNode) Source # | |
| Returnable ((NodeName, NodeName), RelGetter) Source # | |
| Returnable ((NodeName, NodeName), PutRelationship) Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Put Methods isReturned' :: ((NodeName, NodeName), PutRelationship) -> Bool Source # return' :: ((NodeName, NodeName), PutRelationship) -> Text Source # | |
class Extractable a where Source #
Entity which can be extracted from Record by its name.
Instances
| Extractable NodeResult Source # | |
| Defined in Database.Bolt.Extras.Graph.Internal.Get Methods extract :: forall (m :: Type -> Type). MonadIO m => Text -> [Record] -> BoltActionT m [NodeResult] Source # | |
| Extractable RelResult Source # | |
| Extractable BoltId Source # | |
relationName :: (NodeName, NodeName) -> Text Source #
Build relationship name from the names of its start and end nodes
 like [startNodeName]0[endNodeName].
requestGetters :: [(NodeName, NodeGetter)] -> [((NodeName, NodeName), RelGetter)] -> (Text, [Text]) Source #
Takes all node getters and relationship getters and write them to single query to request. Also return conditions on known boltId-s.
requestPut :: [(NodeName, PutNode)] -> [((NodeName, NodeName), PutRelationship)] -> (Text, [Text]) Source #
Takes all PutNodes and PutRelationships
 and write them to single query to request.
 Here WITH is used, because you cannot perform
 "match", "merge" or "create" at the same query.