Safe Haskell | None |
---|---|
Language | Haskell2010 |
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 namesa
: type of nodesb
: type of relations
Relations are described by a pair of nodes - start and end.
Graph | |
|
Instances
(Show n, Show a, Show b) => Show (Graph n a b) Source # | |
Generic (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.1.7-3FlaUg4g8ip6QmPMDATn4z" '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.
:: (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
.
:: Label | |
-> a | |
-> a | set known label |
:: [Text] | |
-> a | |
-> a | add list of properties to return |
:: a | |
-> a | set that entity should be returned |
Instances
GetterLike RelGetter Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Get 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 # | |
GetterLike NodeGetter Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Get 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 # |
data NodeGetter Source #
Helper to find Node
s.
Instances
Helper to find URelationship
s.
Instances
Eq RelGetter Source # | |
Show RelGetter Source # | |
GetterLike RelGetter Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Get 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 # | |
Returnable ((NodeName, NodeName), RelGetter) Source # | |
Requestable ((NodeName, NodeName), RelGetter) Source # | |
type GraphGetRequest = Graph NodeName NodeGetter RelGetter Source #
The combinations of getters to load graph from the database.
Default getters
:: 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
.
Instances
Result for relation where properties are represented as aeson
Value
.
Instances
Eq RelResult Source # | |
Show RelResult Source # | |
Generic RelResult Source # | |
ToJSON RelResult Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Get | |
FromJSON RelResult Source # | |
Extractable RelResult Source # | |
GetBoltId RelResult Source # | |
URelationLike RelResult Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Get | |
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.1.7-3FlaUg4g8ip6QmPMDATn4z" '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 Node
s and URelationship
s 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 BoltId
s.
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 BoltId
s of uploaded entities as result.
Instances
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
.
Instances
Show PutRelationship Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Put showsPrec :: Int -> PutRelationship -> ShowS # show :: PutRelationship -> String # showList :: [PutRelationship] -> ShowS # | |
Returnable ((NodeName, NodeName), PutRelationship) Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Put isReturned' :: ((NodeName, NodeName), PutRelationship) -> Bool Source # return' :: ((NodeName, NodeName), PutRelationship) -> Text Source # | |
Requestable ((NodeName, NodeName), PutRelationship) Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Put |
type GraphPutRequest = Graph NodeName PutNode PutRelationship Source #
The graph of Node
s with specified uploading type and URelationship
s.
type GraphPutResponse = Graph NodeName BoltId BoltId Source #
The graph of BoltId
s 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.
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.
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.
:: (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, NodeName), RelGetter) Source # | |
Requestable ((NodeName, NodeName), PutRelationship) Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Put | |
Requestable (NodeName, NodeGetter) Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Get | |
Requestable (NodeName, PutNode) Source # | |
class Returnable a where Source #
Entity which can be returned from Neo4j in RETURN
operator.
isReturned' :: a -> Bool Source #
If the entity should be returned.
How to return entity in the Cypher.
Instances
Returnable ((NodeName, NodeName), RelGetter) Source # | |
Returnable ((NodeName, NodeName), PutRelationship) Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Put isReturned' :: ((NodeName, NodeName), PutRelationship) -> Bool Source # return' :: ((NodeName, NodeName), PutRelationship) -> Text Source # | |
Returnable (NodeName, NodeGetter) Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Get isReturned' :: (NodeName, NodeGetter) -> Bool Source # | |
Returnable (NodeName, PutNode) Source # | |
class Extractable a where Source #
Entity which can be extracted from Record
by its name.
Instances
Extractable BoltId Source # | |
Extractable RelResult Source # | |
Extractable NodeResult Source # | |
Defined in Database.Bolt.Extras.Graph.Internal.Get extract :: forall (m :: Type -> Type). MonadIO m => Text -> [Record] -> BoltActionT m [NodeResult] 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 PutNode
s and PutRelationship
s
and write them to single query to request.
Here WITH is used, because you cannot perform
"match", "merge" or "create" at the same query.