{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Database.Bolt.Extras.Graph.Internal.Get
(
NodeGetter (..)
, RelGetter (..)
, GetterLike (..)
, ngFromDSL, rgFromDSL
, (#)
, defaultNode
, defaultRel
, defaultNodeReturn
, defaultNodeNotReturn
, defaultRelReturn
, defaultRelNotReturn
, requestGetters
, allProps
, NodeResult (..)
, RelResult (..)
, relationName
, GraphGetRequest
, GraphGetResponse
, 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 (..),
ToJSON (..),
Value,
fromJSON,
genericParseJSON,
genericToJSON,
omitNothingFields,
toJSON)
import Data.Aeson.Casing (aesonPrefix,
snakeCase)
import Data.Function ((&))
import Data.Map.Strict as M (Map,
filter,
fromList,
insert,
toList,
(!))
import Data.Maybe (catMaybes,
fromJust,
isJust)
import Data.Text (Text, cons,
intercalate,
pack,
unpack)
import Database.Bolt as B (BoltActionT,
Node (..),
Record,
URelationship (..),
Value)
import Database.Bolt.Extras (BoltId, GetBoltId (..),
Label,
NodeLike (..),
ToCypher (..),
URelationLike (..))
import qualified Database.Bolt.Extras.DSL as DSL
import Database.Bolt.Extras.Graph.Internal.AbstractGraph (Graph,
NodeName,
relationName,
relations,
vertices)
import Database.Bolt.Extras.Graph.Internal.Class (Extractable (..),
Requestable (..),
Returnable (..))
import GHC.Generics (Generic)
import Language.Haskell.TH.Syntax (Name,
nameBase)
import NeatInterpolation (text)
import Text.Printf (printf)
data NodeGetter = NodeGetter { NodeGetter -> Maybe BoltId
ngboltId :: Maybe BoltId
, NodeGetter -> [NodeName]
ngLabels :: [Label]
, NodeGetter -> Map NodeName Value
ngProps :: Map Text B.Value
, NodeGetter -> [NodeName]
ngReturnProps :: [Text]
, NodeGetter -> Bool
ngIsReturned :: Bool
}
deriving (BoltId -> NodeGetter -> ShowS
[NodeGetter] -> ShowS
NodeGetter -> String
forall a.
(BoltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeGetter] -> ShowS
$cshowList :: [NodeGetter] -> ShowS
show :: NodeGetter -> String
$cshow :: NodeGetter -> String
showsPrec :: BoltId -> NodeGetter -> ShowS
$cshowsPrec :: BoltId -> NodeGetter -> ShowS
Show, NodeGetter -> NodeGetter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeGetter -> NodeGetter -> Bool
$c/= :: NodeGetter -> NodeGetter -> Bool
== :: NodeGetter -> NodeGetter -> Bool
$c== :: NodeGetter -> NodeGetter -> Bool
Eq)
data RelGetter = RelGetter { RelGetter -> Maybe BoltId
rgboltId :: Maybe BoltId
, RelGetter -> Maybe NodeName
rgLabel :: Maybe Label
, RelGetter -> Map NodeName Value
rgProps :: Map Text B.Value
, RelGetter -> [NodeName]
rgReturnProps :: [Text]
, RelGetter -> Bool
rgIsReturned :: Bool
}
deriving (BoltId -> RelGetter -> ShowS
[RelGetter] -> ShowS
RelGetter -> String
forall a.
(BoltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelGetter] -> ShowS
$cshowList :: [RelGetter] -> ShowS
show :: RelGetter -> String
$cshow :: RelGetter -> String
showsPrec :: BoltId -> RelGetter -> ShowS
$cshowsPrec :: BoltId -> RelGetter -> ShowS
Show, RelGetter -> RelGetter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelGetter -> RelGetter -> Bool
$c/= :: RelGetter -> RelGetter -> Bool
== :: RelGetter -> RelGetter -> Bool
$c== :: RelGetter -> RelGetter -> Bool
Eq)
ngFromDSL :: DSL.NodeSelector-> NodeGetter
ngFromDSL :: NodeSelector -> NodeGetter
ngFromDSL DSL.NodeSelector {[(NodeName, NodeName)]
[(NodeName, Value)]
[NodeName]
Maybe NodeName
nodeParams :: NodeSelector -> [(NodeName, NodeName)]
nodeProperties :: NodeSelector -> [(NodeName, Value)]
nodeLabels :: NodeSelector -> [NodeName]
nodeIdentifier :: NodeSelector -> Maybe NodeName
nodeParams :: [(NodeName, NodeName)]
nodeProperties :: [(NodeName, Value)]
nodeLabels :: [NodeName]
nodeIdentifier :: Maybe NodeName
..} = NodeGetter
{ ngboltId :: Maybe BoltId
ngboltId = forall a. Maybe a
Nothing
, ngLabels :: [NodeName]
ngLabels = [NodeName]
nodeLabels
, ngProps :: Map NodeName Value
ngProps = forall k a. Ord k => [(k, a)] -> Map k a
fromList [(NodeName, Value)]
nodeProperties
, ngReturnProps :: [NodeName]
ngReturnProps = []
, ngIsReturned :: Bool
ngIsReturned = Bool
False
}
rgFromDSL :: DSL.RelSelector -> RelGetter
rgFromDSL :: RelSelector -> RelGetter
rgFromDSL DSL.RelSelector {[(NodeName, NodeName)]
[(NodeName, Value)]
Maybe NodeName
NodeName
relParams :: RelSelector -> [(NodeName, NodeName)]
relProperties :: RelSelector -> [(NodeName, Value)]
relLabel :: RelSelector -> NodeName
relIdentifier :: RelSelector -> Maybe NodeName
relParams :: [(NodeName, NodeName)]
relProperties :: [(NodeName, Value)]
relLabel :: NodeName
relIdentifier :: Maybe NodeName
..} = RelGetter
{ rgboltId :: Maybe BoltId
rgboltId = forall a. Maybe a
Nothing
, rgLabel :: Maybe NodeName
rgLabel = forall a. a -> Maybe a
Just NodeName
relLabel
, rgProps :: Map NodeName Value
rgProps = forall k a. Ord k => [(k, a)] -> Map k a
fromList [(NodeName, Value)]
relProperties
, rgReturnProps :: [NodeName]
rgReturnProps = []
, rgIsReturned :: Bool
rgIsReturned = Bool
False
}
(#) :: a -> (a -> b) -> b
# :: forall a b. a -> (a -> b) -> b
(#) = forall a b. a -> (a -> b) -> b
(&)
defaultNode :: Bool
-> NodeGetter
defaultNode :: Bool -> NodeGetter
defaultNode = Maybe BoltId
-> [NodeName]
-> Map NodeName Value
-> [NodeName]
-> Bool
-> NodeGetter
NodeGetter forall a. Maybe a
Nothing [] (forall k a. Ord k => [(k, a)] -> Map k a
fromList []) []
defaultRel :: Bool
-> RelGetter
defaultRel :: Bool -> RelGetter
defaultRel = Maybe BoltId
-> Maybe NodeName
-> Map NodeName Value
-> [NodeName]
-> Bool
-> RelGetter
RelGetter forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall k a. Ord k => [(k, a)] -> Map k a
fromList []) []
defaultNodeReturn :: NodeGetter
defaultNodeReturn :: NodeGetter
defaultNodeReturn = Bool -> NodeGetter
defaultNode Bool
True
defaultNodeNotReturn :: NodeGetter
defaultNodeNotReturn :: NodeGetter
defaultNodeNotReturn = Bool -> NodeGetter
defaultNode Bool
False
defaultRelReturn :: RelGetter
defaultRelReturn :: RelGetter
defaultRelReturn = Bool -> RelGetter
defaultRel Bool
True
defaultRelNotReturn :: RelGetter
defaultRelNotReturn :: RelGetter
defaultRelNotReturn = Bool -> RelGetter
defaultRel Bool
False
class GetterLike a where
withBoltId :: BoltId -> a -> a
withLabel :: Label -> a -> a
withLabelQ :: Name -> a -> a
withProp :: (Text, B.Value) -> a -> a
withReturn :: [Text] -> a -> a
isReturned :: a -> a
instance GetterLike NodeGetter where
withBoltId :: BoltId -> NodeGetter -> NodeGetter
withBoltId BoltId
boltId NodeGetter
ng = NodeGetter
ng { ngboltId :: Maybe BoltId
ngboltId = forall a. a -> Maybe a
Just BoltId
boltId }
withLabel :: NodeName -> NodeGetter -> NodeGetter
withLabel NodeName
lbl NodeGetter
ng = NodeGetter
ng { ngLabels :: [NodeName]
ngLabels = NodeName
lbl forall a. a -> [a] -> [a]
: NodeGetter -> [NodeName]
ngLabels NodeGetter
ng }
withLabelQ :: Name -> NodeGetter -> NodeGetter
withLabelQ Name
lblQ = forall a. GetterLike a => NodeName -> a -> a
withLabel (String -> NodeName
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase forall a b. (a -> b) -> a -> b
$ Name
lblQ)
withProp :: (NodeName, Value) -> NodeGetter -> NodeGetter
withProp (NodeName
pk, Value
pv) NodeGetter
ng = NodeGetter
ng { ngProps :: Map NodeName Value
ngProps = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert NodeName
pk Value
pv (NodeGetter -> Map NodeName Value
ngProps NodeGetter
ng) }
withReturn :: [NodeName] -> NodeGetter -> NodeGetter
withReturn [NodeName]
props NodeGetter
ng = NodeGetter
ng { ngReturnProps :: [NodeName]
ngReturnProps = NodeGetter -> [NodeName]
ngReturnProps NodeGetter
ng forall a. [a] -> [a] -> [a]
++ [NodeName]
props }
isReturned :: NodeGetter -> NodeGetter
isReturned NodeGetter
ng = NodeGetter
ng { ngIsReturned :: Bool
ngIsReturned = Bool
True }
instance GetterLike RelGetter where
withBoltId :: BoltId -> RelGetter -> RelGetter
withBoltId BoltId
boltId RelGetter
rg = RelGetter
rg { rgboltId :: Maybe BoltId
rgboltId = forall a. a -> Maybe a
Just BoltId
boltId }
withLabel :: NodeName -> RelGetter -> RelGetter
withLabel NodeName
lbl RelGetter
rg = RelGetter
rg { rgLabel :: Maybe NodeName
rgLabel = forall a. a -> Maybe a
Just NodeName
lbl }
withLabelQ :: Name -> RelGetter -> RelGetter
withLabelQ Name
lblQ = forall a. GetterLike a => NodeName -> a -> a
withLabel (String -> NodeName
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase forall a b. (a -> b) -> a -> b
$ Name
lblQ)
withProp :: (NodeName, Value) -> RelGetter -> RelGetter
withProp (NodeName
pk, Value
pv) RelGetter
rg = RelGetter
rg { rgProps :: Map NodeName Value
rgProps = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert NodeName
pk Value
pv (RelGetter -> Map NodeName Value
rgProps RelGetter
rg) }
withReturn :: [NodeName] -> RelGetter -> RelGetter
withReturn [NodeName]
props RelGetter
rg = RelGetter
rg { rgReturnProps :: [NodeName]
rgReturnProps = RelGetter -> [NodeName]
rgReturnProps RelGetter
rg forall a. [a] -> [a] -> [a]
++ [NodeName]
props }
isReturned :: RelGetter -> RelGetter
isReturned RelGetter
rg = RelGetter
rg { rgIsReturned :: Bool
rgIsReturned = Bool
True }
instance Requestable (NodeName, NodeGetter) where
request :: (NodeName, NodeGetter) -> NodeName
request (NodeName
name, NodeGetter
ng) = [text|($name $labels $propsQ)|]
where
labels :: NodeName
labels = forall a. (ToCypher a, HasCallStack) => a -> NodeName
toCypher forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeGetter -> [NodeName]
ngLabels forall a b. (a -> b) -> a -> b
$ NodeGetter
ng
propsQ :: NodeName
propsQ = NodeName
"{" forall a. Semigroup a => a -> a -> a
<> (forall a. (ToCypher a, HasCallStack) => a -> NodeName
toCypher forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeGetter -> Map NodeName Value
ngProps forall a b. (a -> b) -> a -> b
$ NodeGetter
ng) forall a. Semigroup a => a -> a -> a
<> NodeName
"}"
instance Requestable ((NodeName, NodeName), RelGetter) where
request :: ((NodeName, NodeName), RelGetter) -> NodeName
request ((NodeName
stName, NodeName
enName), RelGetter
rg) = [text|($stName)-[$name $typeQ $propsQ]->($enName)|]
where
name :: NodeName
name = (NodeName, NodeName) -> NodeName
relationName (NodeName
stName, NodeName
enName)
typeQ :: NodeName
typeQ = forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeName
"" forall a. (ToCypher a, HasCallStack) => a -> NodeName
toCypher (RelGetter -> Maybe NodeName
rgLabel RelGetter
rg)
propsQ :: NodeName
propsQ = NodeName
"{" forall a. Semigroup a => a -> a -> a
<> (forall a. (ToCypher a, HasCallStack) => a -> NodeName
toCypher forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelGetter -> Map NodeName Value
rgProps forall a b. (a -> b) -> a -> b
$ RelGetter
rg) forall a. Semigroup a => a -> a -> a
<> NodeName
"}"
instance Returnable (NodeName, NodeGetter) where
isReturned' :: (NodeName, NodeGetter) -> Bool
isReturned' (NodeName
_, NodeGetter
ng) = NodeGetter -> Bool
ngIsReturned NodeGetter
ng
return' :: (NodeName, NodeGetter) -> NodeName
return' (NodeName
name, NodeGetter
ng) = let showProps :: NodeName
showProps = NodeName -> [NodeName] -> NodeName
showRetProps NodeName
name forall a b. (a -> b) -> a -> b
$ NodeGetter -> [NodeName]
ngReturnProps NodeGetter
ng
in [text|{ id: id($name),
labels: labels($name),
props: $showProps
} as $name
|]
instance Returnable ((NodeName, NodeName), RelGetter) where
isReturned' :: ((NodeName, NodeName), RelGetter) -> Bool
isReturned' ((NodeName, NodeName)
_, RelGetter
rg) = RelGetter -> Bool
rgIsReturned RelGetter
rg
return' :: ((NodeName, NodeName), RelGetter) -> NodeName
return' ((NodeName
stName, NodeName
enName), RelGetter
rg) = let name :: NodeName
name = (NodeName, NodeName) -> NodeName
relationName (NodeName
stName, NodeName
enName)
showProps :: NodeName
showProps = NodeName -> [NodeName] -> NodeName
showRetProps NodeName
name forall a b. (a -> b) -> a -> b
$ RelGetter -> [NodeName]
rgReturnProps RelGetter
rg
in [text|{ id: id($name),
label: type($name),
props: $showProps
} as $name
|]
allProps :: [Text]
allProps :: [NodeName]
allProps = [NodeName
"*"]
showRetProps :: Text -> [Text] -> Text
showRetProps :: NodeName -> [NodeName] -> NodeName
showRetProps NodeName
name [] = NodeName
name forall a. Semigroup a => a -> a -> a
<> NodeName
"{}"
showRetProps NodeName
name [NodeName
"*"] = NodeName
"properties(" forall a. Semigroup a => a -> a -> a
<> NodeName
name forall a. Semigroup a => a -> a -> a
<> NodeName
")"
showRetProps NodeName
name [NodeName]
props = NodeName
name forall a. Semigroup a => a -> a -> a
<> NodeName
"{" forall a. Semigroup a => a -> a -> a
<> NodeName -> [NodeName] -> NodeName
intercalate NodeName
", " (Char -> NodeName -> NodeName
cons Char
'.' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NodeName]
props) forall a. Semigroup a => a -> a -> a
<> NodeName
"}"
requestGetters :: [(NodeName, NodeGetter)]
-> [((NodeName, NodeName), RelGetter)]
-> (Text, [Text])
requestGetters :: [(NodeName, NodeGetter)]
-> [((NodeName, NodeName), RelGetter)] -> (NodeName, [NodeName])
requestGetters [(NodeName, NodeGetter)]
ngs [((NodeName, NodeName), RelGetter)]
rgs = (NodeName
"MATCH " forall a. Semigroup a => a -> a -> a
<> NodeName -> [NodeName] -> NodeName
intercalate NodeName
", " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Requestable a => a -> NodeName
request [((NodeName, NodeName), RelGetter)]
rgs forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Requestable a => a -> NodeName
request [(NodeName, NodeGetter)]
ngs), [NodeName]
conditionsID)
where
boltIdCondN :: (NodeName, NodeGetter) -> Maybe Text
boltIdCondN :: (NodeName, NodeGetter) -> Maybe NodeName
boltIdCondN (NodeName
name, NodeGetter
ng) = String -> NodeName
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"ID(%s)=%d" NodeName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeGetter -> Maybe BoltId
ngboltId NodeGetter
ng
boltIdCondR :: ((NodeName, NodeName), RelGetter) -> Maybe Text
boltIdCondR :: ((NodeName, NodeName), RelGetter) -> Maybe NodeName
boltIdCondR ((NodeName, NodeName)
names, RelGetter
rg) = String -> NodeName
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"ID(%s)=%d" ((NodeName, NodeName) -> NodeName
relationName (NodeName, NodeName)
names) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelGetter -> Maybe BoltId
rgboltId RelGetter
rg
conditionsID :: [NodeName]
conditionsID = forall a. [Maybe a] -> [a]
catMaybes (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeName, NodeGetter) -> Maybe NodeName
boltIdCondN [(NodeName, NodeGetter)]
ngs forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NodeName, NodeName), RelGetter) -> Maybe NodeName
boltIdCondR [((NodeName, NodeName), RelGetter)]
rgs)
data NodeResult = NodeResult { NodeResult -> BoltId
nresId :: BoltId
, NodeResult -> [NodeName]
nresLabels :: [Label]
, NodeResult -> Map NodeName Value
nresProps :: Map Text A.Value
}
deriving (BoltId -> NodeResult -> ShowS
[NodeResult] -> ShowS
NodeResult -> String
forall a.
(BoltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeResult] -> ShowS
$cshowList :: [NodeResult] -> ShowS
show :: NodeResult -> String
$cshow :: NodeResult -> String
showsPrec :: BoltId -> NodeResult -> ShowS
$cshowsPrec :: BoltId -> NodeResult -> ShowS
Show, NodeResult -> NodeResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeResult -> NodeResult -> Bool
$c/= :: NodeResult -> NodeResult -> Bool
== :: NodeResult -> NodeResult -> Bool
$c== :: NodeResult -> NodeResult -> Bool
Eq, forall x. Rep NodeResult x -> NodeResult
forall x. NodeResult -> Rep NodeResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeResult x -> NodeResult
$cfrom :: forall x. NodeResult -> Rep NodeResult x
Generic)
data RelResult = RelResult { RelResult -> BoltId
rresId :: BoltId
, RelResult -> NodeName
rresLabel :: Label
, RelResult -> Map NodeName Value
rresProps :: Map Text A.Value
}
deriving (BoltId -> RelResult -> ShowS
[RelResult] -> ShowS
RelResult -> String
forall a.
(BoltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelResult] -> ShowS
$cshowList :: [RelResult] -> ShowS
show :: RelResult -> String
$cshow :: RelResult -> String
showsPrec :: BoltId -> RelResult -> ShowS
$cshowsPrec :: BoltId -> RelResult -> ShowS
Show, RelResult -> RelResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelResult -> RelResult -> Bool
$c/= :: RelResult -> RelResult -> Bool
== :: RelResult -> RelResult -> Bool
$c== :: RelResult -> RelResult -> Bool
Eq, forall x. Rep RelResult x -> RelResult
forall x. RelResult -> Rep RelResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelResult x -> RelResult
$cfrom :: forall x. RelResult -> Rep RelResult x
Generic)
instance GetBoltId NodeResult where
getBoltId :: NodeResult -> BoltId
getBoltId = NodeResult -> BoltId
nresId
instance GetBoltId RelResult where
getBoltId :: RelResult -> BoltId
getBoltId = RelResult -> BoltId
rresId
instance ToJSON NodeResult where
toJSON :: NodeResult -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (ShowS -> Options
aesonPrefix ShowS
snakeCase)
{ omitNothingFields :: Bool
omitNothingFields = Bool
True }
instance FromJSON NodeResult where
parseJSON :: Value -> Parser NodeResult
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (ShowS -> Options
aesonPrefix ShowS
snakeCase)
{ omitNothingFields :: Bool
omitNothingFields = Bool
True }
instance ToJSON RelResult where
toJSON :: RelResult -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (ShowS -> Options
aesonPrefix ShowS
snakeCase)
{ omitNothingFields :: Bool
omitNothingFields = Bool
True }
instance FromJSON RelResult where
parseJSON :: Value -> Parser RelResult
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (ShowS -> Options
aesonPrefix ShowS
snakeCase)
{ omitNothingFields :: Bool
omitNothingFields = Bool
True }
instance Extractable NodeResult where
extract :: forall (m :: * -> *).
MonadIO m =>
NodeName -> [Map NodeName Value] -> BoltActionT m [NodeResult]
extract = forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
NodeName -> [Map NodeName Value] -> BoltActionT m [a]
extractFromJSON
instance Extractable RelResult where
extract :: forall (m :: * -> *).
MonadIO m =>
NodeName -> [Map NodeName Value] -> BoltActionT m [RelResult]
extract = forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
NodeName -> [Map NodeName Value] -> BoltActionT m [a]
extractFromJSON
extractFromJSON :: (MonadIO m, FromJSON a) => Text -> [Record] -> BoltActionT m [a]
NodeName
var = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Map NodeName Value
r -> case forall a. FromJSON a => Value -> Result a
fromJSON (forall a. ToJSON a => a -> Value
toJSON (Map NodeName Value
r forall k a. Ord k => Map k a -> k -> a
! NodeName
var)) of
Success a
parsed -> a
parsed
Error String
err -> forall a. HasCallStack => String -> a
error String
err)
fromJSONM :: forall a. FromJSON a => A.Value -> Maybe a
fromJSONM :: forall a. FromJSON a => Value -> Maybe a
fromJSONM (forall a. FromJSON a => Value -> Result a
fromJSON -> Success a
r :: Result a) = forall a. a -> Maybe a
Just a
r
fromJSONM Value
_ = forall a. Maybe a
Nothing
instance NodeLike NodeResult where
toNode :: HasCallStack => NodeResult -> Node
toNode NodeResult{BoltId
[NodeName]
Map NodeName Value
nresProps :: Map NodeName Value
nresLabels :: [NodeName]
nresId :: BoltId
nresProps :: NodeResult -> Map NodeName Value
nresLabels :: NodeResult -> [NodeName]
nresId :: NodeResult -> BoltId
..} = BoltId -> [NodeName] -> Map NodeName Value -> Node
Node BoltId
nresId [NodeName]
nresLabels (forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter forall a. Maybe a -> Bool
isJust (forall a. FromJSON a => Value -> Maybe a
fromJSONM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map NodeName Value
nresProps))
fromNode :: HasCallStack => Node -> NodeResult
fromNode Node{BoltId
[NodeName]
Map NodeName Value
nodeIdentity :: Node -> BoltId
labels :: Node -> [NodeName]
nodeProps :: Node -> Map NodeName Value
nodeProps :: Map NodeName Value
labels :: [NodeName]
nodeIdentity :: BoltId
..} = BoltId -> [NodeName] -> Map NodeName Value -> NodeResult
NodeResult BoltId
nodeIdentity [NodeName]
labels (forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map NodeName Value
nodeProps)
instance URelationLike RelResult where
toURelation :: HasCallStack => RelResult -> URelationship
toURelation RelResult{BoltId
NodeName
Map NodeName Value
rresProps :: Map NodeName Value
rresLabel :: NodeName
rresId :: BoltId
rresProps :: RelResult -> Map NodeName Value
rresLabel :: RelResult -> NodeName
rresId :: RelResult -> BoltId
..} = BoltId -> NodeName -> Map NodeName Value -> URelationship
URelationship BoltId
rresId NodeName
rresLabel (forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter forall a. Maybe a -> Bool
isJust (forall a. FromJSON a => Value -> Maybe a
fromJSONM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map NodeName Value
rresProps))
fromURelation :: HasCallStack => URelationship -> RelResult
fromURelation URelationship{BoltId
NodeName
Map NodeName Value
urelIdentity :: URelationship -> BoltId
urelType :: URelationship -> NodeName
urelProps :: URelationship -> Map NodeName Value
urelProps :: Map NodeName Value
urelType :: NodeName
urelIdentity :: BoltId
..} = BoltId -> NodeName -> Map NodeName Value -> RelResult
RelResult BoltId
urelIdentity NodeName
urelType (forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map NodeName Value
urelProps)
type GraphGetRequest = Graph NodeName NodeGetter RelGetter
type GraphGetResponse = Graph NodeName NodeResult RelResult
extractNode :: NodeLike a => NodeName -> GraphGetResponse -> a
NodeName
var GraphGetResponse
graph = GraphGetResponse
graph forall s a. s -> Getting a s a -> a
^. forall n a1 b a2.
Lens (Graph n a1 b) (Graph n a2 b) (Map n a1) (Map n a2)
vertices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NodeName
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. NodeName -> a
errorForNode NodeName
var) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall a. (NodeLike a, HasCallStack) => Node -> a
fromNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (NodeLike a, HasCallStack) => a -> Node
toNode)
extractRelation :: URelationLike a => NodeName -> NodeName -> GraphGetResponse -> a
NodeName
stVar NodeName
enVar GraphGetResponse
graph = GraphGetResponse
graph forall s a. s -> Getting a s a -> a
^. forall n a b1 b2.
Lens (Graph n a b1) (Graph n a b2) (Map (n, n) b1) (Map (n, n) b2)
relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (NodeName
stVar, NodeName
enVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. NodeName -> NodeName -> a
errorForRelation NodeName
stVar NodeName
enVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall a. (URelationLike a, HasCallStack) => URelationship -> a
fromURelation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (URelationLike a, HasCallStack) => a -> URelationship
toURelation)
extractNodeId :: NodeName -> GraphGetResponse -> BoltId
NodeName
var GraphGetResponse
graph = GraphGetResponse
graph forall s a. s -> Getting a s a -> a
^. forall n a1 b a2.
Lens (Graph n a1 b) (Graph n a2 b) (Map n a1) (Map n a2)
vertices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NodeName
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. NodeName -> a
errorForNode NodeName
var) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to NodeResult -> BoltId
nresId
extractRelationId :: NodeName -> NodeName -> GraphGetResponse -> BoltId
NodeName
stVar NodeName
enVar GraphGetResponse
graph = GraphGetResponse
graph forall s a. s -> Getting a s a -> a
^. forall n a b1 b2.
Lens (Graph n a b1) (Graph n a b2) (Map (n, n) b1) (Map (n, n) b2)
relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (NodeName
stVar, NodeName
enVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. NodeName -> NodeName -> a
errorForRelation NodeName
stVar NodeName
enVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to RelResult -> BoltId
rresId
extractNodeAeson :: NodeName -> GraphGetResponse -> NodeResult
NodeName
var GraphGetResponse
graph = GraphGetResponse
graph forall s a. s -> Getting a s a -> a
^. forall n a1 b a2.
Lens (Graph n a1 b) (Graph n a2 b) (Map n a1) (Map n a2)
vertices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NodeName
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. NodeName -> a
errorForNode NodeName
var)
extractRelationAeson :: NodeName -> NodeName -> GraphGetResponse -> RelResult
NodeName
stVar NodeName
enVar GraphGetResponse
graph = GraphGetResponse
graph forall s a. s -> Getting a s a -> a
^. forall n a b1 b2.
Lens (Graph n a b1) (Graph n a b2) (Map (n, n) b1) (Map (n, n) b2)
relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (NodeName
stVar, NodeName
enVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. NodeName -> NodeName -> a
errorForRelation NodeName
stVar NodeName
enVar)
errorForNode :: NodeName -> a
errorForNode :: forall a. NodeName -> a
errorForNode NodeName
name = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeName -> String
unpack forall a b. (a -> b) -> a -> b
$ NodeName
"node with name " forall a. Semigroup a => a -> a -> a
<> NodeName
name forall a. Semigroup a => a -> a -> a
<> NodeName
" doesn't exist"
errorForRelation :: NodeName -> NodeName -> a
errorForRelation :: forall a. NodeName -> NodeName -> a
errorForRelation NodeName
stName NodeName
enName = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeName -> String
unpack forall a b. (a -> b) -> a -> b
$ NodeName
"relation between nodes " forall a. Semigroup a => a -> a -> a
<>
NodeName
stName forall a. Semigroup a => a -> a -> a
<> NodeName
" and " forall a. Semigroup a => a -> a -> a
<> NodeName
enName forall a. Semigroup a => a -> a -> a
<>
NodeName
" doesn't exist"