diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,10 @@ ## [Unreleased] +## [0.0.0.16] - 2019-02-01 +### Changed +- Optimized query, easy way to extract entities from result graph. + ## [0.0.0.15] - 2019-01-22 ### Changed - Ability to choose whether to return entity or not in graphs. diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -11,7 +11,6 @@ import Data.Aeson (encode) import qualified Data.ByteString.Lazy.Char8 as B (putStrLn) import Data.Default (def) -import Data.Map.Strict ((!)) import Data.Text (Text) import Database.Bolt (BoltActionT, BoltCfg (..), Value (..), close, connect, run) @@ -105,7 +104,7 @@ -- putGraph :: IO () putGraph = do - putGraphR <- runQueryDB $ makeRequest @PutRequestB [] examplePutGraph + putGraphR <- runQueryDB $ makeRequest @PutRequest [] examplePutGraph putStrLn "Uploaded graph: " print putGraphR @@ -113,8 +112,8 @@ -- getGraphB :: IO () getGraphB = do - getGraphsR <- runQueryDB $ makeRequest @GetRequestB [] exampleGetGraphB - let nodesA :: [ExampleNode] = fromNode . (! exNodeAVar) . _vertices <$> getGraphsR + getGraphsR <- runQueryDB $ makeRequest @GetRequest [] exampleGetGraphB + let nodesA :: [ExampleNode] = extractNode exNodeAVar <$> getGraphsR putStrLn "Downloaded graph and converted to Haskell object: " print nodesA @@ -122,8 +121,8 @@ -- getGraphA :: IO () getGraphA = do - getGraphsR <- runQueryDB $ makeRequest @GetRequestA [] exampleGetGraphA - let nodesA = (! exNodeAVar) . _vertices <$> getGraphsR + getGraphsR <- runQueryDB $ makeRequest @GetRequest [] exampleGetGraphA + let nodesA = extractNodeAeson exNodeAVar <$> getGraphsR putStrLn "Downloaded graph and converted to JSON: " B.putStrLn . encode $ nodesA diff --git a/hasbolt-extras.cabal b/hasbolt-extras.cabal --- a/hasbolt-extras.cabal +++ b/hasbolt-extras.cabal @@ -1,5 +1,5 @@ name: hasbolt-extras -version: 0.0.0.15 +version: 0.0.0.16 synopsis: Extras for hasbolt library description: Extras for hasbolt library homepage: https://github.com/biocad/hasbolt-extras#readme diff --git a/src/Database/Bolt/Extras/Graph/Internal/Get.hs b/src/Database/Bolt/Extras/Graph/Internal/Get.hs --- a/src/Database/Bolt/Extras/Graph/Internal/Get.hs +++ b/src/Database/Bolt/Extras/Graph/Internal/Get.hs @@ -6,7 +6,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -31,10 +30,18 @@ , relationName -- * Graph types , GraphGetRequest - , GraphGetResponseA - , GraphGetResponseB + , GraphGetResponse + -- * Helpers to extract entities from result graph + , extractNode + , extractRelation + , extractNodeId + , extractRelationId + , extractNodeAeson + , extractRelationAeson ) where +import Control.Lens (at, non, to, + (^.)) import Control.Monad.IO.Class (MonadIO) import Data.Aeson as A (FromJSON (..), Result (..), @@ -60,7 +67,8 @@ import Data.Monoid ((<>)) import Data.Text (Text, cons, intercalate, - pack) + pack, + unpack) import Database.Bolt as B (BoltActionT, Node (..), Record, @@ -73,7 +81,9 @@ URelationLike (..)) import Database.Bolt.Extras.Graph.Internal.AbstractGraph (Graph, NodeName, - relationName) + relationName, + relations, + vertices) import Database.Bolt.Extras.Graph.Internal.Class (Extractable (..), Requestable (..), Returnable (..)) @@ -217,8 +227,6 @@ -- RESULT -- ---------------------------------------------------------- --- | AESON FORMAT - -- | Result for node in the Aeson like format. -- data NodeResult = NodeResult { nresId :: BoltId @@ -261,17 +269,6 @@ instance Extractable RelResult where extract = extractFromJSON ----------------------------------------------------------- --- | BOLT FORMAT - -instance Extractable Node where - extract :: forall m. MonadIO m => Text -> [Record] -> BoltActionT m [Node] - extract t rec = fmap toNode <$> extractFromJSON @ _ @ NodeResult t rec - -instance Extractable URelationship where - extract :: forall m. MonadIO m => Text -> [Record] -> BoltActionT m [URelationship] - extract t rec = fmap toURelation <$> extractFromJSON @ _ @ RelResult t rec - extractFromJSON :: (MonadIO m, FromJSON a) => Text -> [Record] -> BoltActionT m [a] extractFromJSON var = pure . fmap (\r -> case fromJSON (toJSON (r ! var)) of Success parsed -> parsed @@ -290,19 +287,46 @@ fromURelation URelationship{..} = RelResult urelIdentity urelType (toJSON <$> urelProps) ---------------------------------------------------------- --- GRAPH TYPES -- +-- GRAPH -- ---------------------------------------------------------- -- | The combinations of 'Getter's to load graph from the database. -- type GraphGetRequest = Graph NodeName NodeGetter RelGetter --- | The graph of 'Node's and 'URelationship's which we got from the database using 'GraphGetRequest', --- converted to the Aeson Value like. +-- | The graph of 'Node's and 'URelationship's which we got from the database using 'GraphGetRequest'. -- -type GraphGetResponseA = Graph NodeName NodeResult RelResult +type GraphGetResponse = Graph NodeName NodeResult RelResult --- | The graph of 'Node's and 'URelationship's which we got from the database using 'GraphGetRequest', --- converted to the Bolt Value like. --- -type GraphGetResponseB = Graph NodeName Node URelationship +-- | Some helpers to extract entities from the result graph. + +extractNode :: NodeLike a => NodeName -> GraphGetResponse -> a +extractNode var graph = graph ^. vertices . at var . non (errorForNode var) . to (fromNode . toNode) + +extractRelation :: URelationLike a => NodeName -> NodeName -> GraphGetResponse -> a +extractRelation stVar enVar graph = graph ^. relations . at (stVar, enVar) + . non (errorForRelation stVar enVar) + . to (fromURelation . toURelation) + +extractNodeId :: NodeName -> GraphGetResponse -> BoltId +extractNodeId var graph = graph ^. vertices . at var . non (errorForNode var) . to nresId + +extractRelationId :: NodeName -> NodeName -> GraphGetResponse -> BoltId +extractRelationId stVar enVar graph = graph ^. relations . at (stVar, enVar) + . non (errorForRelation stVar enVar) + . to rresId + +extractNodeAeson :: NodeName -> GraphGetResponse -> NodeResult +extractNodeAeson var graph = graph ^. vertices . at var . non (errorForNode var) + +extractRelationAeson :: NodeName -> NodeName -> GraphGetResponse -> RelResult +extractRelationAeson stVar enVar graph = graph ^. relations . at (stVar, enVar) + . non (errorForRelation stVar enVar) + +errorForNode :: NodeName -> a +errorForNode name = error . unpack $ "node with name " <> name <> " doesn't exist" + +errorForRelation :: NodeName -> NodeName -> a +errorForRelation stName enName = error . unpack $ "relation between nodes " <> + stName <> " and " <> enName <> + " doesn't exist" diff --git a/src/Database/Bolt/Extras/Graph/Internal/GraphQuery.hs b/src/Database/Bolt/Extras/Graph/Internal/GraphQuery.hs --- a/src/Database/Bolt/Extras/Graph/Internal/GraphQuery.hs +++ b/src/Database/Bolt/Extras/Graph/Internal/GraphQuery.hs @@ -11,9 +11,8 @@ module Database.Bolt.Extras.Graph.Internal.GraphQuery ( GraphQuery (..) - , GetRequestA (..) - , GetRequestB (..) - , PutRequestB (..) + , GetRequest (..) + , PutRequest (..) , mergeGraphs ) where @@ -30,9 +29,7 @@ null, pack) import Database.Bolt (BoltActionT, - Node, Record, - URelationship, query) import Database.Bolt.Extras (BoltId, GetBoltId (..)) import Database.Bolt.Extras.Graph.Internal.AbstractGraph (Graph (..), @@ -83,10 +80,12 @@ -> Text formQuery customConds graph = [text|$completeRequest $conditionsQ - RETURN DISTINCT $completeReturn|] + WITH DISTINCT $distinctVars + RETURN $completeReturn|] where vertices' = toList (graph ^. vertices) relations' = toList (graph ^. relations) + distinctVars = intercalate ", " $ fmap fst vertices' ++ fmap (relationName . fst) relations' (completeRequest, reqConds) = requestEntities @a vertices' relations' @@ -134,29 +133,16 @@ -- GET -- --------------------------------------------------------------------------------------- --- | Get request with result in Aeson format. --- Easy way to show result graphs. --- -data GetRequestA = GetRequestA - --- | Get request with result in Bolt format. --- Easy way to extract results and convert them to another entities (using 'fromNode'). +-- | Get request with graph result. -- -data GetRequestB = GetRequestB - -instance GraphQuery GetRequestA where - type NodeReq GetRequestA = NodeGetter - type RelReq GetRequestA = RelGetter - type NodeRes GetRequestA = NodeResult - type RelRes GetRequestA = RelResult - requestEntities = requestGetters +data GetRequest = GetRequest -instance GraphQuery GetRequestB where - type NodeReq GetRequestB = NodeGetter - type RelReq GetRequestB = RelGetter - type NodeRes GetRequestB = Node - type RelRes GetRequestB = URelationship - requestEntities = requestGetters +instance GraphQuery GetRequest where + type NodeReq GetRequest = NodeGetter + type RelReq GetRequest = RelGetter + type NodeRes GetRequest = NodeResult + type RelRes GetRequest = RelResult + requestEntities = requestGetters --------------------------------------------------------------------------------------- -- PUT -- @@ -164,13 +150,13 @@ -- | Put request in Bolt format with 'BoltId's of uploaded entities as result. -- -data PutRequestB = PutRequestB +data PutRequest = PutRequest -instance GraphQuery PutRequestB where - type NodeReq PutRequestB = PutNode - type RelReq PutRequestB = PutRelationship - type NodeRes PutRequestB = BoltId - type RelRes PutRequestB = BoltId +instance GraphQuery PutRequest where + type NodeReq PutRequest = PutNode + type RelReq PutRequest = PutRelationship + type NodeRes PutRequest = BoltId + type RelRes PutRequest = BoltId requestEntities = requestPut -- | Helper function to merge graphs of results, i.e. diff --git a/src/Database/Bolt/Extras/Internal/Instances.hs b/src/Database/Bolt/Extras/Internal/Instances.hs --- a/src/Database/Bolt/Extras/Internal/Instances.hs +++ b/src/Database/Bolt/Extras/Internal/Instances.hs @@ -11,9 +11,10 @@ import Data.Aeson.Types (Parser) import Data.Map.Strict (Map) import Data.Text (Text) -import Database.Bolt (Value (..)) +import Database.Bolt (Node, Value (..)) import qualified Database.Bolt as DB (Structure) import Database.Bolt.Extras.Internal.Types (FromValue (..), + NodeLike (..), ToValue (..)) import Database.Bolt.Extras.Utils (currentLoc) import GHC.Float (double2Float, @@ -115,3 +116,7 @@ <|> L <$> (parseJSON v :: Parser [Value]) <|> M <$> (parseJSON v :: Parser (Map Text Value)) <|> error "Database.Bolt.Extras.Internal.Instances: could not convert from json Database.Bolt.Value" + +instance NodeLike Node where + toNode = id + fromNode = id