{-# 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
  (
  -- * Types for requesting nodes and relationships
    NodeGetter (..)
  , RelGetter (..)
  , GetterLike (..)
  , ngFromDSL, rgFromDSL
  , (#)
  , defaultNode
  , defaultRel
  , defaultNodeReturn
  , defaultNodeNotReturn
  , defaultRelReturn
  , defaultRelNotReturn
  , requestGetters
  , allProps
  -- * Types for extracting nodes and relationships
  , NodeResult (..)
  , RelResult (..)
  , relationName
  -- * Graph types
  , GraphGetRequest
  , 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 (..),
                                                                         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)

----------------------------------------------------------
-- REQUEST --
----------------------------------------------------------

-- | Helper to find 'Node's.
--
data NodeGetter = NodeGetter { NodeGetter -> Maybe BoltId
ngboltId      :: Maybe BoltId     -- ^ known 'BoltId'
                             , NodeGetter -> [Label]
ngLabels      :: [Label]          -- ^ known labels
                             , NodeGetter -> Map Label Value
ngProps       :: Map Text B.Value -- ^ known properties
                             , NodeGetter -> [Label]
ngReturnProps :: [Text]           -- ^ names of properties to return
                             , NodeGetter -> Bool
ngIsReturned  :: Bool             -- ^ whether to return this node or not
                             }
  deriving (BoltId -> NodeGetter -> ShowS
[NodeGetter] -> ShowS
NodeGetter -> String
(BoltId -> NodeGetter -> ShowS)
-> (NodeGetter -> String)
-> ([NodeGetter] -> ShowS)
-> Show NodeGetter
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
(NodeGetter -> NodeGetter -> Bool)
-> (NodeGetter -> NodeGetter -> Bool) -> Eq NodeGetter
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)

-- | Helper to find 'URelationship's.
--
data RelGetter = RelGetter { RelGetter -> Maybe BoltId
rgboltId      :: Maybe BoltId     -- ^ known 'BoltId'
                           , RelGetter -> Maybe Label
rgLabel       :: Maybe Label      -- ^ known labels
                           , RelGetter -> Map Label Value
rgProps       :: Map Text B.Value -- ^ known properties
                           , RelGetter -> [Label]
rgReturnProps :: [Text]           -- ^ names of properties to return
                           , RelGetter -> Bool
rgIsReturned  :: Bool             -- ^ whether to return this relation or not
                           }
  deriving (BoltId -> RelGetter -> ShowS
[RelGetter] -> ShowS
RelGetter -> String
(BoltId -> RelGetter -> ShowS)
-> (RelGetter -> String)
-> ([RelGetter] -> ShowS)
-> Show RelGetter
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
(RelGetter -> RelGetter -> Bool)
-> (RelGetter -> RelGetter -> Bool) -> Eq RelGetter
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)

-- | Create a 'NodeGetter' from 'DSL.NodeSelector' from the DSL. 'ngIsReturned' is set to @False@.
ngFromDSL :: DSL.NodeSelector-> NodeGetter
ngFromDSL :: NodeSelector -> NodeGetter
ngFromDSL DSL.NodeSelector {[(Label, Label)]
[(Label, Value)]
[Label]
Maybe Label
nodeParams :: NodeSelector -> [(Label, Label)]
nodeProperties :: NodeSelector -> [(Label, Value)]
nodeLabels :: NodeSelector -> [Label]
nodeIdentifier :: NodeSelector -> Maybe Label
nodeParams :: [(Label, Label)]
nodeProperties :: [(Label, Value)]
nodeLabels :: [Label]
nodeIdentifier :: Maybe Label
..} = NodeGetter :: Maybe BoltId
-> [Label] -> Map Label Value -> [Label] -> Bool -> NodeGetter
NodeGetter
  { ngboltId :: Maybe BoltId
ngboltId      = Maybe BoltId
forall a. Maybe a
Nothing
  , ngLabels :: [Label]
ngLabels      = [Label]
nodeLabels
  , ngProps :: Map Label Value
ngProps       = [(Label, Value)] -> Map Label Value
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Label, Value)]
nodeProperties
  , ngReturnProps :: [Label]
ngReturnProps = []
  , ngIsReturned :: Bool
ngIsReturned  = Bool
False
  }

-- | Create a 'RelGetter' from 'DSL.RelSelector' from the DSL. 'rgIsReturned' is set to @False@.
rgFromDSL :: DSL.RelSelector -> RelGetter
rgFromDSL :: RelSelector -> RelGetter
rgFromDSL DSL.RelSelector {[(Label, Label)]
[(Label, Value)]
Maybe Label
Label
relParams :: RelSelector -> [(Label, Label)]
relProperties :: RelSelector -> [(Label, Value)]
relLabel :: RelSelector -> Label
relIdentifier :: RelSelector -> Maybe Label
relParams :: [(Label, Label)]
relProperties :: [(Label, Value)]
relLabel :: Label
relIdentifier :: Maybe Label
..} = RelGetter :: Maybe BoltId
-> Maybe Label -> Map Label Value -> [Label] -> Bool -> RelGetter
RelGetter
  { rgboltId :: Maybe BoltId
rgboltId      = Maybe BoltId
forall a. Maybe a
Nothing
  , rgLabel :: Maybe Label
rgLabel       = Label -> Maybe Label
forall a. a -> Maybe a
Just Label
relLabel
  , rgProps :: Map Label Value
rgProps       = [(Label, Value)] -> Map Label Value
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Label, Value)]
relProperties
  , rgReturnProps :: [Label]
