{-# 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 -> [NodeName]
ngLabels      :: [Label]          -- ^ known labels
                             , NodeGetter -> Map NodeName Value
ngProps       :: Map Text B.Value -- ^ known properties
                             , NodeGetter -> [NodeName]
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
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)

-- | Helper to find 'URelationship's.
--
data RelGetter = RelGetter { RelGetter -> Maybe BoltId
rgboltId      :: Maybe BoltId     -- ^ known 'BoltId'
                           , RelGetter -> Maybe NodeName
rgLabel       :: Maybe Label      -- ^ known labels
                           , RelGetter -> Map NodeName Value
rgProps       :: Map Text B.Value -- ^ known properties
                           , RelGetter -> [NodeName]
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
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)

-- | Create a 'NodeGetter' from 'DSL.NodeSelector' from the DSL. 'ngIsReturned' is set to @False@.
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
  }

-- | Create a 'RelGetter' from 'DSL.RelSelector' from the DSL. 'rgIsReturned' is set to @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 synonym for '&'. Kept for historical reasons.
(#) :: a -> (a -> b) -> b
# :: forall a 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
-> [NodeName]
-> Map NodeName Value
-> [NodeName]
-> Bool
-> NodeGetter
NodeGetter forall a. Maybe a
Nothing [] (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 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 []) []

-- | '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       = 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
                                      |]

-- | Return all properties of a node or relation. To be used with 'withReturn'.
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
"}"

-- | 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 :: [(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)

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

-- | Result for node where properties are represented as @aeson@ 'A.Value'.
--
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)

-- | Result for relation where properties are represented as @aeson@ 'A.Value'.
--
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]
extractFromJSON :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
NodeName -> [Map NodeName Value] -> BoltActionT m [a]
extractFromJSON 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)

----------------------------------------------------------
-- 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 :: forall a. NodeLike a => NodeName -> GraphGetResponse -> a
extractNode 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)

-- | 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 :: forall a.
URelationLike a =>
NodeName -> NodeName -> GraphGetResponse -> a
extractRelation 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)

-- | Extract just node's 'BoltId'.
extractNodeId :: NodeName -> GraphGetResponse -> BoltId
extractNodeId :: NodeName -> GraphGetResponse -> BoltId
extractNodeId 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

-- | Extract just relation's 'BoltId'.
extractRelationId :: NodeName -> NodeName -> GraphGetResponse -> BoltId
extractRelationId :: NodeName -> NodeName -> GraphGetResponse -> BoltId
extractRelationId 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

-- | Extract 'NodeResult'.
extractNodeAeson :: NodeName -> GraphGetResponse -> NodeResult
extractNodeAeson :: NodeName -> GraphGetResponse -> NodeResult
extractNodeAeson 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)

-- | Extract 'RelResult'.
extractRelationAeson :: NodeName -> NodeName -> GraphGetResponse -> RelResult
extractRelationAeson :: NodeName -> NodeName -> GraphGetResponse -> RelResult
extractRelationAeson 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"