{-# LANGUAGE AllowAmbiguousTypes     #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE OverloadedStrings       #-}
{-# LANGUAGE QuasiQuotes             #-}
{-# LANGUAGE ScopedTypeVariables     #-}
{-# LANGUAGE TypeApplications        #-}
{-# LANGUAGE TypeFamilies            #-}
{-# LANGUAGE TypeFamilyDependencies  #-}

module Database.Bolt.Extras.Graph.Internal.GraphQuery
  (
    GraphQuery (..)
  , GetRequest (..)
  , PutRequest (..)
  , mergeGraphs
  ) where

import           Control.Lens                                      (over, (^.))
import           Control.Monad.IO.Class                            (MonadIO)
import           Data.List                                         (foldl')
import           Data.Map.Strict                                   (fromList,
                                                                    mapKeys,
                                                                    mapWithKey,
                                                                    toList,
                                                                    union, (!))
import           Data.Text                                         as T (Text, intercalate,
                                                                         null,
                                                                         pack)
import           Database.Bolt                                     (BoltActionT,
                                                                    Record,
                                                                    query)
import           Database.Bolt.Extras                              (BoltId, GetBoltId (..))
import           Database.Bolt.Extras.Graph.Internal.AbstractGraph (Graph (..),
                                                                    NodeName,
                                                                    emptyGraph,
                                                                    relationName,
                                                                    relations,
                                                                    vertices)
import           Database.Bolt.Extras.Graph.Internal.Class         (Extractable (..),
                                                                    Requestable (..),
                                                                    Returnable (..))
import           Database.Bolt.Extras.Graph.Internal.Get           (NodeGetter,
                                                                    NodeResult,
                                                                    RelGetter,
                                                                    RelResult,
                                                                    requestGetters)
import           Database.Bolt.Extras.Graph.Internal.Put           (PutNode, PutRelationship,
                                                                    requestPut)
import           NeatInterpolation                                 (text)

-- | Type class used to perform requests to the Neo4j based on graphs.
--
class GraphQuery a where
  -- | Type of entity describing node for request.
  type NodeReq a :: *
  -- | Type of entity describing relationship for request.
  type RelReq  a :: *
  -- | Type of node entity which will be extracted from result.
  type NodeRes a :: *
  -- | Type of relationship entity which will be extracted from result.
  type RelRes  a :: *

  -- | Convert requestable entities to text in the query.
  requestEntities :: (Requestable (NodeName, NodeReq a),
                      Requestable ((NodeName, NodeName), RelReq a))
                  => [(NodeName, NodeReq a)]
                  -> [((NodeName, NodeName), RelReq a)]
                  -> (Text, [Text])

  -- | Abstract function to form query for request.
  --
  formQuery :: (Requestable (NodeName, NodeReq a),
                Requestable ((NodeName, NodeName), RelReq a),
                Returnable (NodeName, NodeReq a),
                Returnable ((NodeName, NodeName), RelReq a))
            => [Text]                                -- ^ Custom conditions that will be added to @WHERE@ block.
            -> Graph NodeName (NodeReq a) (RelReq a) -- ^ Request graph template.
            -> Text                                  -- ^ Cypher query as text.
  formQuery [Text]
customConds Graph Text (NodeReq a) (RelReq a)
graph = [text|$completeRequest
                                      $conditionsQ
                                      WITH DISTINCT $distinctVars
                                      RETURN $completeReturn|]
    where
      vertices' :: [(Text, NodeReq a)]
vertices'        = Map Text (NodeReq a) -> [(Text, NodeReq a)]
forall k a. Map k a -> [(k, a)]
toList (Graph Text (NodeReq a) (RelReq a)
graph Graph Text (NodeReq a) (RelReq a)
-> Getting
     (Map Text (NodeReq a))
     (Graph Text (NodeReq a) (RelReq a))
     (Map Text (NodeReq a))
-> Map Text (NodeReq a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Text (NodeReq a))
  (Graph Text (NodeReq a) (RelReq a))
  (Map Text (NodeReq a))
forall n a b a2.
Lens (Graph n a b) (Graph n a2 b) (Map n a) (Map n a2)
vertices)
      relations' :: [((Text, Text), RelReq a)]
relations'       = Map (Text, Text) (RelReq a) -> [((Text, Text), RelReq a)]
forall k a. Map k a -> [(k, a)]
toList (Graph Text (NodeReq a) (RelReq a)
graph Graph Text (NodeReq a) (RelReq a)
-> Getting
     (Map (Text, Text) (RelReq a))
     (Graph Text (NodeReq a) (RelReq a))
     (Map (Text, Text) (RelReq a))
-> Map (Text, Text) (RelReq a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Text, Text) (RelReq a))
  (Graph Text (NodeReq a) (RelReq a))
  (Map (Text, Text) (RelReq a))
forall n a b b2.
Lens (Graph n a b) (Graph n a b2) (Map (n, n) b) (Map (n, n) b2)
relations)
      distinctVars :: Text
distinctVars     = Text -> [Text] -> Text
intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Text, NodeReq a) -> Text) -> [(Text, NodeReq a)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, NodeReq a) -> Text
forall a b. (a, b) -> a
fst [(Text, NodeReq a)]
vertices' [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (((Text, Text), RelReq a) -> Text)
-> [((Text, Text), RelReq a)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text, Text) -> Text
relationName ((Text, Text) -> Text)
-> (((Text, Text), RelReq a) -> (Text, Text))
-> ((Text, Text), RelReq a)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text), RelReq a) -> (Text, Text)
forall a b. (a, b) -> a
fst) [((Text, Text), RelReq a)]
relations'

      (Text
completeRequest, [Text]
reqConds) = [(Text, NodeReq a)] -> [((Text, Text), RelReq a)] -> (Text, [Text])
forall a.
(GraphQuery a, Requestable (Text, NodeReq a),
 Requestable ((Text, Text), RelReq a)) =>
[(Text, NodeReq a)] -> [((Text, Text), RelReq a)] -> (Text, [Text])
requestEntities @a [(Text, NodeReq a)]
vertices' [((Text, Text), RelReq a)]
relations'

      conditions :: [Text]
conditions       = [Text]
reqConds [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
customConds
      conditionsQ :: Text
conditionsQ      = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [Text]
conditions then Text
"" else Text
" WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
" AND " [Text]
conditions

      returnVertices :: [Text]
returnVertices   = (Text, NodeReq a) -> Text
forall a. Returnable a => a -> Text
return' ((Text, NodeReq a) -> Text) -> [(Text, NodeReq a)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, NodeReq a) -> Bool)
-> [(Text, NodeReq a)] -> [(Text, NodeReq a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text, NodeReq a) -> Bool
forall a. Returnable a => a -> Bool
isReturned' [(Text, NodeReq a)]
vertices'
      returnRelations :: [Text]
returnRelations  = ((Text, Text), RelReq a) -> Text
forall a. Returnable a => a -> Text
return' (((Text, Text), RelReq a) -> Text)
-> [((Text, Text), RelReq a)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Text, Text), RelReq a) -> Bool)
-> [((Text, Text), RelReq a)] -> [((Text, Text), RelReq a)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text, Text), RelReq a) -> Bool
forall a. Returnable a => a -> Bool
isReturned' [((Text, Text), RelReq a)]
relations'

      completeReturn :: Text