rgReturnProps = []
  , rgIsReturned :: Bool
rgIsReturned  = Bool
False
  }

-- | A synonym for '&'. Kept for historical reasons.
(#) :: a -> (a -> b) -> b
# :: a -> (a -> b) -> b
(#) = a -> (a -> b) -> b
forall a b. a -> (a -> b) -> b
(&)

-- | 'NodeGetter' that matches any node.
defaultNode :: Bool       -- ^ Whether to return the node
            -> NodeGetter
defaultNode :: Bool -> NodeGetter
defaultNode = Maybe BoltId
-> [Label] -> Map Label Value -> [Label] -> Bool -> NodeGetter
NodeGetter Maybe BoltId
forall a. Maybe a
Nothing [] ([(Label, Value)] -> Map Label Value
forall k a. Ord k => [(k, a)] -> Map k a
fromList []) []

-- | 'RelGetter' that matches any relation.
defaultRel :: Bool      -- ^ Whether to return the relation
           -> RelGetter
defaultRel :: Bool -> RelGetter
defaultRel = Maybe BoltId
-> Maybe Label -> Map Label Value -> [Label] -> Bool -> RelGetter
RelGetter Maybe BoltId
forall a. Maybe a
Nothing Maybe Label
forall a. Maybe a
Nothing ([(Label, Value)] -> Map Label Value
forall k a. Ord k => [(k, a)] -> Map k a
fromList []) []

-- | 'NodeGetter' that matches any node and returns it.
defaultNodeReturn :: NodeGetter
defaultNodeReturn :: NodeGetter
defaultNodeReturn = Bool -> NodeGetter
defaultNode Bool
True

-- | 'NodeGetter' that matches any node and does not return it.
defaultNodeNotReturn :: NodeGetter
defaultNodeNotReturn :: NodeGetter
defaultNodeNotReturn = Bool -> NodeGetter
defaultNode Bool
False

-- | 'RelGetter' that matches any relation and returns it.
defaultRelReturn :: RelGetter
defaultRelReturn :: RelGetter
defaultRelReturn = Bool -> RelGetter
defaultRel Bool
True


-- | 'RelGetter' that matches any relation and does not return it.
defaultRelNotReturn :: RelGetter
defaultRelNotReturn :: RelGetter
defaultRelNotReturn = Bool -> RelGetter
defaultRel Bool
False

-- | Endomorphisms to set up 'NodeGetter' and 'RelGetter'.
--
class GetterLike a where
    withBoltId :: BoltId          -> a -> a -- ^ set known 'BoltId'
    withLabel  :: Label           -> a -> a -- ^ set known label
    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 entity should be returned

instance GetterLike NodeGetter where
    withBoltId :: BoltId -> NodeGetter -> NodeGetter
withBoltId BoltId
boltId NodeGetter
ng = NodeGetter
ng { ngboltId :: Maybe BoltId
ngboltId       = BoltId -> Maybe BoltId
forall a. a -> Maybe a
Just BoltId
boltId }
    withLabel :: Label -> NodeGetter -> NodeGetter
withLabel  Label
lbl    NodeGetter
ng = NodeGetter
ng { ngLabels :: [Label]
ngLabels       = Label
lbl Label -> [Label] -> [Label]
forall a. a -> [a] -> [a]
: NodeGetter -> [Label]
ngLabels NodeGetter
ng }
    withLabelQ :: Name -> NodeGetter -> NodeGetter
withLabelQ Name
lblQ      = Label -> NodeGetter -> NodeGetter
forall a. GetterLike a => Label -> a -> a
withLabel (String -> Label
pack (String -> Label) -> (Name -> String) -> Name -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase (Name -> Label) -> Name -> Label
forall a b. (a -> b) -> a -> b
$ Name
lblQ)
    withProp :: (Label, Value) -> NodeGetter -> NodeGetter
withProp (Label
pk, Value
pv) NodeGetter
ng = NodeGetter
ng { ngProps :: Map Label Value
ngProps        = Label -> Value -> Map Label Value -> Map Label Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Label
pk Value
pv (NodeGetter -> Map Label Value
ngProps NodeGetter
ng) }
    withReturn :: [Label] -> NodeGetter -> NodeGetter
withReturn [Label]
props  NodeGetter
ng = NodeGetter
ng { ngReturnProps :: [Label]
ngReturnProps  = NodeGetter -> [Label]
ngReturnProps NodeGetter
ng [Label] -> [Label] -> [Label]
forall a. [a] -> [a] -> [a]
++ [Label]
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       = BoltId -> Maybe BoltId
forall a. a -> Maybe a
Just BoltId
boltId }
    withLabel :: Label -> RelGetter -> RelGetter
withLabel  Label
lbl    RelGetter
rg = RelGetter
rg { rgLabel :: Maybe Label
rgLabel        = Label -> Maybe Label
forall a. a -> Maybe a
Just Label
lbl    }
    withLabelQ :: Name -> RelGetter -> RelGetter
withLabelQ Name
lblQ      = Label -> RelGetter -> RelGetter
forall a. GetterLike a => Label -> a -> a
withLabel (String -> Label
pack (String -> Label) -> (Name -> String) -> Name -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase (Name -> Label) -> Name -> Label
forall a b. (a -> b) -> a -> b
$ Name
lblQ)
    withProp :: (Label, Value) -> RelGetter -> RelGetter
withProp (Label
pk, Value
pv) RelGetter
rg = RelGetter
rg { rgProps :: Map Label Value
rgProps        = Label -> Value -> Map Label Value -> Map Label Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Label
pk Value
pv (RelGetter -> Map Label Value
rgProps RelGetter
rg) }
    withReturn :: [Label] -> RelGetter -> RelGetter
withReturn [Label]
props  RelGetter
rg = RelGetter
rg { rgReturnProps :: [Label]
rgReturnProps  = RelGetter -> [Label]
rgReturnProps RelGetter
rg [Label] -> [Label] -> [Label]
forall a. [a] -> [a] -> [a]
++ [Label]
props }
    isReturned :: RelGetter -> RelGetter
isReturned        RelGetter
rg = RelGetter
rg { rgIsReturned :: Bool
rgIsReturned   = Bool
True }

instance Requestable (NodeName, NodeGetter) where
  request :: (Label, NodeGetter) -> Label
request (Label
name, NodeGetter
ng) = [text|($name $labels $propsQ)|]
    where
      labels :: Label
labels = [Label] -> Label
forall a. ToCypher a => a -> Label
toCypher ([Label] -> Label)
-> (NodeGetter -> [Label]) -> NodeGetter -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeGetter -> [Label]
ngLabels (NodeGetter -> Label) -> NodeGetter -> Label
forall a b. (a -> b) -> a -> b
$ NodeGetter
ng
      propsQ :: Label
propsQ = Label
"{" Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> ([(Label, Value)] -> Label
forall a. ToCypher a => a -> Label
toCypher ([(Label, Value)] -> Label)
-> (NodeGetter -> [(Label, Value)]) -> NodeGetter -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Label Value -> [(Label, Value)]
forall k a. Map k a -> [(k, a)]
toList (Map Label Value -> [(Label, Value)])
-> (NodeGetter -> Map Label Value)
-> NodeGetter
-> [(Label, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeGetter -> Map Label Value
ngProps (NodeGetter -> Label) -> NodeGetter -> Label
forall a b. (a -> b) -> a -> b
$ NodeGetter
ng) Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
"}"

instance Requestable ((NodeName, NodeName), RelGetter) where
  request :: ((Label, Label), RelGetter) -> Label
request ((Label
stName, Label
enName), RelGetter
rg) = [text|($stName)-[$name $typeQ $propsQ]->($enName)|]
    where
      name :: Label
name   = (Label, Label) -> Label
relationName (Label
stName, Label
enName)
      typeQ :: Label
typeQ  = Label -> (Label -> Label) -> Maybe Label -> Label
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Label
"" Label -> Label
forall a. ToCypher a => a -> Label
toCypher (RelGetter -> Maybe Label
rgLabel RelGetter
rg)
      propsQ :: Label
propsQ = Label
"{" Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> ([(Label, Value)] -> Label
forall a. ToCypher a => a -> Label
toCypher ([(Label, Value)] -> Label)
-> (RelGetter -> [(Label, Value)]) -> RelGetter -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Label Value -> [(Label, Value)]
forall k a. Map k a -> [(k, a)]
toList (Map Label Value -> [(Label, Value)])
-> (RelGetter -> Map Label Value) -> RelGetter -> [(Label, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelGetter -> Map Label Value
rgProps (RelGetter -> Label) -> RelGetter -> Label
forall a b. (a -> b) -> a -> b
$ RelGetter
rg) Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
"}"

instance Returnable (NodeName, NodeGetter) where
  isReturned' :: (Label, NodeGetter) -> Bool
isReturned' (Label
_, NodeGetter
ng) = NodeGetter -> Bool
ngIsReturned NodeGetter
ng

  return' :: (Label, NodeGetter) -> Label
return' (Label
name, NodeGetter
ng)  = let showProps :: Label
showProps = Label -> [Label] -> Label
showRetProps Label
name ([Label] -> Label) -> [Label] -> Label
forall a b. (a -> b) -> a -> b
$ NodeGetter -> [Label]
ngReturnProps NodeGetter
ng
                        in [text|{ id: id($name),
                                   labels: labels($name),
                                   props: $showProps
                                 } as $name
                           |]

instance Returnable ((NodeName, NodeName), RelGetter) where
  isReturned' :: ((Label, Label), RelGetter) -> Bool
isReturned' ((Label, Label)
_, RelGetter
rg)            = RelGetter -> Bool
rgIsReturned RelGetter
rg

  return' :: ((Label, Label), RelGetter) -> Label
return' ((Label
stName, Label
enName), RelGetter
rg) = let name :: Label
name      = (Label, Label) -> Label
relationName (Label
stName, Label
enName)
                                       showProps :: Label
showProps = Label -> [Label] -> Label
showRetProps Label
name ([Label] -> Label) -> [Label] -> Label
forall a b. (a -> b) -> a -> b
$ RelGetter -> [Label]
rgReturnProps RelGetter
rg
                                   in [text|{ id: id($name),
                                              label: type($name),
                                              props: $showProps
                                            } as $name
                                      |]

-- | Return all properties of a node or relation. To be used with 'withReturn'.
allProps :: [Text]
allProps :: [Label]
allProps = [Label
"*"]

showRetProps :: Text -> [Text] -> Text
showRetProps :: Label -> [Label] -> Label
showRetProps Label
name []    = Label
name Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
"{}"
showRetProps Label
name [Label
"*"] = Label
"properties(" Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
name Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
")"
showRetProps Label
name [Label]
props = Label
name Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
"{" Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label -> [Label] -> Label
intercalate Label
", " (Char -> Label -> Label
cons Char
'.' (Label -> Label) -> [Label] -> [Label]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Label]
props) Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
"}"

