{-# 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           GHC.Stack                                         (HasCallStack)
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 -> [Text]
ngLabels      :: [Label]          -- ^ known labels
                             , NodeGetter -> Map Text Value
ngProps       :: Map Text B.Value -- ^ known properties
                             , NodeGetter -> [Text]
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 Text
rgLabel       :: Maybe Label      -- ^ known labels
                           , RelGetter -> Map Text Value
rgProps       :: Map Text B.Value -- ^ known properties
                           , RelGetter -> [Text]
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 {[(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
  }

-- | Create a 'RelGetter' from 'DSL.RelSelector' from the DSL. 'rgIsReturned' is set to @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 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
-> [Text] -> Map Text Value -> [Text] -> 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 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 []) []

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

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

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

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

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

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

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

-- | Extract a relation by name of it start and end nodes and convert to user type with 'fromURelation'.
extractRelation :: HasCallStack => URelationLike a => NodeName -> NodeName -> GraphGetResponse -> a
extractRelation :: forall a.
(HasCallStack, URelationLike a) =>
Text -> Text -> GraphGetResponse -> a
extractRelation 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)

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

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

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

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