Skip to content

Commit

Permalink
version 0.0.0.16: optimized query, easy result extraction (#23)
Browse files Browse the repository at this point in the history
  • Loading branch information
@Cheshirrrrrr @ozzzzz
Cheshirrrrrr authored and ozzzzz committed Feb 1, 2019
1 parent fec4376 commit 64abb0d
Show file tree
Hide file tree
Showing 6 changed files with 85 additions and 67 deletions.
4 changes: 4 additions & 0 deletions CHANGELOG.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,10 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.

## [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.
Expand Down
11 changes: 5 additions & 6 deletions example/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,6 @@ import Control.Monad.State (execState, modify)
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)
Expand Down Expand Up @@ -105,25 +104,25 @@ exampleGetGraphA = flip execState emptyGraph $
--
putGraph :: IO ()
putGraph = do
putGraphR <- runQueryDB $ makeRequest @PutRequestB [] examplePutGraph
putGraphR <- runQueryDB $ makeRequest @PutRequest [] examplePutGraph
putStrLn "Uploaded graph: "
print putGraphR

-- Get 'exampleGetGraphB' and parse it to Haskell object.
--
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

-- Get 'exampleGetGraphA' and parse it to JSON.
--
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

Expand Down
2 changes: 1 addition & 1 deletion hasbolt-extras.cabal
View file
Original file line number Diff line number Diff line change
@@ -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
Expand Down
76 changes: 50 additions & 26 deletions src/Database/Bolt/Extras/Graph/Internal/Get.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,6 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

Expand All @@ -31,10 +30,18 @@ module Database.Bolt.Extras.Graph.Internal.Get
, 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 (..),
Expand All @@ -60,7 +67,8 @@ import Data.Maybe (catMaybes,
import Data.Monoid ((<>))
import Data.Text (Text, cons,
intercalate,
pack)
pack,
unpack)
import Database.Bolt as B (BoltActionT,
Node (..),
Record,
Expand All @@ -73,7 +81,9 @@ import Database.Bolt.Extras (BoltId, GetB
URelationLike (..))
import Database.Bolt.Extras.Graph.Internal.AbstractGraph (Graph,
NodeName,
relationName)
relationName,
relations,
vertices)
import Database.Bolt.Extras.Graph.Internal.Class (Extractable (..),
Requestable (..),
Returnable (..))
Expand Down Expand Up @@ -217,8 +227,6 @@ requestGetters ngs rgs = ("MATCH " <> intercalate ", " (fmap request rgs ++ fmap
-- RESULT --
----------------------------------------------------------

-- | AESON FORMAT

-- | Result for node in the Aeson like format.
--
data NodeResult = NodeResult { nresId :: BoltId
Expand Down Expand Up @@ -261,17 +269,6 @@ instance Extractable NodeResult where
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
Expand All @@ -290,19 +287,46 @@ instance URelationLike RelResult where
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"
52 changes: 19 additions & 33 deletions src/Database/Bolt/Extras/Graph/Internal/GraphQuery.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,8 @@
module Database.Bolt.Extras.Graph.Internal.GraphQuery
(
GraphQuery (..)
, GetRequestA (..)
, GetRequestB (..)
, PutRequestB (..)
, GetRequest (..)
, PutRequest (..)
, mergeGraphs
) where

Expand All @@ -30,9 +29,7 @@ import Data.Text as T (Text, i
null,
pack)
import Database.Bolt (BoltActionT,
Node,
Record,
URelationship,
query)
import Database.Bolt.Extras (BoltId, GetBoltId (..))
import Database.Bolt.Extras.Graph.Internal.AbstractGraph (Graph (..),
Expand Down Expand Up @@ -83,10 +80,12 @@ class GraphQuery a where
-> 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'

Expand Down Expand Up @@ -134,43 +133,30 @@ class GraphQuery a where
-- GET --
---------------------------------------------------------------------------------------

-- | Get request with result in Aeson format.
-- Easy way to show result graphs.
-- | Get request with graph result.
--
data GetRequestA = GetRequestA
data GetRequest = GetRequest

-- | Get request with result in Bolt format.
-- Easy way to extract results and convert them to another entities (using 'fromNode').
--
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

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 --
---------------------------------------------------------------------------------------

-- | 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.
Expand Down
7 changes: 6 additions & 1 deletion src/Database/Bolt/Extras/Internal/Instances.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,10 @@ import Data.Aeson (FromJSON (..),
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,
Expand Down Expand Up @@ -115,3 +116,7 @@ instance FromJSON Value where
<|> 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

0 comments on commit 64abb0d

Please sign in to comment.