-- | Takes all node getters and relationship getters
-- and write them to single query to request.
-- Also return conditions on known boltId-s.
--
requestGetters :: [(NodeName, NodeGetter)]
               -> [((NodeName, NodeName), RelGetter)]
               -> (Text, [Text])
requestGetters :: [(Label, NodeGetter)]
-> [((Label, Label), RelGetter)] -> (Label, [Label])
requestGetters [(Label, NodeGetter)]
ngs [((Label, Label), RelGetter)]
rgs = (Label
"MATCH " Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label -> [Label] -> Label
intercalate Label
", " ((((Label, Label), RelGetter) -> Label)
-> [((Label, Label), RelGetter)] -> [Label]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Label, Label), RelGetter) -> Label
forall a. Requestable a => a -> Label
request [((Label, Label), RelGetter)]
rgs [Label] -> [Label] -> [Label]
forall a. [a] -> [a] -> [a]
++ ((Label, NodeGetter) -> Label) -> [(Label, NodeGetter)] -> [Label]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Label, NodeGetter) -> Label
forall a. Requestable a => a -> Label
request [(Label, NodeGetter)]
ngs), [Label]
conditionsID)
  where
    boltIdCondN :: (NodeName, NodeGetter) -> Maybe Text
    boltIdCondN :: (Label, NodeGetter) -> Maybe Label
