hasbolt-extras 0.0.0.16 → 0.0.0.17
raw patch · 10 files changed
+252/−70 lines, 10 files
Files
- CHANGELOG.md +4/−0
- hasbolt-extras.cabal +1/−1
- src/Database/Bolt/Extras/Graph.hs +131/−5
- src/Database/Bolt/Extras/Graph/Internal/AbstractGraph.hs +25/−11
- src/Database/Bolt/Extras/Graph/Internal/Class.hs +3/−3
- src/Database/Bolt/Extras/Graph/Internal/Get.hs +31/−14
- src/Database/Bolt/Extras/Graph/Internal/GraphQuery.hs +31/−24
- src/Database/Bolt/Extras/Graph/Internal/Put.hs +10/−4
- src/Database/Bolt/Extras/Internal/Condition.hs +13/−6
- src/Database/Bolt/Extras/Template/Internal/Converters.hs +3/−2
CHANGELOG.md view
@@ -6,6 +6,10 @@ ## [Unreleased] +## [0.0.0.17] - 2019-05-09+### Changed+- Expanded documentation for `Database.Bolt.Extras.Graph`.+ ## [0.0.0.16] - 2019-02-01 ### Changed - Optimized query, easy way to extract entities from result graph.
hasbolt-extras.cabal view
@@ -1,5 +1,5 @@ name: hasbolt-extras-version: 0.0.0.16+version: 0.0.0.17 synopsis: Extras for hasbolt library description: Extras for hasbolt library homepage: https://github.com/biocad/hasbolt-extras#readme
src/Database/Bolt/Extras/Graph.hs view
@@ -1,10 +1,136 @@+{-|++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 'Data.Function.&' operator.++A complete example of running Get and Put queries can be found in "@example/Main.hs@" file in this+repository.++-}+ module Database.Bolt.Extras.Graph (- module Database.Bolt.Extras.Graph.Internal.AbstractGraph- , module Database.Bolt.Extras.Graph.Internal.Class- , module Database.Bolt.Extras.Graph.Internal.Get- , module Database.Bolt.Extras.Graph.Internal.GraphQuery- , module Database.Bolt.Extras.Graph.Internal.Put+ -- * 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"+ --+ Graph(..), vertices, relations,+ emptyGraph, addNode, addRelation,++ -- * 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 'Database.Bolt.Extras.NodeLike'+ -- or 'Database.Bolt.Extras.URelationshipLike') from the result.++ -- ** Getter types+ GetRequest,+ GetterLike(..),+ NodeGetter(..), RelGetter(..),+ GraphGetRequest,++ -- ** Default getters+ defaultNode, defaultNodeReturn, defaultNodeNotReturn,+ defaultRel, defaultRelReturn, defaultRelNotReturn,+ allProps,++ -- ** Result types+ NodeResult(..), RelResult(..),+ GraphGetResponse,++ -- ** 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, extractRelation,+ extractNodeId, extractRelationId,+ extractNodeAeson, extractRelationAeson,+ mergeGraphs,++ -- * 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.+ PutRequest,+ PutNode(..), PutRelationship(..),+ GraphPutRequest, GraphPutResponse,++ -- * Internal machinery for forming Cypher queries+ GraphQuery(..),+ Requestable(..), Returnable(..), Extractable(..),+ NodeName, relationName,+ requestGetters, requestPut,++ (#), ) where import Database.Bolt.Extras.Graph.Internal.AbstractGraph
src/Database/Bolt/Extras/Graph/Internal/AbstractGraph.hs view
@@ -21,32 +21,46 @@ import GHC.Generics (Generic) import Text.Printf (printf) --- | 'Graph' contains vertices, that are parameterized by some type @n@, and relations,--- that parameterized by pair of type @n@. This pair represents vertices, that are connected with this relation.+-- | 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.+--+-- There are lenses defined for 'Graph': 'vertices' and 'relations'.+-- data Graph n a b = Graph { _vertices :: Map n a , _relations :: Map (n, n) b } deriving (Show, Generic) makeLenses ''Graph --- | Creates empty graph.+-- | An empty graph. -- emptyGraph :: Ord n => Graph n a b emptyGraph = Graph mempty mempty --- | Adds node to graph by it's @name@ and @node@ content.--- If graph already contains vertex with given @name@, error will be thrown.+-- | Adds node to graph by its name and data.+-- If graph already contains node with given @name@, @error@ will be thrown. ---addNode :: (Show n, Ord n) => n -> a -> Graph n a b -> Graph n a b+addNode :: (Show n, Ord n)+ => n -- ^ Name of the node+ -> a -- ^ Node data+ -> Graph n a b -> Graph n a b addNode name node graph = if name `notMember` _vertices graph then over vertices (insert name node) graph else error . printf "vertex with name %s key already exists" . show $ name --- | Adds relation to graph by @startName@ of vertex, @endName@ of vertex, and @rel@ with relation content.--- If graph already contains relation with given @(startName, endName)@, error will be thrown.+-- | 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. ---addRelation :: (Show n, Ord n) => n -> n -> b -> Graph n a b -> Graph n a b+addRelation :: (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 addRelation startName endName rel graph = if (startName, endName) `notMember` _relations graph then over relations (insert (startName, endName) rel) graph else error $ printf "relation with names (%s, %s) already exists" (show startName) (show endName)@@ -55,7 +69,7 @@ -- type NodeName = Text --- | Creates relationship name from the names of its start and end nodes--- in the way `<startNodeName>0<endNodeName>`.+-- | Build relationship name from the names of its start and end nodes+-- like @[startNodeName]0[endNodeName]@. relationName :: (NodeName, NodeName) -> Text relationName (st, en) = st <> "0" <> en
src/Database/Bolt/Extras/Graph/Internal/Class.hs view
@@ -9,13 +9,13 @@ import Data.Text (Text) import Database.Bolt (BoltActionT, Record) --- | Class describes entity, which can be requested.+-- | Entity which can be requested from Neo4j in @MATCH@ operator. -- class Requestable a where -- | How to convert entity to Cypher. request :: a -> Text --- | Class describes entity, which can be returned.+-- | Entity which can be returned from Neo4j in @RETURN@ operator. -- class Returnable a where -- | If the entity should be returned.@@ -24,7 +24,7 @@ -- | How to return entity in the Cypher. return' :: a -> Text --- | Class describes entity, which can be extracted from records by name.+-- | Entity which can be extracted from 'Record' by its name. -- class Extractable a where extract :: MonadIO m => Text -> [Record] -> BoltActionT m [a]
src/Database/Bolt/Extras/Graph/Internal/Get.hs view
@@ -99,54 +99,64 @@ -- | Helper to find 'Node's. ---data NodeGetter = NodeGetter { ngboltId :: Maybe BoltId -- ^ known boltId+data NodeGetter = NodeGetter { ngboltId :: Maybe BoltId -- ^ known 'BoltId' , ngLabels :: [Label] -- ^ known labels , ngProps :: Map Text B.Value -- ^ known properties , ngReturnProps :: [Text] -- ^ names of properties to return- , ngIsReturned :: Bool -- ^ whether return this node or not+ , ngIsReturned :: Bool -- ^ whether to return this node or not } deriving (Show, Eq) -- | Helper to find 'URelationship's. ---data RelGetter = RelGetter { rgboltId :: Maybe BoltId -- ^ known boltId+data RelGetter = RelGetter { rgboltId :: Maybe BoltId -- ^ known 'BoltId' , rgLabel :: Maybe Label -- ^ known labels , rgProps :: Map Text B.Value -- ^ known properties , rgReturnProps :: [Text] -- ^ names of properties to return- , rgIsReturned :: Bool -- ^ whether return this relation or not+ , rgIsReturned :: Bool -- ^ whether to return this relation or not } deriving (Show, Eq) +-- | A synonym for '&'. Kept for historical reasons. (#) :: a -> (a -> b) -> b (#) = (&) -defaultNode :: Bool -> NodeGetter+-- | 'NodeGetter' that matches any node.+defaultNode :: Bool -- ^ Whether to return the node+ -> NodeGetter defaultNode = NodeGetter Nothing [] (fromList []) [] -defaultRel :: Bool -> RelGetter+-- | 'RelGetter' that matches any relation.+defaultRel :: Bool -- ^ Whether to return the relation+ -> RelGetter defaultRel = RelGetter Nothing Nothing (fromList []) [] +-- | 'NodeGetter' that matches any node and returns it. defaultNodeReturn :: NodeGetter defaultNodeReturn = defaultNode True +-- | 'NodeGetter' that matches any node and does not return it. defaultNodeNotReturn :: NodeGetter defaultNodeNotReturn = defaultNode False +-- | 'RelGetter' that matches any relation and returns it. defaultRelReturn :: RelGetter defaultRelReturn = defaultRel True ++-- | 'RelGetter' that matches any relation and does not return it. defaultRelNotReturn :: RelGetter defaultRelNotReturn = defaultRel False --- | Helper to work with Getters.+-- | Endomorphisms to set up 'NodeGetter' and 'RelGetter'. -- class GetterLike a where- withBoltId :: BoltId -> a -> a -- ^ set known boltId+ withBoltId :: BoltId -> a -> a -- ^ set known 'BoltId' withLabel :: Label -> a -> a -- ^ set known label- withLabelQ :: Name -> a -> a -- ^ set known label as 'Name'+ withLabelQ :: Name -> a -> a -- ^ set known label as TemplateHaskell 'Name' withProp :: (Text, B.Value) -> a -> a -- ^ add known property withReturn :: [Text] -> a -> a -- ^ add list of properties to return- isReturned :: a -> a -- ^ set that current node should be returned+ isReturned :: a -> a -- ^ set that entity should be returned instance GetterLike NodeGetter where withBoltId boltId ng = ng { ngboltId = Just boltId }@@ -198,6 +208,7 @@ } as $name |] +-- | Return all properties of a node or relation. To be used with 'withReturn'. allProps :: [Text] allProps = ["*"] @@ -227,7 +238,7 @@ -- RESULT -- ---------------------------------------------------------- --- | Result for node in the Aeson like format.+-- | Result for node where properties are represented as @aeson@ 'A.Value'. -- data NodeResult = NodeResult { nresId :: BoltId , nresLabels :: [Label]@@ -235,7 +246,7 @@ } deriving (Show, Eq, Generic) --- | Result for relationship in the Aeson like format.+-- | Result for relation where properties are represented as @aeson@ 'A.Value'. -- data RelResult = RelResult { rresId :: BoltId , rresLabel :: Label@@ -290,7 +301,7 @@ -- GRAPH -- ---------------------------------------------------------- --- | The combinations of 'Getter's to load graph from the database.+-- | The combinations of getters to load graph from the database. -- type GraphGetRequest = Graph NodeName NodeGetter RelGetter @@ -298,27 +309,33 @@ -- type GraphGetResponse = Graph NodeName NodeResult RelResult --- | Some helpers to extract entities from the result graph. +-- | Extract a node by its name from 'GraphGetResponse' and convert it to user type+-- with 'fromNode'. extractNode :: NodeLike a => NodeName -> GraphGetResponse -> a extractNode var graph = graph ^. vertices . at var . non (errorForNode var) . to (fromNode . toNode) +-- | Extract a relation by name of it start and end nodes and convert to user type with 'fromURelation'. extractRelation :: URelationLike a => NodeName -> NodeName -> GraphGetResponse -> a extractRelation stVar enVar graph = graph ^. relations . at (stVar, enVar) . non (errorForRelation stVar enVar) . to (fromURelation . toURelation) +-- | Extract just node's 'BoltId'. extractNodeId :: NodeName -> GraphGetResponse -> BoltId extractNodeId var graph = graph ^. vertices . at var . non (errorForNode var) . to nresId +-- | Extract just relation's 'BoltId'. extractRelationId :: NodeName -> NodeName -> GraphGetResponse -> BoltId extractRelationId stVar enVar graph = graph ^. relations . at (stVar, enVar) . non (errorForRelation stVar enVar) . to rresId +-- | Extract 'NodeResult'. extractNodeAeson :: NodeName -> GraphGetResponse -> NodeResult extractNodeAeson var graph = graph ^. vertices . at var . non (errorForNode var) +-- | Extract 'RelResult'. extractRelationAeson :: NodeName -> NodeName -> GraphGetResponse -> RelResult extractRelationAeson stVar enVar graph = graph ^. relations . at (stVar, enVar) . non (errorForRelation stVar enVar)
src/Database/Bolt/Extras/Graph/Internal/GraphQuery.hs view
@@ -50,19 +50,19 @@ requestPut) import NeatInterpolation (text) --- | Type family used to perform requests to the Neo4j based on graphs.+-- | Type class used to perform requests to the Neo4j based on graphs. -- class GraphQuery a where- -- | Type of entity, describing node for request.+ -- | Type of entity describing node for request. type NodeReq a :: *- -- | Type of entity, describing relationship for request.+ -- | Type of entity describing relationship for request. type RelReq a :: *- -- | Type of node entity, which will be extracted from result.+ -- | Type of node entity which will be extracted from result. type NodeRes a :: *- -- | Type of relationship entity, which will be extracted from result.+ -- | Type of relationship entity which will be extracted from result. type RelRes a :: * - -- | How to convert requestable entities to text in the query.+ -- | Convert requestable entities to text in the query. requestEntities :: (Requestable (NodeName, NodeReq a), Requestable ((NodeName, NodeName), RelReq a)) => [(NodeName, NodeReq a)]@@ -75,9 +75,9 @@ Requestable ((NodeName, NodeName), RelReq a), Returnable (NodeName, NodeReq a), Returnable ((NodeName, NodeName), RelReq a))- => [Text]- -> Graph NodeName (NodeReq a) (RelReq a)- -> Text+ => [Text] -- ^ Custom conditions that will be added to @WHERE@ block.+ -> Graph NodeName (NodeReq a) (RelReq a) -- ^ Request graph template.+ -> Text -- ^ Cypher query as text. formQuery customConds graph = [text|$completeRequest $conditionsQ WITH DISTINCT $distinctVars@@ -97,7 +97,7 @@ completeReturn = intercalate ", " $ Prelude.filter (not . T.null) $ returnVertices ++ returnRelations - -- | Abstract function, which exctracts graph from records if nodes and relations can be extracted.+ -- | Abstract function which exctracts graph from records if nodes and relations can be extracted. -- extractGraphs :: (Extractable (NodeRes a), Extractable (RelRes a), MonadIO m) => [NodeName]@@ -160,24 +160,31 @@ requestEntities = requestPut -- | 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 presented only once in the database--- and B was presented only two times in the database.+-- 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.+-- 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],+--+-- @+-- 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].+--+-- @+-- 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].+-- @ -- mergeGraphs :: GetBoltId a => [Graph NodeName a b] -> Graph NodeName a b mergeGraphs graphs = foldl' mergeGraph emptyGraph (updateGraph <$> graphs)
src/Database/Bolt/Extras/Graph/Internal/Put.hs view
@@ -36,15 +36,21 @@ ------------------------------------------------------------------------------------------------ -- REQUEST -- --------------------------------------------------------------------------------------------------- | BOLT FORMAT+-- BOLT FORMAT -- | 'PutNode' is the wrapper for 'Node' where we can specify if we want to merge or create it. ---data PutNode = BoltId BoltId | MergeN Node | CreateN Node+data PutNode+ = BoltId BoltId -- ^ Describe existing node by its 'Database.Bolt.Extras.BoltId'. No new data will be inserted for this node.+ | MergeN Node -- ^ Merge the 'Node' with existing node in the DB. Corresponds to @MERGE@ Cypher operator.+ | CreateN Node -- ^ Create an entirely new node. Corresponds to @CREATE@ Cypher operator. deriving (Show) --- | 'PutRelationship' is the wrapper for 'Relationship' where we can specify if we want to merge or create it.+-- | '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'.+-- data PutRelationship = MergeR URelationship | CreateR URelationship deriving (Show) @@ -124,7 +130,7 @@ -- type GraphPutRequest = Graph NodeName PutNode PutRelationship --- | The graph of 'BoltId's corresponding to the nodes and relationships+-- | The graph of 'Database.Bolt.Extras.BoltId's corresponding to the nodes and relationships -- which we get after putting 'GraphPutRequest'. -- type GraphPutResponse = Graph NodeName BoltId BoltId
src/Database/Bolt/Extras/Internal/Condition.hs view
@@ -10,13 +10,16 @@ -- | Conditional expressions over type 'a' and its mappings. -- Supported operations:--- * equality check :==--- * disunction :&&--- * conjunction :|| --+-- * equality check ':=='+-- * disunction ':&&'+-- * conjunction ':||'+-- -- Typical usage:--- Say we have variable 'var :: a', a function 'f :: a -> b' and a value 'val :: b'.--- Expression 'f :== b' acts as 'f a == b'+--+-- Say we have variable @var :: a@, a function @f :: a -> b@ and a value @val :: b@.+-- Expression @f :== val@ acts as @f var == val@.+-- -- Examples: -- -- > data D = D { fld1 :: Int@@ -48,8 +51,11 @@ -- | Matching 'tautology' will always succeed.+-- -- > whatever `matches` tautology == True--- > -- Match is lazy:+--+-- Match is lazy:+-- -- > undefined `matches` tautology == True -- tautology :: Condition a@@ -57,6 +63,7 @@ -- | Object itself instead of its mappings is matched with help of this alias.+-- -- > 42 `matches` (itself :== 42) == True -- > 42 `matches` (itself :== 41) == False --
src/Database/Bolt/Extras/Template/Internal/Converters.hs view
@@ -61,12 +61,13 @@ -- > , quuz :: Int -- > } ----- You can make it instance of NodeClass by writing+-- You can make it instance of 'NodeLike' by writing+-- -- > makeNodeLike ''Foo -- -- Then you may create example and convert it into from from Node: ----- > ghci>:set -XOverloadedStrings+-- > ghci> :set -XOverloadedStrings -- > ghci> let foo = Bar 42.0 "Loren ipsum" 7 -- > ghci> toNode foo -- > Node {nodeIdentity = -1, labels = ["Foo"], nodeProps = fromList [("baz",F 42.0),("quux",T "Loren ipsum"),("quuz",I 7)]}