completeReturn   = Text -> [Text] -> Text
intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
returnVertices [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
returnRelations

  -- | Abstract function which exctracts graph from records if nodes and relations can be extracted.
  --
  extractGraphs :: (Extractable (NodeRes a), Extractable (RelRes a), MonadIO m)
                => [NodeName]
                -> [(NodeName, NodeName)]
                -> [Record]
                -> BoltActionT m [Graph NodeName (NodeRes a) (RelRes a)]
  extractGraphs [Text]
verticesN [(Text, Text)]
relationsN [Record]
records = (Int -> BoltActionT m (Graph Text (NodeRes a) (RelRes a)))
-> [Int] -> BoltActionT m [Graph Text (NodeRes a) (RelRes a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
i -> do
        [(Text, NodeRes a)]
vertices'  <- [Text] -> [NodeRes a] -> [(Text, NodeRes a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
verticesN  ([NodeRes a] -> [(Text, NodeRes a)])
-> BoltActionT m [NodeRes a] -> BoltActionT m [(Text, NodeRes a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> BoltActionT m (NodeRes a))
-> [Text] -> BoltActionT m [NodeRes a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (([NodeRes a] -> NodeRes a)
-> BoltActionT m [NodeRes a] -> BoltActionT m (NodeRes a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([NodeRes a] -> Int -> NodeRes a
forall a. [a] -> Int -> a
!! Int
i) (BoltActionT m [NodeRes a] -> BoltActionT m (NodeRes a))
-> (Text -> BoltActionT m [NodeRes a])
-> Text
-> BoltActionT m (NodeRes a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Record] -> BoltActionT m [NodeRes a])
-> [Record] -> Text -> BoltActionT m [NodeRes a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Record] -> BoltActionT m [NodeRes a]
forall a (m :: * -> *).
(Extractable a, MonadIO m) =>
Text -> [Record] -> BoltActionT m [a]
extract [Record]
records               ) [Text]
verticesN
        [((Text, Text), RelRes a)]
relations' <- [(Text, Text)] -> [RelRes a] -> [((Text, Text), RelRes a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, Text)]
relationsN ([RelRes a] -> [((Text, Text), RelRes a)])
-> BoltActionT m [RelRes a]
-> BoltActionT m [((Text, Text), RelRes a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Text) -> BoltActionT m (RelRes a))
-> [(Text, Text)] -> BoltActionT m [RelRes a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (([RelRes a] -> RelRes a)
-> BoltActionT m [RelRes a] -> BoltActionT m (RelRes a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([RelRes a] -> Int -> RelRes a
forall a. [a] -> Int -> a
!! Int
i) (BoltActionT m [RelRes a] -> BoltActionT m (RelRes a))
-> ((Text, Text) -> BoltActionT m [RelRes a])
-> (Text, Text)
-> BoltActionT m (RelRes a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Record] -> BoltActionT m [RelRes a])
-> [Record] -> Text -> BoltActionT m [RelRes a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Record] -> BoltActionT m [RelRes a]
forall a (m :: * -> *).
(Extractable a, MonadIO m) =>
Text -> [Record] -> BoltActionT m [a]
extract [Record]
records (Text -> BoltActionT m [RelRes a])
-> ((Text, Text) -> Text)
-> (Text, Text)
-> BoltActionT m [RelRes a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
relationName) [(Text, Text)]
relationsN
        Graph Text (NodeRes a) (RelRes a)
-> BoltActionT m (Graph Text (NodeRes a) (RelRes a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Graph Text (NodeRes a) (RelRes a)
 -> BoltActionT m (Graph Text (NodeRes a) (RelRes a)))
-> Graph Text (NodeRes a) (RelRes a)
-> BoltActionT m (Graph Text (NodeRes a) (RelRes a))
forall a b. (a -> b) -> a -> b
$ Map Text (NodeRes a)
-> Map (Text, Text) (RelRes a) -> Graph Text (NodeRes a) (RelRes a)
forall n a b. Map n a -> Map (n, n) b -> Graph n a b
Graph ([(Text, NodeRes a)] -> Map Text (NodeRes a)
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Text, NodeRes a)]
vertices') ([((Text, Text), RelRes a)] -> Map (Text, Text) (RelRes a)
forall k a. Ord k => [(k, a)] -> Map k a
fromList [((Text, Text), RelRes a)]
relations'))
      [Int
0 .. [Record] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Record]
records Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

  -- | For given query graph, perform query and extract results graph.
  --
  makeRequest :: (Requestable (NodeName, NodeReq a),
                  Requestable ((NodeName, NodeName), RelReq a),
                  Returnable (NodeName, NodeReq a),
                  Returnable ((NodeName, NodeName), RelReq a),
                  Extractable (NodeRes a),
                  Extractable (RelRes a),
                  MonadIO m)
              => [Text]
              -> Graph NodeName (NodeReq a) (RelReq a)
              -> BoltActionT m [Graph NodeName (NodeRes a) (RelRes a)]
  makeRequest [Text]
conds Graph Text (NodeReq a) (RelReq a)
graph = do
      [Record]
response <- Text -> BoltActionT m [Record]
forall (m :: * -> *). MonadIO m => Text -> BoltActionT m [Record]
query (Text -> BoltActionT m [Record]) -> Text -> BoltActionT m [Record]
forall a b. (a -> b) -> a -> b
$ [Text] -> Graph Text (NodeReq a) (RelReq a) -> Text
forall a.
(GraphQuery a, Requestable (Text, NodeReq a),
 Requestable ((Text, Text), RelReq a), Returnable (Text, NodeReq a),
 Returnable ((Text, Text), RelReq a)) =>
[Text] -> Graph Text (NodeReq a) (RelReq a) -> Text
formQuery @a [Text]
conds Graph Text (NodeReq a) (RelReq a)
graph
      [Text]
-> [(Text, Text)]
-> [Record]
-> BoltActionT m [Graph Text (NodeRes a) (RelRes a)]
forall a (m :: * -> *).
(GraphQuery a, Extractable (NodeRes a), Extractable (RelRes a),
 MonadIO m) =>
[Text]
-> [(Text, Text)]
-> [Record]
-> BoltActionT m [Graph Text (NodeRes a) (RelRes a)]
extractGraphs @a [Text]
presentedVertices [(Text, Text)]
presentedRelations [Record]
response
    where
      presentedVertices :: [Text]
presentedVertices  = ((Text, NodeReq a) -> Text) -> [(Text, NodeReq a)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, NodeReq a) -> Text
forall a b. (a, b) -> a
fst ([(Text, NodeReq a)] -> [Text])
-> (Map Text (NodeReq a) -> [(Text, NodeReq a)])
-> Map Text (NodeReq a)
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, NodeReq a) -> Bool)
-> [(Text, NodeReq a)] -> [(Text, NodeReq a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text, NodeReq a) -> Bool
forall a. Returnable a => a -> Bool
isReturned' ([(Text, NodeReq a)] -> [(Text, NodeReq a)])
-> (Map Text (NodeReq a) -> [(Text, NodeReq a)])
-> Map Text (NodeReq a)
-> [(Text, NodeReq a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (NodeReq a) -> [(Text, NodeReq a)]
forall k a. Map k a -> [(k, a)]
toList (Map Text (NodeReq a) -> [Text]) -> Map Text (NodeReq a) -> [Text]
forall a b. (a -> b) -> a -> b
$ Graph Text (NodeReq a) (RelReq a)
graph Graph Text (NodeReq a) (RelReq a)
-> Getting
     (Map Text (NodeReq a))
     (Graph Text (NodeReq a) (RelReq a))
     (Map Text (NodeReq a))
-> Map Text (NodeReq a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Text (NodeReq a))
  (Graph Text (NodeReq a) (RelReq a))
  (Map Text (NodeReq a))
forall n a b a2.
Lens (Graph n a b) (Graph n a2 b) (Map n a) (Map n a2)
vertices
      presentedRelations :: [(Text, Text)]
presentedRelations = (((Text, Text), RelReq a) -> (Text, Text))
-> [((Text, Text), RelReq a)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text, Text), RelReq a) -> (Text, Text)
forall a b. (a, b) -> a
fst ([((Text, Text), RelReq a)] -> [(Text, Text)])
-> (Map (Text, Text) (RelReq a) -> [((Text, Text), RelReq a)])
-> Map (Text, Text) (RelReq a)
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text, Text), RelReq a) -> Bool)
-> [((Text, Text), RelReq a)] -> [((Text, Text), RelReq a)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text, Text), RelReq a) -> Bool
forall a. Returnable a => a -> Bool
isReturned' ([((Text, Text), RelReq a)] -> [((Text, Text), RelReq a)])
-> (Map (Text, Text) (RelReq a) -> [((Text, Text), RelReq a)])
-> Map (Text, Text) (RelReq a)
-> [((Text, Text), RelReq a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Text, Text) (RelReq a) -> [((Text, Text), RelReq a)]
forall k a. Map k a -> [(k, a)]
toList (Map (Text, Text) (RelReq a) -> [(Text, Text)])
-> Map (Text, Text) (RelReq a) -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Graph Text (NodeReq a) (RelReq a)
graph Graph Text (NodeReq a) (RelReq a)
-> Getting
     (Map (Text, Text) (RelReq a))
     (Graph Text (NodeReq a) (RelReq a))
     (Map (Text, Text) (RelReq a))
-> Map (Text, Text) (RelReq a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Text, Text) (RelReq a))
  (Graph Text (NodeReq a) (RelReq a))
  (Map (Text, Text) (RelReq a))
forall n a b b2.
Lens (Graph n a b) (Graph n a b2) (Map (n, n) b) (Map (n, n) b2)
relations

---------------------------------------------------------------------------------------
-- GET --
---------------------------------------------------------------------------------------

-- | Get request with graph result.
--
data GetRequest = GetRequest

instance GraphQuery GetRequest where
  type NodeReq GetRequest = NodeGetter
  type RelReq  GetRequest = RelGetter
  type NodeRes GetRequest = NodeResult
  type RelRes  GetRequest = RelResult
  requestEntities :: [(Text, NodeReq GetRequest)]
-> [((Text, Text), RelReq GetRequest)] -> (Text, [Text])
requestEntities         = [(Text, NodeGetter)]
-> [((Text, Text), RelGetter)] -> (Text, [Text])
[(Text, NodeReq GetRequest)]
-> [((Text, Text), RelReq GetRequest)] -> (Text, [Text])
requestGetters

---------------------------------------------------------------------------------------
-- PUT --
---------------------------------------------------------------------------------------

-- | Put request in Bolt format with 'BoltId's of uploaded entities as result.
--
data PutRequest = PutRequest

instance GraphQuery PutRequest where
  type NodeReq PutRequest = PutNode
  type RelReq  PutRequest = PutRelationship
  type NodeRes PutRequest = BoltId
  type RelRes  PutRequest = BoltId
  requestEntities :: [(Text, NodeReq PutRequest)]
-> [((Text, Text), RelReq PutRequest)] -> (Text, [Text])
requestEntities          = [(Text, PutNode)]
-> [((Text, Text), PutRelationship)] -> (Text, [Text])
[(Text, NodeReq PutRequest)]
-> [((Text, Text), RelReq PutRequest)] -> (Text, [Text])
requestPut

-- | Helper function to merge graphs of results, i.e.
-- if you requested graph @A -> B -> C@
-- and in the database there were two @B@ entities connected to the same entity @A@
-- and four @C@ entities connected to the same two entities @B@,
-- Cypher query will return four graphs which satisfy this path,
-- despite the fact that @A@ was present only once in the database
-- and @B@ was present only two times in the database.
--
-- This function will merge these four graphs in one
-- and return nodes by node names with suffixes equal to their 'BoltId's.
--
-- For example, if there were four graphs:
--
-- @
--   nodes: [A (boltId = 0), B (boltId = 1), C (boltId = 3)], relations: [A -> B, B -> C];
--   nodes: [A (boltId = 0), B (boltId = 1), C (boltId = 4)], relations: [A -> B, B -> C];
--   nodes: [A (boltId = 0), B (boltId = 2), C (boltId = 5)], relations: [A -> B, B -> C];
--   nodes: [A (boltId = 0), B (boltId = 2), C (boltId = 6)], relations: [A -> B, B -> C].
-- @
-- this function will merge them into new graph:
--
-- @
--   nodes: [A0 (boltId = 0), B1 (boltId = 1), B2 (boltId = 2),
--           C3 (boltId = 3), C4 (boltId = 4), C5 (boltId = 5), C6 (boltId = 6)],
--   relations: [A0 -> B1, A0 -> B2, B1 -> C3, B1 -> C4, B2 -> C5, B2 -> C6].
-- @
--
mergeGraphs :: GetBoltId a => [Graph NodeName a b] -> Graph NodeName a b
mergeGraphs :: [Graph Text a b] -> Graph Text a b
mergeGraphs [Graph Text a b]
graphs = (Graph Text a b -> Graph Text a b -> Graph Text a b)
-> Graph Text a b -> [Graph Text a b] -> Graph Text a b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Graph Text a b -> Graph Text a b -> Graph Text a b
forall a b.
GetBoltId a =>
Graph Text a b -> Graph Text a b -> Graph Text a b
mergeGraph Graph Text a b
forall n a b. Ord n => Graph n a b
emptyGraph (Graph Text a b -> Graph Text a b
forall a b. GetBoltId a => Graph Text a b -> Graph Text a b
updateGraph (Graph Text a b -> Graph Text a b)
-> [Graph Text a b] -> [Graph Text a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Graph Text a b]
graphs)
  where
    updateGraph :: GetBoltId a => Graph NodeName a b -> Graph NodeName a b
    updateGraph :: Graph Text a b -> Graph Text a b
updateGraph Graph Text a b
graph = Map Text a -> Map (Text, Text) b -> Graph Text a b
forall n a b. Map n a -> Map (n, n) b -> Graph n a b
Graph Map Text a
newVertices Map (Text, Text) b
newRelations
      where
        namesMap :: Map Text Text
namesMap     = (\Text
name        a
node     ->  Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (a -> Int) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. GetBoltId a => a -> Int
getBoltId (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ a
node)  ) (Text -> a -> Text) -> Map Text a -> Map Text Text
forall k a b. (k -> a -> b) -> Map k a -> Map k b
`mapWithKey` (Graph Text a b
graph Graph Text a b
-> Getting (Map Text a) (Graph Text a b) (Map Text a) -> Map Text a
forall s a. s -> Getting a s a -> a
^. Getting (Map Text a) (Graph Text a b) (Map Text a)
forall n a b a2.
Lens (Graph n a b) (Graph n a2 b) (Map n a) (Map n a2)
vertices)
        newVertices :: Map Text a
newVertices  = (\Text
name                 ->  Map Text Text
namesMap Map Text Text -> Text -> Text
forall k a. Ord k => Map k a -> k -> a
! Text
name                           ) (Text -> Text) -> Map Text a -> Map Text a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
`mapKeys`    (Graph Text a b
graph Graph Text a b
-> Getting (Map Text a) (Graph Text a b) (Map Text a) -> Map Text a
forall s a. s -> Getting a s a -> a
^. Getting (Map Text a) (Graph Text a b) (Map Text a)
forall n a b a2.
Lens (Graph n a b) (Graph n a2 b) (Map n a) (Map n a2)
vertices)
        newRelations :: Map (Text, Text) b
newRelations = (\(Text
startName, Text
endName) -> (Map Text Text
namesMap Map Text Text -> Text -> Text
forall k a. Ord k => Map k a -> k -> a
! Text
startName, Map Text Text
namesMap Map Text Text -> Text -> Text
forall k a. Ord k => Map k a -> k -> a
! Text
endName) ) ((Text, Text) -> (Text, Text))
-> Map (Text, Text) b -> Map (Text, Text) b
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
`mapKeys`    (Graph Text a b
graph Graph Text a b
-> Getting
     (Map (Text, Text) b) (Graph Text a b) (Map (Text, Text) b)
-> Map (Text, Text) b
forall s a. s -> Getting a s a -> a
^. Getting (Map (Text, Text) b) (Graph Text a b) (Map (Text, Text) b)
forall n a b b2.
Lens (Graph n a b) (Graph n a b2) (Map (n, n) b) (Map (n, n) b2)
relations)

    mergeGraph :: GetBoltId a => Graph NodeName a b -> Graph NodeName a b -> Graph NodeName a b
    mergeGraph :: Graph Text a b -> Graph Text a b -> Graph Text a b
mergeGraph Graph Text a b
graphToMerge Graph Text a b
initialGraph = ASetter
  (Graph Text a b)
  (Graph Text a b)
  (Map (Text, Text) b)
  (Map (Text, Text) b)
-> (Map (Text, Text) b -> Map (Text, Text) b)
-> Graph Text a b
-> Graph Text a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Graph Text a b)
  (Graph Text a b)
  (Map (Text, Text) b)
  (Map (Text, Text) b)
forall n a b b2.
Lens (Graph n a b) (Graph n a b2) (Map (n, n) b) (Map (n, n) b2)
relations (Map (Text, Text) b -> Map (Text, Text) b -> Map (Text, Text) b
forall k a. Ord k => Map k a -> Map k a -> Map k a
union (Graph Text a b
graphToMerge Graph Text a b
-> Getting
     (Map (Text, Text) b) (Graph Text a b) (Map (Text, Text) b)
-> Map (Text, Text) b
forall s a. s -> Getting a s a -> a
^. Getting (Map (Text, Text) b) (Graph Text a b) (Map (Text, Text) b)
forall n a b b2.
Lens (Graph n a b) (Graph n a b2) (Map (n, n) b) (Map (n, n) b2)
relations)) (Graph Text a b -> Graph Text a b)
-> Graph Text a b -> Graph Text a b
forall a b. (a -> b) -> a -> b
$
                                           ASetter (Graph Text a b) (Graph Text a b) (Map Text a) (Map Text a)
-> (Map Text a -> Map Text a) -> Graph Text a b -> Graph Text a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Graph Text a b) (Graph Text a b) (Map Text a) (Map Text a)
forall n a b a2.
Lens (Graph n a b) (Graph n a2 b) (Map n a) (Map n a2)
vertices  (Map Text a -> Map Text a -> Map Text a
forall k a. Ord k => Map k a -> Map k a -> Map k a
union (Graph Text a b
graphToMerge Graph Text a b
-> Getting (Map Text a) (Graph Text a b) (Map Text a) -> Map Text a
forall s a. s -> Getting a s a -> a
^. Getting (Map Text a) (Graph Text a b) (Map Text a)
forall n a b a2.
Lens (Graph n a b) (Graph n a2 b) (Map n a) (Map n a2)
vertices))
                                           Graph Text a b
initialGraph