boltIdCondN (Label
name, NodeGetter
ng) = String -> Label
pack (String -> Label) -> (BoltId -> String) -> BoltId -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Label -> BoltId -> String
forall r. PrintfType r => String -> r
printf String
"ID(%s)=%d" Label
name (BoltId -> Label) -> Maybe BoltId -> Maybe Label
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 :: ((Label, Label), RelGetter) -> Maybe Label
boltIdCondR ((Label, Label)
names, RelGetter
rg) = String -> Label
pack (String -> Label) -> (BoltId -> String) -> BoltId -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Label -> BoltId -> String
forall r. PrintfType r => String -> r
printf String
"ID(%s)=%d" ((Label, Label) -> Label
relationName (Label, Label)
names) (BoltId -> Label) -> Maybe BoltId -> Maybe Label
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelGetter -> Maybe BoltId
rgboltId RelGetter
rg

    conditionsID :: [Label]
conditionsID  = [Maybe Label] -> [Label]
forall a. [Maybe a] -> [a]
catMaybes (((Label, NodeGetter) -> Maybe Label)
-> [(Label, NodeGetter)] -> [Maybe Label]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Label, NodeGetter) -> Maybe Label
boltIdCondN [(Label, NodeGetter)]
ngs [Maybe Label] -> [Maybe Label] -> [Maybe Label]
forall a. [a] -> [a] -> [a]
++ (((Label, Label), RelGetter) -> Maybe Label)
-> [((Label, Label), RelGetter)] -> [Maybe Label]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Label, Label), RelGetter) -> Maybe Label
boltIdCondR [((Label, Label), RelGetter)]
rgs)

----------------------------------------------------------
-- RESULT --
----------------------------------------------------------

-- | Result for node where properties are represented as @aeson@ 'A.Value'.
--
data NodeResult = NodeResult { NodeResult -> BoltId
nresId     :: BoltId
                             , NodeResult -> [Label]
nresLabels :: [Label]
                             , NodeResult -> Map Label Value
nresProps  :: Map Text A.Value
                             }
  deriving (BoltId -> NodeResult -> ShowS
[NodeResult] -> ShowS
NodeResult -> String
(BoltId -> NodeResult -> ShowS)
-> (NodeResult -> String)
-> ([NodeResult] -> ShowS)
-> Show NodeResult
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
(NodeResult -> NodeResult -> Bool)
-> (NodeResult -> NodeResult -> Bool) -> Eq NodeResult
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. NodeResult -> Rep NodeResult x)
-> (forall x. Rep NodeResult x -> NodeResult) -> Generic NodeResult
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)

