{-# 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 GHC.Stack (HasCallStack)
import Language.Haskell.TH.Syntax (Name,
nameBase)
import NeatInterpolation (text)
import Text.Printf (printf)
data NodeGetter = NodeGetter { NodeGetter -> Maybe BoltId
ngboltId :: Maybe BoltId
, NodeGetter -> [Text]
ngLabels :: [Label]
, NodeGetter -> Map Text Value
ngProps :: Map Text B.Value
, NodeGetter -> [Text]
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 Text
rgLabel :: Maybe Label
, RelGetter -> Map Text Value
rgProps :: Map Text B.Value
, RelGetter -> [Text]
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 {[(Text, Text)]
[(Text, Value)]
[Text]
Maybe Text
nodeParams :: NodeSelector -> [(Text, Text)]
nodeProperties :: NodeSelector -> [(Text, Value)]
nodeLabels :: NodeSelector -> [Text]
nodeIdentifier :: NodeSelector -> Maybe Text
nodeParams :: [(Text, Text)]
nodeProperties :: [(Text, Value)]
nodeLabels :: [Text]
nodeIdentifier :: Maybe Text
..} = NodeGetter
{ ngboltId :: Maybe BoltId
ngboltId = forall a. Maybe a
Nothing
, ngLabels :: [Text]
ngLabels = [Text]
nodeLabels
, ngProps :: Map Text Value
ngProps = forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Text, Value)]
nodeProperties
, ngReturnProps :: [Text]
ngReturnProps = []
, ngIsReturned :: Bool
ngIsReturned = Bool
False
}
rgFromDSL :: DSL.RelSelector -> RelGetter
rgFromDSL :: RelSelector -> RelGetter
rgFromDSL DSL.RelSelector {[(Text, Text)]
[(Text, Value)]
Maybe Text
Text
relParams :: RelSelector -> [(Text, Text)]
relProperties :: RelSelector -> [(Text, Value)]
relLabel :: RelSelector -> Text
relIdentifier :: RelSelector -> Maybe Text
relParams :: [(Text, Text)]
relProperties :: [(Text, Value)]
relLabel :: Text
relIdentifier :: Maybe Text
..} = RelGetter
{ rgboltId :: Maybe BoltId
rgboltId = forall a. Maybe a
Nothing
, rgLabel :: Maybe Text
rgLabel = forall a. a -> Maybe a
Just Text
relLabel
, rgProps :: Map Text Value
rgProps = forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Text, Value)]
relProperties
, rgReturnProps :: [Text]
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
-> [Text] -> Map Text Value -> [Text] -> 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 Text -> Map Text Value -> [Text] -> 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 :: Text -> NodeGetter -> NodeGetter
withLabel Text
lbl NodeGetter
ng = NodeGetter
ng { ngLabels :: [Text]
ngLabels = Text
lbl forall a. a -> [a] -> [a]
: NodeGetter -> [Text]
ngLabels NodeGetter
ng }
withLabelQ :: Name -> NodeGetter -> NodeGetter
withLabelQ Name
lblQ = forall a. GetterLike a => Text -> a -> a
withLabel (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase forall a b. (a -> b) -> a -> b
$ Name
lblQ)
withProp :: (Text, Value) -> NodeGetter -> NodeGetter
withProp (Text
pk, Value
pv) NodeGetter
ng = NodeGetter
ng { ngProps :: Map Text Value
ngProps = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
pk Value
pv (NodeGetter -> Map Text Value
ngProps NodeGetter
ng) }
withReturn :: [Text] -> NodeGetter -> NodeGetter
withReturn [Text]
props NodeGetter
ng = NodeGetter
ng { ngReturnProps :: [Text]
ngReturnProps = NodeGetter -> [Text]
ngReturnProps NodeGetter
ng forall a. [a] -> [a] -> [a]
++ [Text]
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 :: Text -> RelGetter -> RelGetter
withLabel Text
lbl RelGetter
rg = RelGetter
rg { rgLabel :: Maybe Text
rgLabel = forall a. a -> Maybe a
Just Text
lbl }
withLabelQ :: Name -> RelGetter -> RelGetter
withLabelQ Name
lblQ = forall a. GetterLike a => Text -> a -> a
withLabel (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase forall a b. (a -> b) -> a -> b
$ Name
lblQ)
withProp :: (Text, Value) -> RelGetter -> RelGetter
withProp (Text
pk, Value
pv) RelGetter
rg = RelGetter
rg { rgProps :: Map Text Value
rgProps = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Text
pk Value
pv (RelGetter -> Map Text Value
rgProps RelGetter
rg) }
withReturn :: [Text] -> RelGetter -> RelGetter
withReturn [Text]
props RelGetter
rg = RelGetter
rg { rgReturnProps :: [Text]
rgReturnProps = RelGetter -> [Text]
rgReturnProps RelGetter
rg forall a. [a] -> [a] -> [a]
++ [Text]
props }
isReturned :: RelGetter -> RelGetter
isReturned RelGetter
rg = RelGetter
rg { rgIsReturned :: Bool
rgIsReturned = Bool
True }
instance Requestable (NodeName, NodeGetter) where
request :: (Text, NodeGetter) -> Text
request (Text
name, NodeGetter
ng) = [text|($name $labels $propsQ)|]
where
labels :: Text
labels = forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeGetter -> [Text]
ngLabels forall a b. (a -> b) -> a -> b
$ NodeGetter
ng
propsQ :: Text
propsQ = Text
"{" forall a. Semigroup a => a -> a -> a
<> (forall a. (ToCypher a, HasCallStack) => a -> Text
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 Text Value
ngProps forall a b. (a -> b) -> a -> b
$ NodeGetter
ng) forall a. Semigroup a => a -> a -> a
<> Text
"}"
instance Requestable ((NodeName, NodeName), RelGetter) where
request :: ((Text, Text), RelGetter) -> Text
request ((Text
stName, Text
enName), RelGetter
rg) = [text|($stName)-[$name $typeQ $propsQ]->($enName)|]
where
name :: Text
name = (Text, Text) -> Text
relationName (Text
stName, Text
enName)
typeQ :: Text
typeQ = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall a. (ToCypher a, HasCallStack) => a -> Text
toCypher (RelGetter -> Maybe Text
rgLabel RelGetter
rg)
propsQ :: Text
propsQ = Text
"{" forall a. Semigroup a => a -> a -> a
<> (forall a. (ToCypher a, HasCallStack) => a -> Text
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 Text Value
rgProps forall a b. (a -> b) -> a -> b
$ RelGetter
rg) forall a. Semigroup a => a -> a -> a
<> Text
"}"
instance Returnable (NodeName, NodeGetter) where
isReturned' :: (Text, NodeGetter) -> Bool
isReturned' (Text
_, NodeGetter
ng) = NodeGetter -> Bool
ngIsReturned NodeGetter
ng
return' :: (Text, NodeGetter) -> Text
return' (Text
name, NodeGetter
ng) = let showProps :: Text
showProps = Text -> [Text] -> Text
showRetProps Text
name forall a b. (a -> b) -> a -> b
$ NodeGetter -> [Text]
ngReturnProps NodeGetter
ng
in [text|{ id: id($name),
labels: labels($name),
props: $showProps
} as $name
|]
instance Returnable ((NodeName, NodeName), RelGetter) where
isReturned' :: ((Text, Text), RelGetter) -> Bool
isReturned' ((Text, Text)
_, RelGetter
rg) = RelGetter -> Bool
rgIsReturned RelGetter
rg
return' :: ((Text, Text), RelGetter) -> Text
return' ((Text
stName, Text
enName), RelGetter
rg) = let name :: Text
name = (Text, Text) -> Text
relationName (Text
stName, Text
enName)
showProps :: Text
showProps = Text -> [Text] -> Text
showRetProps Text
name forall a b. (a -> b) -> a -> b
$ RelGetter -> [Text]
rgReturnProps RelGetter
rg
in [text|{ id: id($name),
label: type($name),
props: $showProps
} as $name
|]
allProps :: [Text]
allProps :: [Text]
allProps = [Text
"*"]
showRetProps :: Text -> [Text] -> Text
showRetProps :: Text -> [Text] -> Text
showRetProps Text
name [] = Text
name forall a. Semigroup a => a -> a -> a
<> Text
"{}"
showRetProps Text
name [Text
"*"] = Text
"properties(" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
")"
showRetProps Text
name [Text]
props = Text
name forall a. Semigroup a => a -> a -> a
<> Text
"{" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " (Char -> Text -> Text
cons Char
'.' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
props) forall a. Semigroup a => a -> a -> a
<> Text
"}"
requestGetters :: [(NodeName, NodeGetter)]
-> [((NodeName, NodeName), RelGetter)]
-> (Text, [Text])
requestGetters :: [(Text, NodeGetter)]
-> [((Text, Text), RelGetter)] -> (Text, [Text])
requestGetters [(Text, NodeGetter)]
ngs [((Text, Text), RelGetter)]
rgs = (Text
"MATCH " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Requestable a => a -> Text
request [((Text, Text), 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 -> Text
request [(Text, NodeGetter)]
ngs), [Text]
conditionsID)
where
boltIdCondN :: (NodeName, NodeGetter) -> Maybe Text
boltIdCondN :: (Text, NodeGetter) -> Maybe Text
boltIdCondN (Text
name, NodeGetter
ng) = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"ID(%s)=%d" Text
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 :: ((Text, Text), RelGetter) -> Maybe Text
boltIdCondR ((Text, Text)
names, RelGetter
rg) = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"ID(%s)=%d" ((Text, Text) -> Text
relationName (Text, Text)
names) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelGetter -> Maybe BoltId
rgboltId RelGetter
rg
conditionsID :: [Text]
conditionsID = forall a. [Maybe a] -> [a]
catMaybes (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, NodeGetter) -> Maybe Text
boltIdCondN [(Text, NodeGetter)]
ngs forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text, Text), RelGetter) -> Maybe Text
boltIdCondR [((Text, Text), RelGetter)]
rgs)
data NodeResult = NodeResult { NodeResult -> BoltId
nresId :: BoltId
, NodeResult -> [Text]
nresLabels :: [Label]
, NodeResult -> Map Text 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 -> Text
rresLabel :: Label
, RelResult -> Map Text 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 :: HasCallStack => NodeResult -> BoltId
getBoltId = NodeResult -> BoltId
nresId
instance GetBoltId RelResult where
getBoltId :: HasCallStack => 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 :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> [Map Text Value] -> BoltActionT m [NodeResult]
extract = forall (m :: * -> *) a.
(HasCallStack, MonadIO m, FromJSON a) =>
Text -> [Map Text Value] -> BoltActionT m [a]
extractFromJSON
instance Extractable RelResult where
extract :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> [Map Text Value] -> BoltActionT m [RelResult]
extract = forall (m :: * -> *) a.
(HasCallStack, MonadIO m, FromJSON a) =>
Text -> [Map Text Value] -> BoltActionT m [a]
extractFromJSON
extractFromJSON :: (HasCallStack, MonadIO m, FromJSON a) => Text -> [Record] -> BoltActionT m [a]
Text
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 Text Value
r -> case forall a. FromJSON a => Value -> Result a
fromJSON (forall a. ToJSON a => a -> Value
toJSON (Map Text Value
r forall k a. Ord k => Map k a -> k -> a
! Text
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
[Text]
Map Text Value
nresProps :: Map Text Value
nresLabels :: [Text]
nresId :: BoltId
nresProps :: NodeResult -> Map Text Value
nresLabels :: NodeResult -> [Text]
nresId :: NodeResult -> BoltId
..} = BoltId -> [Text] -> Map Text Value -> Node
Node BoltId
nresId [Text]
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 Text Value
nresProps))
fromNode :: HasCallStack => Node -> NodeResult
fromNode Node{BoltId
[Text]
Map Text Value
nodeIdentity :: Node -> BoltId
labels :: Node -> [Text]
nodeProps :: Node -> Map Text Value
nodeProps :: Map Text Value
labels :: [Text]
nodeIdentity :: BoltId
..} = BoltId -> [Text] -> Map Text Value -> NodeResult
NodeResult BoltId
nodeIdentity [Text]
labels (forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Value
nodeProps)
instance URelationLike RelResult where
toURelation :: HasCallStack => RelResult -> URelationship
toURelation RelResult{BoltId
Text
Map Text Value
rresProps :: Map Text Value
rresLabel :: Text
rresId :: BoltId
rresProps :: RelResult -> Map Text Value
rresLabel :: RelResult -> Text
rresId :: RelResult -> BoltId
..} = BoltId -> Text -> Map Text Value -> URelationship
URelationship BoltId
rresId Text
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 Text Value
rresProps))
fromURelation :: HasCallStack => URelationship -> RelResult
fromURelation URelationship{BoltId
Text
Map Text Value
urelIdentity :: URelationship -> BoltId
urelType :: URelationship -> Text
urelProps :: URelationship -> Map Text Value
urelProps :: Map Text Value
urelType :: Text
urelIdentity :: BoltId
..} = BoltId -> Text -> Map Text Value -> RelResult
RelResult BoltId
urelIdentity Text
urelType (forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Value
urelProps)
type GraphGetRequest = Graph NodeName NodeGetter RelGetter
type GraphGetResponse = Graph NodeName NodeResult RelResult
extractNode :: HasCallStack => NodeLike a => NodeName -> GraphGetResponse -> a
Text
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 Text
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. HasCallStack => Text -> a
errorForNode Text
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 :: HasCallStack => URelationLike a => NodeName -> NodeName -> GraphGetResponse -> a
Text
stVar Text
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 (Text
stVar, Text
enVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. HasCallStack => Text -> Text -> a
errorForRelation Text
stVar Text
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 :: HasCallStack => NodeName -> GraphGetResponse -> BoltId
Text
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 Text
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. HasCallStack => Text -> a
errorForNode Text
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 :: HasCallStack => NodeName -> NodeName -> GraphGetResponse -> BoltId
Text
stVar Text
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 (Text
stVar, Text
enVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. HasCallStack => Text -> Text -> a
errorForRelation Text
stVar Text
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 :: HasCallStack => NodeName -> GraphGetResponse -> NodeResult
Text
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 Text
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. HasCallStack => Text -> a
errorForNode Text
var)
extractRelationAeson :: HasCallStack => NodeName -> NodeName -> GraphGetResponse -> RelResult
Text
stVar Text
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 (Text
stVar, Text
enVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non (forall a. HasCallStack => Text -> Text -> a
errorForRelation Text
stVar Text
enVar)
errorForNode :: HasCallStack => NodeName -> a
errorForNode :: forall a. HasCallStack => Text -> a
errorForNode Text
name = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall a b. (a -> b) -> a -> b
$ Text
"node with name " forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
" doesn't exist"
errorForRelation :: HasCallStack => NodeName -> NodeName -> a
errorForRelation :: forall a. HasCallStack => Text -> Text -> a
errorForRelation Text
stName Text
enName = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall a b. (a -> b) -> a -> b
$ Text
"relation between nodes " forall a. Semigroup a => a -> a -> a
<>
Text
stName forall a. Semigroup a => a -> a -> a
<> Text
" and " forall a. Semigroup a => a -> a -> a
<> Text
enName forall a. Semigroup a => a -> a -> a
<>
Text
" doesn't exist"