-- | Result for relation where properties are represented as @aeson@ 'A.Value'.
--
data RelResult = RelResult { RelResult -> BoltId
rresId    :: BoltId
                           , RelResult -> Label
rresLabel :: Label
                           , RelResult -> Map Label Value
rresProps :: Map Text A.Value
                           }
  deriving (BoltId -> RelResult -> ShowS
[RelResult] -> ShowS
RelResult -> String
(BoltId -> RelResult -> ShowS)
-> (RelResult -> String)
-> ([RelResult] -> ShowS)
-> Show RelResult
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
(RelResult -> RelResult -> Bool)
-> (RelResult -> RelResult -> Bool) -> Eq RelResult
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. RelResult -> Rep RelResult x)
-> (forall x. Rep RelResult x -> RelResult) -> Generic RelResult
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 = Options -> NodeResult -> Value
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 = Options -> Value -> Parser NodeResult
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 = Options -> RelResult -> Value
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 = Options -> Value -> Parser RelResult
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 :: Label -> [Map Label Value] -> BoltActionT m [NodeResult]
extract = Label -> [Map Label Value] -> BoltActionT m [NodeResult]
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Label -> [Map Label Value] -> BoltActionT m [a]
extractFromJSON

instance Extractable RelResult where
  extract :: Label -> [Map Label Value] -> BoltActionT m [RelResult]
extract = Label -> [Map Label Value] -> BoltActionT m [RelResult]
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Label -> [Map Label Value] -> BoltActionT m [a]
extractFromJSON

extractFromJSON :: (MonadIO m, FromJSON a) => Text -> [Record] -> BoltActionT m [a]
extractFromJSON :: Label -> [Map Label Value] -> BoltActionT m [a]
extractFromJSON Label
var = [a] -> BoltActionT m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> BoltActionT m [a])
-> ([Map Label Value] -> [a])
-> [Map Label Value]
-> BoltActionT m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Label Value -> a) -> [Map Label Value] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Map Label Value
r -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Map Label Value
r Map Label Value -> Label -> Value
forall k a. Ord k => Map k a -> k -> a
! Label
var)) of
                                        Success a
parsed -> a
parsed
                                        Error   String
err    -> String -> a
forall a. HasCallStack => String -> a
error String
err)

fromJSONM :: forall a. FromJSON a => A.Value -> Maybe a
fromJSONM :: Value -> Maybe a
fromJSONM (Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON -> Success a
r :: Result a) = a -> Maybe a
forall a. a -> Maybe a
Just a
r
fromJSONM Value
_                                   = Maybe a
forall a. Maybe a
Nothing

instance NodeLike NodeResult where
  toNode :: NodeResult -> Node
toNode NodeResult{BoltId
[Label]
Map Label Value
nresProps :: Map Label Value
nresLabels :: [Label]
nresId :: BoltId
nresProps :: NodeResult -> Map Label Value
nresLabels :: NodeResult -> [Label]
nresId :: NodeResult -> BoltId
..} = BoltId -> [Label] -> Map Label Value -> Node
Node       BoltId
nresId       [Label]
nresLabels (Maybe Value -> Value
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Value -> Value)
-> Map Label (Maybe Value) -> Map Label Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Value -> Bool)
-> Map Label (Maybe Value) -> Map Label (Maybe Value)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Value -> Maybe Value
forall a. FromJSON a => Value -> Maybe a
fromJSONM (Value -> Maybe Value)
-> Map Label Value -> Map Label (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Label Value
nresProps))
  fromNode :: Node -> NodeResult
fromNode Node{BoltId
[Label]
Map Label Value
nodeIdentity :: Node -> BoltId
labels :: Node -> [Label]
nodeProps :: Node -> Map Label Value
nodeProps :: Map Label Value
labels :: [Label]
nodeIdentity :: BoltId
..}     = BoltId -> [Label] -> Map Label Value -> NodeResult
NodeResult BoltId
nodeIdentity [Label]
labels     (Value -> Value
forall a. ToJSON a => a -> Value
toJSON   (Value -> Value) -> Map Label Value -> Map Label Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Label Value
nodeProps)

instance URelationLike RelResult where
  toURelation :: RelResult -> URelationship
toURelation RelResult{BoltId
Label
Map Label Value
rresProps :: Map Label Value
rresLabel :: Label
rresId :: BoltId
rresProps :: RelResult -> Map Label Value
rresLabel :: RelResult -> Label
rresId :: RelResult -> BoltId
..}       = BoltId -> Label -> Map Label Value -> URelationship
URelationship BoltId
rresId       Label
rresLabel (Maybe Value -> Value
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Value -> Value)
-> Map Label (Maybe Value) -> Map Label Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Value -> Bool)
-> Map Label (Maybe Value) -> Map Label (Maybe Value)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Value -> Maybe Value
forall a. FromJSON a => Value -> Maybe a
fromJSONM (Value -> Maybe Value)
-> Map Label Value -> Map Label (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Label Value
rresProps))
  fromURelation :: URelationship -> RelResult
fromURelation URelationship{BoltId
Label
Map Label Value
urelIdentity :: URelationship -> BoltId
urelType :: URelationship -> Label
urelProps :: URelationship -> Map Label Value
urelProps :: Map Label Value
urelType :: Label
urelIdentity :: BoltId
..} = BoltId -> Label -> Map Label Value -> RelResult
RelResult     BoltId
urelIdentity Label
urelType  (Value -> Value
forall a. ToJSON a => a -> Value
toJSON   (Value -> Value) -> Map Label Value -> Map Label Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Label Value
urelProps)

----------------------------------------------------------
-- GRAPH --
----------------------------------------------------------

-- | The combinations of getters 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'.
--
type GraphGetResponse = Graph NodeName NodeResult RelResult


-- | Extract a node by its name from 'GraphGetResponse' and convert it to user type
-- with 'fromNode'.
extractNode :: NodeLike a => NodeName -> GraphGetResponse -> a
extractNode :: Label -> GraphGetResponse -> a
extractNode Label
var GraphGetResponse
graph = GraphGetResponse
graph GraphGetResponse -> Getting a GraphGetResponse a -> a
forall s a. s -> Getting a s a -> a
^. (Map Label NodeResult -> Const a (Map Label NodeResult))
-> GraphGetResponse -> Const a GraphGetResponse
forall n a1 b a2.
Lens (Graph n a1 b) (Graph n a2 b) (Map n a1) (Map n a2)
vertices ((Map Label NodeResult -> Const a (Map Label NodeResult))
 -> GraphGetResponse -> Const a GraphGetResponse)
-> ((a -> Const a a)
    -> Map Label NodeResult -> Const a (Map Label NodeResult))
-> Getting a GraphGetResponse a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Label NodeResult)
-> Lens'
     (Map Label NodeResult) (Maybe (IxValue (Map Label NodeResult)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Label
Index (Map Label NodeResult)
var ((Maybe NodeResult -> Const a (Maybe NodeResult))
 -> Map Label NodeResult -> Const a (Map Label NodeResult))
-> ((a -> Const a a)
    -> Maybe NodeResult -> Const a (Maybe NodeResult))
-> (a -> Const a a)
-> Map Label NodeResult
-> Const a (Map Label NodeResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeResult -> Iso' (Maybe NodeResult) NodeResult
forall a. Eq a => a -> Iso' (Maybe a) a
non (Label -> NodeResult
forall a. Label -> a
errorForNode Label
var) ((NodeResult -> Const a NodeResult)
 -> Maybe NodeResult -> Const a (Maybe NodeResult))
-> ((a -> Const a a) -> NodeResult -> Const a NodeResult)
-> (a -> Const a a)
-> Maybe NodeResult
-> Const a (Maybe NodeResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeResult -> a)
-> (a -> Const a a) -> NodeResult -> Const a NodeResult
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Node -> a
forall a. NodeLike a => Node -> a
fromNode (Node -> a) -> (NodeResult -> Node) -> NodeResult -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeResult -> Node
forall a. NodeLike a => a -> Node
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 :: Label -> Label -> GraphGetResponse -> a
extractRelation Label
stVar Label
enVar GraphGetResponse
graph = GraphGetResponse
graph GraphGetResponse -> Getting a GraphGetResponse a -> a
forall s a. s -> Getting a s a -> a
^. (Map (Label, Label) RelResult
 -> Const a (Map (Label, Label) RelResult))
-> GraphGetResponse -> Const a GraphGetResponse
forall n a1 b b2.
Lens (Graph n a1 b) (Graph n a1 b2) (Map (n, n) b) (Map (n, n) b2)
relations ((Map (Label, Label) RelResult
  -> Const a (Map (Label, Label) RelResult))
 -> GraphGetResponse -> Const a GraphGetResponse)
-> ((a -> Const a a)
    -> Map (Label, Label) RelResult
    -> Const a (Map (Label, Label) RelResult))
-> Getting a GraphGetResponse a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map (Label, Label) RelResult)
-> Lens'
     (Map (Label, Label) RelResult)
     (Maybe (IxValue (Map (Label, Label) RelResult)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Label
stVar, Label
enVar)
                                  ((Maybe RelResult -> Const a (Maybe RelResult))
 -> Map (Label, Label) RelResult
 -> Const a (Map (Label, Label) RelResult))
-> ((a -> Const a a)
    -> Maybe RelResult -> Const a (Maybe RelResult))
-> (a -> Const a a)
-> Map (Label, Label) RelResult
-> Const a (Map (Label, Label) RelResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelResult -> Iso' (Maybe RelResult) RelResult
forall a. Eq a => a -> Iso' (Maybe a) a
non (Label -> Label -> RelResult
forall a. Label -> Label -> a
errorForRelation Label
stVar Label
enVar)
                                  ((RelResult -> Const a RelResult)
 -> Maybe RelResult -> Const a (Maybe RelResult))
-> ((a -> Const a a) -> RelResult -> Const a RelResult)
-> (a -> Const a a)
-> Maybe RelResult
-> Const a (Maybe RelResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RelResult -> a)
-> (a -> Const a a) -> RelResult -> Const a RelResult
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (URelationship -> a
forall a. URelationLike a => URelationship -> a
fromURelation (URelationship -> a)
-> (RelResult -> URelationship) -> RelResult -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelResult -> URelationship
forall a. URelationLike a => a -> URelationship
toURelation)

-- | Extract just node's 'BoltId'.
extractNodeId :: NodeName -> GraphGetResponse -> BoltId
extractNodeId :: Label -> GraphGetResponse -> BoltId
extractNodeId Label
var GraphGetResponse
graph = GraphGetResponse
graph GraphGetResponse
-> Getting BoltId GraphGetResponse BoltId -> BoltId
forall s a. s -> Getting a s a -> a
^. (Map Label NodeResult -> Const BoltId (Map Label NodeResult))
-> GraphGetResponse -> Const BoltId GraphGetResponse
forall n a1 b a2.
Lens (Graph n a1 b) (Graph n a2 b) (Map n a1) (Map n a2)
vertices ((Map Label NodeResult -> Const BoltId (Map Label NodeResult))
 -> GraphGetResponse -> Const BoltId GraphGetResponse)
-> ((BoltId -> Const BoltId BoltId)
    -> Map Label NodeResult -> Const BoltId (Map Label NodeResult))
-> Getting BoltId GraphGetResponse BoltId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Label NodeResult)
-> Lens'
     (Map Label NodeResult) (Maybe (IxValue (Map Label NodeResult)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Label
Index (Map Label NodeResult)
var ((Maybe NodeResult -> Const BoltId (Maybe NodeResult))
 -> Map Label NodeResult -> Const BoltId (Map Label NodeResult))
-> ((BoltId -> Const BoltId BoltId)
    -> Maybe NodeResult -> Const BoltId (Maybe NodeResult))
-> (BoltId -> Const BoltId BoltId)
-> Map Label NodeResult
-> Const BoltId (Map Label NodeResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeResult -> Iso' (Maybe NodeResult) NodeResult
forall a. Eq a => a -> Iso' (Maybe a) a
non (Label -> NodeResult
forall a. Label -> a
errorForNode Label
var) ((NodeResult -> Const BoltId NodeResult)
 -> Maybe NodeResult -> Const BoltId (Maybe NodeResult))
-> ((BoltId -> Const BoltId BoltId)
    -> NodeResult -> Const BoltId NodeResult)
-> (BoltId -> Const BoltId BoltId)
-> Maybe NodeResult
-> Const BoltId (Maybe NodeResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeResult -> BoltId)
-> (BoltId -> Const BoltId BoltId)
-> NodeResult
-> Const BoltId NodeResult
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to NodeResult -> BoltId
nresId

-- | Extract just relation's 'BoltId'.
extractRelationId :: NodeName -> NodeName -> GraphGetResponse -> BoltId
extractRelationId :: Label -> Label -> GraphGetResponse -> BoltId
extractRelationId Label
stVar Label
enVar GraphGetResponse
graph = GraphGetResponse
graph GraphGetResponse
-> Getting BoltId GraphGetResponse BoltId -> BoltId
forall s a. s -> Getting a s a -> a
^. (Map (Label, Label) RelResult
 -> Const BoltId (Map (Label, Label) RelResult))
-> GraphGetResponse -> Const BoltId GraphGetResponse
forall n a1 b b2.
Lens (Graph n a1 b) (Graph n a1 b2) (Map (n, n) b) (Map (n, n) b2)
relations ((Map (Label, Label) RelResult
  -> Const BoltId (Map (Label, Label) RelResult))
 -> GraphGetResponse -> Const BoltId GraphGetResponse)
-> ((BoltId -> Const BoltId BoltId)
    -> Map (Label, Label) RelResult
    -> Const BoltId (Map (Label, Label) RelResult))
-> Getting BoltId GraphGetResponse BoltId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map (Label, Label) RelResult)
-> Lens'
     (Map (Label, Label) RelResult)
     (Maybe (IxValue (Map (Label, Label) RelResult)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Label
stVar, Label
enVar)
                                    ((Maybe RelResult -> Const BoltId (Maybe RelResult))
 -> Map (Label, Label) RelResult
 -> Const BoltId (Map (Label, Label) RelResult))
-> ((BoltId -> Const BoltId BoltId)
    -> Maybe RelResult -> Const BoltId (Maybe RelResult))
-> (BoltId -> Const BoltId BoltId)
-> Map (Label, Label) RelResult
-> Const BoltId (Map (Label, Label) RelResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelResult -> Iso' (Maybe RelResult) RelResult
forall a. Eq a => a -> Iso' (Maybe a) a
non (Label -> Label -> RelResult
forall a. Label -> Label -> a
errorForRelation Label
stVar Label
enVar)
                                    ((RelResult -> Const BoltId RelResult)
 -> Maybe RelResult -> Const BoltId (Maybe RelResult))
-> ((BoltId -> Const BoltId BoltId)
    -> RelResult -> Const BoltId RelResult)
-> (BoltId -> Const BoltId BoltId)
-> Maybe RelResult
-> Const BoltId (Maybe RelResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RelResult -> BoltId)
-> (BoltId -> Const BoltId BoltId)
-> RelResult
-> Const BoltId RelResult
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to RelResult -> BoltId
rresId

-- | Extract 'NodeResult'.
extractNodeAeson :: NodeName -> GraphGetResponse -> NodeResult
extractNodeAeson :: Label -> GraphGetResponse -> NodeResult
extractNodeAeson Label
var GraphGetResponse
graph = GraphGetResponse
graph GraphGetResponse
-> Getting NodeResult GraphGetResponse NodeResult -> NodeResult
forall s a. s -> Getting a s a -> a
^. (Map Label NodeResult -> Const NodeResult (Map Label NodeResult))
-> GraphGetResponse -> Const NodeResult GraphGetResponse
forall n a1 b a2.
Lens (Graph n a1 b) (Graph n a2 b) (Map n a1) (Map n a2)
vertices ((Map Label NodeResult -> Const NodeResult (Map Label NodeResult))
 -> GraphGetResponse -> Const NodeResult GraphGetResponse)
-> ((NodeResult -> Const NodeResult NodeResult)
    -> Map Label NodeResult -> Const NodeResult (Map Label NodeResult))
-> Getting NodeResult GraphGetResponse NodeResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Label NodeResult)
-> Lens'
     (Map Label NodeResult) (Maybe (IxValue (Map Label NodeResult)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Label
Index (Map Label NodeResult)
var ((Maybe NodeResult -> Const NodeResult (Maybe NodeResult))
 -> Map Label NodeResult -> Const NodeResult (Map Label NodeResult))
-> ((NodeResult -> Const NodeResult NodeResult)
    -> Maybe NodeResult -> Const NodeResult (Maybe NodeResult))
-> (NodeResult -> Const NodeResult NodeResult)
-> Map Label NodeResult
-> Const NodeResult (Map Label NodeResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeResult -> Iso' (Maybe NodeResult) NodeResult
forall a. Eq a => a -> Iso' (Maybe a) a
non (Label -> NodeResult
forall a. Label -> a
errorForNode Label
var)

-- | Extract 'RelResult'.
extractRelationAeson :: NodeName -> NodeName -> GraphGetResponse -> RelResult
extractRelationAeson :: Label -> Label -> GraphGetResponse -> RelResult
extractRelationAeson Label
stVar Label
enVar GraphGetResponse
graph = GraphGetResponse
graph GraphGetResponse
-> Getting RelResult GraphGetResponse RelResult -> RelResult
forall s a. s -> Getting a s a -> a
^. (Map (Label, Label) RelResult
 -> Const RelResult (Map (Label, Label) RelResult))
-> GraphGetResponse -> Const RelResult GraphGetResponse
forall n a1 b b2.
Lens (Graph n a1 b) (Graph n a1 b2) (Map (n, n) b) (Map (n, n) b2)
relations ((Map (Label, Label) RelResult
  -> Const RelResult (Map (Label, Label) RelResult))
 -> GraphGetResponse -> Const RelResult GraphGetResponse)
-> ((RelResult -> Const RelResult RelResult)
    -> Map (Label, Label) RelResult
    -> Const RelResult (Map (Label, Label) RelResult))
-> Getting RelResult GraphGetResponse RelResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map (Label, Label) RelResult)
-> Lens'
     (Map (Label, Label) RelResult)
     (Maybe (IxValue (Map (Label, Label) RelResult)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Label
stVar, Label
enVar)
                                       ((Maybe RelResult -> Const RelResult (Maybe RelResult))
 -> Map (Label, Label) RelResult
 -> Const RelResult (Map (Label, Label) RelResult))
-> ((RelResult -> Const RelResult RelResult)
    -> Maybe RelResult -> Const RelResult (Maybe RelResult))
-> (RelResult -> Const RelResult RelResult)
-> Map (Label, Label) RelResult
-> Const RelResult (Map (Label, Label) RelResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelResult -> Iso' (Maybe RelResult) RelResult
forall a. Eq a => a -> Iso' (Maybe a) a
non (Label -> Label -> RelResult
forall a. Label -> Label -> a
errorForRelation Label
stVar Label
enVar)

errorForNode :: NodeName -> a
errorForNode :: Label -> a
errorForNode Label
name = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (Label -> String) -> Label -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> String
unpack (Label -> a) -> Label -> a
forall a b. (a -> b) -> a -> b
$ Label
"node with name " Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
name Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
" doesn't exist"

errorForRelation :: NodeName -> NodeName -> a
errorForRelation :: Label -> Label -> a
errorForRelation Label
stName Label
enName = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (Label -> String) -> Label -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> String
unpack (Label -> a) -> Label -> a
forall a b. (a -> b) -> a -> b
$ Label
"relation between nodes " Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<>
                                                  Label
stName Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
" and " Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
enName Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<>
                                                  Label
" doesn't exist"