{-# LANGUAGE OverloadedStrings, TypeFamilies #-}
-- |
-- Module: NetSpider.Spider
-- Description: Spider type.
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- 
module NetSpider.Spider
       ( -- * Spider type
         Spider,
         -- * Make Spider
         connectWS,
         connectWith,
         -- * Close Spider
         close,
         -- * Bracket form
         withSpider,
         -- * Graph operations
         addFoundNode,
         getSnapshotSimple,
         getSnapshot,
         clearAll
       ) where

import Control.Category ((<<<))
import Control.Exception.Safe (throwString, bracket)
import Control.Monad (void, mapM_, mapM, when)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (ToJSON)
import Data.Foldable (foldr', toList, foldl')
import Data.List (reverse)
import Data.Greskell
  ( runBinder, ($.), (<$.>), (<*.>),
    Greskell, Binder, ToGreskell(GreskellReturn), AsIterator(IteratorItem), FromGraphSON,
    liftWalk, gLimit, gIdentity, gSelect1, gAs, gProject, gByL, gIdentity, gFold,
    gRepeat, gEmitHead, gSimplePath, gConstant, gLocal,
    lookupAsM, newAsLabel,
    Transform, Walk, SideEffect
  )
import Data.Greskell.Extra (gWhenEmptyInput)
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import Data.IORef (IORef, modifyIORef, newIORef, readIORef, atomicModifyIORef')
import Data.Maybe (catMaybes, mapMaybe, listToMaybe)
import Data.Monoid (mempty, (<>))
import Data.Text (Text, pack, intercalate)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Network.Greskell.WebSocket (Host, Port)
import qualified Network.Greskell.WebSocket as Gr

import NetSpider.Graph (EID, LinkAttributes, NodeAttributes)
import NetSpider.Graph.Internal
  ( VFoundNode, EFinds, VNode,
    VFoundNodeData(..), EFindsData(..),
    gVFoundNodeData, gEFindsData,
    makeFoundNode, makeFoundLink
  )
import NetSpider.Found
  (FoundNode(..), FoundLink(..), LinkState(..), allTargetNodes)
import qualified NetSpider.Found as Found
import NetSpider.Log (runWriterLoggingM, WriterLoggingM, logDebugW, LogLine, spack)
import NetSpider.Pair (Pair)
import NetSpider.Queue (Queue, newQueue, popQueue, pushQueue)
import NetSpider.Query
  ( Query, defQuery, startsFrom, unifyLinkSamples, timeInterval,
    foundNodePolicy,
    Interval
  )
import NetSpider.Query.Internal (FoundNodePolicy(..))
import NetSpider.Snapshot.Internal (SnapshotGraph, SnapshotNode(..), SnapshotLink(..))
import NetSpider.Spider.Config (Config(..), defConfig)
import NetSpider.Spider.Internal.Graph
  ( gMakeFoundNode, gAllNodes, gHasNodeID, gHasNodeEID, gNodeEID, gNodeID, gMakeNode, gClearAll,
    gLatestFoundNode, gSelectFoundNode, gFinds, gFindsTarget, gHasFoundNodeEID, gAllFoundNode,
    gFilterFoundNodeByTime, gSubjectNodeID, gTraverseViaFinds,
    gNodeMix, gFoundNodeOnly, gEitherNodeMix, gDedupNodes
  )
import NetSpider.Spider.Internal.Log
  ( runLogger, logDebug, logWarn, logLine
  )
import NetSpider.Spider.Internal.Spider (Spider(..))
import NetSpider.Timestamp (Timestamp, showTimestamp)
import NetSpider.Unify (LinkSampleUnifier, LinkSample(..), LinkSampleID, linkSampleId)
import NetSpider.Weaver (Weaver, newWeaver)
import qualified NetSpider.Weaver as Weaver

-- | Connect to the WebSocket endpoint of Tinkerpop Gremlin Server
-- that hosts the NetSpider database.
connectWS :: Eq n => Host -> Port -> IO (Spider n na la)
connectWS :: Host -> Port -> IO (Spider n na la)
connectWS Host
host Port
port = Config n na la -> IO (Spider n na la)
forall n na fla. Config n na fla -> IO (Spider n na fla)
connectWith (Config n na la -> IO (Spider n na la))
-> Config n na la -> IO (Spider n na la)
forall a b. (a -> b) -> a -> b
$ Config n Any Any
forall n na fla. Config n na fla
defConfig { wsHost :: Host
wsHost = Host
host,
                                                wsPort :: Port
wsPort = Port
port
                                              }

-- | Connect to the server with the given 'Config'.
connectWith :: Config n na fla -> IO (Spider n na fla)
connectWith :: Config n na fla -> IO (Spider n na fla)
connectWith Config n na fla
conf = do
  Client
client <- Host -> Port -> IO Client
Gr.connect (Config n na fla -> Host
forall n na fla. Config n na fla -> Host
wsHost Config n na fla
conf) (Config n na fla -> Port
forall n na fla. Config n na fla -> Port
wsPort Config n na fla
conf)
  Spider n na fla -> IO (Spider n na fla)
forall (m :: * -> *) a. Monad m => a -> m a
return (Spider n na fla -> IO (Spider n na fla))
-> Spider n na fla -> IO (Spider n na fla)
forall a b. (a -> b) -> a -> b
$ Spider :: forall n na fla. Config n na fla -> Client -> Spider n na fla
Spider { spiderConfig :: Config n na fla
spiderConfig = Config n na fla
conf,
                    spiderClient :: Client
spiderClient = Client
client
                  }
  
-- | Close and release the 'Spider' object.
close :: Spider n na fla -> IO ()
close :: Spider n na fla -> IO ()
close Spider n na fla
sp = Client -> IO ()
Gr.close (Client -> IO ()) -> Client -> IO ()
forall a b. (a -> b) -> a -> b
$ Spider n na fla -> Client
forall n na fla. Spider n na fla -> Client
spiderClient Spider n na fla
sp

-- | Connect the spider, run the given action and close the
-- connection.
--
-- @since 0.3.2.0
withSpider :: Config n na fla -> (Spider n na fla -> IO a) -> IO a
withSpider :: Config n na fla -> (Spider n na fla -> IO a) -> IO a
withSpider Config n na fla
conf = IO (Spider n na fla)
-> (Spider n na fla -> IO ()) -> (Spider n na fla -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Config n na fla -> IO (Spider n na fla)
forall n na fla. Config n na fla -> IO (Spider n na fla)
connectWith Config n na fla
conf) Spider n na fla -> IO ()
forall n na fla. Spider n na fla -> IO ()
close

submitB :: (ToGreskell g, r ~ GreskellReturn g, AsIterator r, v ~ IteratorItem r, FromGraphSON v)
        => Spider n na fla -> Binder g -> IO (Gr.ResultHandle v)
submitB :: Spider n na fla -> Binder g -> IO (ResultHandle v)
submitB Spider n na fla
sp Binder g
b = Client -> g -> Maybe Object -> IO (ResultHandle v)
forall g r v.
(ToGreskell g, r ~ GreskellReturn g, AsIterator r,
 v ~ IteratorItem r, FromGraphSON v) =>
Client -> g -> Maybe Object -> IO (ResultHandle v)
Gr.submit (Spider n na fla -> Client
forall n na fla. Spider n na fla -> Client
spiderClient Spider n na fla
sp) g
script Maybe Object
mbs
  where
    (g
script, Object
bs) = Binder g -> (g, Object)
forall a. Binder a -> (a, Object)
runBinder Binder g
b
    mbs :: Maybe Object
mbs = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
bs

-- | Clear all content in the NetSpider database. This is mainly for
-- testing.
clearAll :: Spider n na fla -> IO ()
clearAll :: Spider n na fla -> IO ()
clearAll Spider n na fla
spider = ResultHandle () -> IO ()
forall v. ResultHandle v -> IO ()
Gr.drainResults (ResultHandle () -> IO ()) -> IO (ResultHandle ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Spider n na fla
-> Binder (GTraversal SideEffect () ()) -> IO (ResultHandle ())
forall g r v n na fla.
(ToGreskell g, r ~ GreskellReturn g, AsIterator r,
 v ~ IteratorItem r, FromGraphSON v) =>
Spider n na fla -> Binder g -> IO (ResultHandle v)
submitB Spider n na fla
spider (GTraversal SideEffect () () -> Binder (GTraversal SideEffect () ())
forall (m :: * -> *) a. Monad m => a -> m a
return GTraversal SideEffect () ()
gClearAll)

-- | Add a 'FoundNode' (observation of a node) to the NetSpider
-- database.
addFoundNode :: (ToJSON n, LinkAttributes fla, NodeAttributes na) => Spider n na fla -> FoundNode n na fla -> IO ()
addFoundNode :: Spider n na fla -> FoundNode n na fla -> IO ()
addFoundNode Spider n na fla
spider FoundNode n na fla
found_node = do
  EID VNode
subject_vid <- Spider n na fla -> n -> IO (EID VNode)
forall n na fla. ToJSON n => Spider n na fla -> n -> IO (EID VNode)
getOrMakeNode Spider n na fla
spider (n -> IO (EID VNode)) -> n -> IO (EID VNode)
forall a b. (a -> b) -> a -> b
$ FoundNode n na fla -> n
forall n na la. FoundNode n na la -> n
subjectNode FoundNode n na fla
found_node
  [(FoundLink n fla, EID VNode)]
link_pairs <- (FoundLink n fla -> IO (FoundLink n fla, EID VNode))
-> [FoundLink n fla] -> IO [(FoundLink n fla, EID VNode)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FoundLink n fla -> IO (FoundLink n fla, EID VNode)
linkAndTargetVID ([FoundLink n fla] -> IO [(FoundLink n fla, EID VNode)])
-> [FoundLink n fla] -> IO [(FoundLink n fla, EID VNode)]
forall a b. (a -> b) -> a -> b
$ FoundNode n na fla -> [FoundLink n fla]
forall n na la. FoundNode n na la -> [FoundLink n la]
neighborLinks FoundNode n na fla
found_node
  EID VNode -> [(FoundLink n fla, EID VNode)] -> IO ()
makeFoundNodeVertex EID VNode
subject_vid [(FoundLink n fla, EID VNode)]
link_pairs
  where
    linkAndTargetVID :: FoundLink n fla -> IO (FoundLink n fla, EID VNode)
linkAndTargetVID FoundLink n fla
link = do
      EID VNode
target_vid <- Spider n na fla -> n -> IO (EID VNode)
forall n na fla. ToJSON n => Spider n na fla -> n -> IO (EID VNode)
getOrMakeNode Spider n na fla
spider (n -> IO (EID VNode)) -> n -> IO (EID VNode)
forall a b. (a -> b) -> a -> b
$ FoundLink n fla -> n
forall n la. FoundLink n la -> n
targetNode FoundLink n fla
link
      (FoundLink n fla, EID VNode) -> IO (FoundLink n fla, EID VNode)
forall (m :: * -> *) a. Monad m => a -> m a
return (FoundLink n fla
link, EID VNode
target_vid)
    makeFoundNodeVertex :: EID VNode -> [(FoundLink n fla, EID VNode)] -> IO ()
makeFoundNodeVertex EID VNode
subject_vid [(FoundLink n fla, EID VNode)]
link_pairs =
      ResultHandle () -> IO ()
forall v. ResultHandle v -> IO ()
Gr.drainResults (ResultHandle () -> IO ()) -> IO (ResultHandle ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Spider n na fla
-> Binder (GTraversal SideEffect () ()) -> IO (ResultHandle ())
forall g r v n na fla.
(ToGreskell g, r ~ GreskellReturn g, AsIterator r,
 v ~ IteratorItem r, FromGraphSON v) =>
Spider n na fla -> Binder g -> IO (ResultHandle v)
submitB Spider n na fla
spider ((GTraversal SideEffect () VFoundNode
 -> GTraversal SideEffect () ())
-> Binder (GTraversal SideEffect () VFoundNode)
-> Binder (GTraversal SideEffect () ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GTraversal SideEffect () VFoundNode -> GTraversal SideEffect () ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Binder (GTraversal SideEffect () VFoundNode)
 -> Binder (GTraversal SideEffect () ()))
-> Binder (GTraversal SideEffect () VFoundNode)
-> Binder (GTraversal SideEffect () ())
forall a b. (a -> b) -> a -> b
$ EID VNode
-> [(FoundLink n fla, EID VNode)]
-> FoundNode n na fla
-> Binder (GTraversal SideEffect () VFoundNode)
forall la na n.
(LinkAttributes la, NodeAttributes na) =>
EID VNode
-> [(FoundLink n la, EID VNode)]
-> FoundNode n na la
-> Binder (GTraversal SideEffect () VFoundNode)
gMakeFoundNode EID VNode
subject_vid [(FoundLink n fla, EID VNode)]
link_pairs FoundNode n na fla
found_node)

vToMaybe :: Vector a -> Maybe a
vToMaybe :: Vector a -> Maybe a
vToMaybe Vector a
v = Vector a
v Vector a -> Port -> Maybe a
forall a. Vector a -> Port -> Maybe a
V.!? Port
0
  
getOrMakeNode :: (ToJSON n) => Spider n na fla -> n -> IO (EID VNode)
getOrMakeNode :: Spider n na fla -> n -> IO (EID VNode)
getOrMakeNode Spider n na fla
spider n
nid = Vector (EID VNode) -> IO (EID VNode)
forall (m :: * -> *) a. MonadThrow m => Vector a -> m a
expectOne (Vector (EID VNode) -> IO (EID VNode))
-> IO (Vector (EID VNode)) -> IO (EID VNode)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ResultHandle (EID VNode) -> IO (Vector (EID VNode))
forall v. ResultHandle v -> IO (Vector v)
Gr.slurpResults (ResultHandle (EID VNode) -> IO (Vector (EID VNode)))
-> IO (ResultHandle (EID VNode)) -> IO (Vector (EID VNode))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Spider n na fla
-> Binder (GTraversal SideEffect () (EID VNode))
-> IO (ResultHandle (EID VNode))
forall g r v n na fla.
(ToGreskell g, r ~ GreskellReturn g, AsIterator r,
 v ~ IteratorItem r, FromGraphSON v) =>
Spider n na fla -> Binder g -> IO (ResultHandle v)
submitB Spider n na fla
spider Binder (GTraversal SideEffect () (EID VNode))
bound_traversal
  where
    bound_traversal :: Binder (GTraversal SideEffect () (EID VNode))
bound_traversal = do
      Walk SideEffect [VNode] VNode
wMakeNode <- Spider n na fla -> n -> Binder (Walk SideEffect [VNode] VNode)
forall n na fla a.
ToJSON n =>
Spider n na fla -> n -> Binder (Walk SideEffect a VNode)
gMakeNode Spider n na fla
spider n
nid
      Walk Transform VNode VNode
wHasNodeID <- Spider n na fla -> n -> Binder (Walk Transform VNode VNode)
forall n c na fla.
(ToJSON n, WalkType c) =>
Spider n na fla -> n -> Binder (Walk c VNode VNode)
gHasNodeID Spider n na fla
spider n
nid
      GTraversal SideEffect () (EID VNode)
-> Binder (GTraversal SideEffect () (EID VNode))
forall (m :: * -> *) a. Monad m => a -> m a
return
        (GTraversal SideEffect () (EID VNode)
 -> Binder (GTraversal SideEffect () (EID VNode)))
-> GTraversal SideEffect () (EID VNode)
-> Binder (GTraversal SideEffect () (EID VNode))
forall a b. (a -> b) -> a -> b
$ (Walk Transform VNode (EID VNode)
-> Walk SideEffect VNode (EID VNode)
forall (g :: * -> * -> * -> *) from to s e.
(ToGTraversal g, WalkType from, WalkType to, Lift from to) =>
g from s e -> g to s e
liftWalk Walk Transform VNode (EID VNode)
gNodeEID :: Walk SideEffect VNode (EID VNode))
        Walk SideEffect VNode (EID VNode)
-> GTraversal SideEffect () VNode
-> GTraversal SideEffect () (EID VNode)
forall c b d a. Walk c b d -> GTraversal c a b -> GTraversal c a d
$. Walk SideEffect [VNode] VNode -> Walk SideEffect VNode VNode
forall (g :: * -> * -> * -> *) cc c s.
(ToGTraversal g, Split cc c, Lift Transform cc, Lift Transform c,
 WalkType c, WalkType cc) =>
g cc [s] s -> Walk c s s
gWhenEmptyInput Walk SideEffect [VNode] VNode
wMakeNode
        Walk SideEffect VNode VNode
-> GTraversal SideEffect () VNode -> GTraversal SideEffect () VNode
forall c b d a. Walk c b d -> GTraversal c a b -> GTraversal c a d
$. GTraversal Transform () VNode -> GTraversal SideEffect () VNode
forall (g :: * -> * -> * -> *) from to s e.
(ToGTraversal g, WalkType from, WalkType to, Lift from to) =>
g from s e -> g to s e
liftWalk (GTraversal Transform () VNode -> GTraversal SideEffect () VNode)
-> GTraversal Transform () VNode -> GTraversal SideEffect () VNode
forall a b. (a -> b) -> a -> b
$ Walk Transform VNode VNode
wHasNodeID Walk Transform VNode VNode
-> GTraversal Transform () VNode -> GTraversal Transform () VNode
forall c b d a. Walk c b d -> GTraversal c a b -> GTraversal c a d
$. GTraversal Transform () VNode
gAllNodes
    expectOne :: Vector a -> m a
expectOne Vector a
v = case Vector a -> Maybe a
forall a. Vector a -> Maybe a
vToMaybe Vector a
v of
      Just a
e -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e
      Maybe a
Nothing -> Host -> m a
forall (m :: * -> *) a. (MonadThrow m, HasCallStack) => Host -> m a
throwString Host
"Expects at least single result, but got nothing."
      -- TODO: make decent exception spec.

-- | Simple version of 'getSnapshot'. It builds the snapshot graph by
-- traversing the history graph from the given starting node.
--
-- This function is very simple, and should be used only for small
-- graphs.
getSnapshotSimple :: (FromGraphSON n, ToJSON n, Ord n, Hashable n, Show n, LinkAttributes fla, NodeAttributes na)
                  => Spider n na fla
                  -> n -- ^ ID of the node where it starts traversing.
                  -> IO (SnapshotGraph n na fla)
getSnapshotSimple :: Spider n na fla -> n -> IO (SnapshotGraph n na fla)
getSnapshotSimple Spider n na fla
spider n
start_nid = Spider n na fla
-> Query n na fla fla -> IO (SnapshotGraph n na fla)
forall n fla na sla.
(FromGraphSON n, ToJSON n, Ord n, Hashable n, Show n,
 LinkAttributes fla, NodeAttributes na) =>
Spider n na fla
-> Query n na fla sla -> IO (SnapshotGraph n na sla)
getSnapshot Spider n na fla
spider (Query n na fla fla -> IO (SnapshotGraph n na fla))
-> Query n na fla fla -> IO (SnapshotGraph n na fla)
forall a b. (a -> b) -> a -> b
$ [n] -> Query n na fla fla
forall n na fla. (Eq n, Show n) => [n] -> Query n na fla fla
defQuery [n
start_nid]


-- | Get the snapshot graph from the history graph as specified by the
-- 'Query'.
getSnapshot :: (FromGraphSON n, ToJSON n, Ord n, Hashable n, Show n, LinkAttributes fla, NodeAttributes na)
            => Spider n na fla
            -> Query n na fla sla
            -> IO (SnapshotGraph n na sla)
getSnapshot :: Spider n na fla
-> Query n na fla sla -> IO (SnapshotGraph n na sla)
getSnapshot Spider n na fla
spider Query n na fla sla
query = do
  let fn_policy :: FoundNodePolicy n na
fn_policy = Query n na fla sla -> FoundNodePolicy n na
forall n na fla sla. Query n na fla sla -> FoundNodePolicy n na
foundNodePolicy Query n na fla sla
query
  IORef (Weaver n na fla)
ref_weaver <- Weaver n na fla -> IO (IORef (Weaver n na fla))
forall a. a -> IO (IORef a)
newIORef (Weaver n na fla -> IO (IORef (Weaver n na fla)))
-> Weaver n na fla -> IO (IORef (Weaver n na fla))
forall a b. (a -> b) -> a -> b
$ FoundNodePolicy n na -> Weaver n na fla
forall n na la. FoundNodePolicy n na -> Weaver n na la
newWeaver FoundNodePolicy n na
fn_policy
  (n -> IO ()) -> [n] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Spider n na fla
-> Interval Timestamp
-> FoundNodePolicy n na
-> IORef (Weaver n na fla)
-> n
-> IO ()
forall n fla na.
(FromGraphSON n, ToJSON n, Eq n, Hashable n, Show n,
 LinkAttributes fla, NodeAttributes na) =>
Spider n na fla
-> Interval Timestamp
-> FoundNodePolicy n na
-> IORef (Weaver n na fla)
-> n
-> IO ()
traverseFromOneNode Spider n na fla
spider (Query n na fla sla -> Interval Timestamp
forall n na fla sla. Query n na fla sla -> Interval Timestamp
timeInterval Query n na fla sla
query) FoundNodePolicy n na
fn_policy IORef (Weaver n na fla)
ref_weaver) ([n] -> IO ()) -> [n] -> IO ()
forall a b. (a -> b) -> a -> b
$ Query n na fla sla -> [n]
forall n na fla sla. Query n na fla sla -> [n]
startsFrom Query n na fla sla
query
  (SnapshotGraph n na sla
graph, [LogLine]
logs) <- (Weaver n na fla -> (SnapshotGraph n na sla, [LogLine]))
-> IO (Weaver n na fla) -> IO (SnapshotGraph n na sla, [LogLine])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LinkSampleUnifier n na fla sla
-> Weaver n na fla -> (SnapshotGraph n na sla, [LogLine])
forall n na fla sla.
(Ord n, Hashable n, Show n) =>
LinkSampleUnifier n na fla sla
-> Weaver n na fla -> (SnapshotGraph n na sla, [LogLine])
Weaver.getSnapshot' (LinkSampleUnifier n na fla sla
 -> Weaver n na fla -> (SnapshotGraph n na sla, [LogLine]))
-> LinkSampleUnifier n na fla sla
-> Weaver n na fla
-> (SnapshotGraph n na sla, [LogLine])
forall a b. (a -> b) -> a -> b
$ Query n na fla sla -> LinkSampleUnifier n na fla sla
forall n na fla sla.
Query n na fla sla -> LinkSampleUnifier n na fla sla
unifyLinkSamples Query n na fla sla
query) (IO (Weaver n na fla) -> IO (SnapshotGraph n na sla, [LogLine]))
-> IO (Weaver n na fla) -> IO (SnapshotGraph n na sla, [LogLine])
forall a b. (a -> b) -> a -> b
$ IORef (Weaver n na fla) -> IO (Weaver n na fla)
forall a. IORef a -> IO a
readIORef IORef (Weaver n na fla)
ref_weaver
  (LogLine -> IO ()) -> [LogLine] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Spider n na fla -> LogLine -> IO ()
forall n na fla. Spider n na fla -> LogLine -> IO ()
logLine Spider n na fla
spider) [LogLine]
logs
  SnapshotGraph n na sla -> IO (SnapshotGraph n na sla)
forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotGraph n na sla
graph

traverseFromOneNode :: (FromGraphSON n, ToJSON n, Eq n, Hashable n, Show n, LinkAttributes fla, NodeAttributes na)
                    => Spider n na fla
                    -> Interval Timestamp
                    -> FoundNodePolicy n na
                    -> IORef (Weaver n na fla)
                    -> n -- ^ starting node
                    -> IO ()
traverseFromOneNode :: Spider n na fla
-> Interval Timestamp
-> FoundNodePolicy n na
-> IORef (Weaver n na fla)
-> n
-> IO ()
traverseFromOneNode Spider n na fla
spider Interval Timestamp
time_interval FoundNodePolicy n na
fn_policy IORef (Weaver n na fla)
ref_weaver n
start_nid = do
  Weaver n na fla
init_weaver <- IORef (Weaver n na fla) -> IO (Weaver n na fla)
forall a. IORef a -> IO a
readIORef IORef (Weaver n na fla)
ref_weaver
  Spider n na fla -> Text -> IO ()
forall n na fla. Spider n na fla -> Text -> IO ()
logDebug Spider n na fla
spider (Text
"Start traverse from: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> n -> Text
forall a. Show a => a -> Text
spack n
start_nid)
  IO (Maybe (Either n (FoundNode n na fla)))
get_next <- Spider n na fla
-> Interval Timestamp
-> FoundNodePolicy n na
-> n
-> IO (IO (Maybe (Either n (FoundNode n na fla))))
forall n na fla.
(ToJSON n, NodeAttributes na, LinkAttributes fla,
 FromGraphSON n) =>
Spider n na fla
-> Interval Timestamp
-> FoundNodePolicy n na
-> n
-> IO (IO (Maybe (Either n (FoundNode n na fla))))
traverseFoundNodes Spider n na fla
spider Interval Timestamp
time_interval FoundNodePolicy n na
fn_policy n
start_nid
  Weaver n na fla
-> IO (Maybe (Either n (FoundNode n na fla))) -> IO ()
doTraverseWith Weaver n na fla
init_weaver IO (Maybe (Either n (FoundNode n na fla)))
get_next
  where
    logTraverseItem :: Either n (FoundNode n na fla) -> IO ()
logTraverseItem Either n (FoundNode n na fla)
eitem = Spider n na fla -> Text -> IO ()
forall n na fla. Spider n na fla -> Text -> IO ()
logDebug Spider n na fla
spider (Text
"Visit: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Either n (FoundNode n na fla) -> Text
forall a a na la.
(Show a, Show a) =>
Either a (FoundNode a na la) -> Text
showTraverseItem Either n (FoundNode n na fla)
eitem)
    showTraverseItem :: Either a (FoundNode a na la) -> Text
showTraverseItem (Left a
nid) = Text
"Node(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
spack a
nid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    showTraverseItem (Right FoundNode a na la
fn) =
      Text
"FoundNode("
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ts:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Timestamp -> Text
showTimestamp (Timestamp -> Text) -> Timestamp -> Text
forall a b. (a -> b) -> a -> b
$ FoundNode a na la -> Timestamp
forall n na la. FoundNode n na la -> Timestamp
foundAt FoundNode a na la
fn)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", sub:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (a -> Text
forall a. Show a => a -> Text
spack (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ FoundNode a na la -> a
forall n na la. FoundNode n na la -> n
subjectNode FoundNode a na la
fn)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", tgt:[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FoundLink a la -> Text) -> [FoundLink a la] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FoundLink a la -> Text
forall a la. Show a => FoundLink a la -> Text
showLink ([FoundLink a la] -> [Text]) -> [FoundLink a la] -> [Text]
forall a b. (a -> b) -> a -> b
$ FoundNode a na la -> [FoundLink a la]
forall n na la. FoundNode n na la -> [FoundLink n la]
neighborLinks FoundNode a na la
fn)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"])"
    showLink :: FoundLink a la -> Text
showLink FoundLink a la
l = a -> Text
forall a. Show a => a -> Text
spack (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ FoundLink a la -> a
forall n la. FoundLink n la -> n
targetNode FoundLink a la
l
    doTraverseWith :: Weaver n na fla
-> IO (Maybe (Either n (FoundNode n na fla))) -> IO ()
doTraverseWith Weaver n na fla
init_weaver IO (Maybe (Either n (FoundNode n na fla)))
getNext = IO ()
go
      where
        go :: IO ()
go = do
          Maybe (Either n (FoundNode n na fla))
mvisited_node <- IO (Maybe (Either n (FoundNode n na fla)))
getNext
          case Maybe (Either n (FoundNode n na fla))
mvisited_node of
            Maybe (Either n (FoundNode n na fla))
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just Either n (FoundNode n na fla)
eitem -> do
              Either n (FoundNode n na fla) -> IO ()
logTraverseItem Either n (FoundNode n na fla)
eitem
              case Either n (FoundNode n na fla)
eitem of
                Left n
sub_nid -> n -> Maybe (FoundNode n na fla) -> IO ()
tryAdd n
sub_nid Maybe (FoundNode n na fla)
forall a. Maybe a
Nothing
                Right FoundNode n na fla
fnode -> n -> Maybe (FoundNode n na fla) -> IO ()
tryAdd (FoundNode n na fla -> n
forall n na la. FoundNode n na la -> n
subjectNode FoundNode n na fla
fnode) (FoundNode n na fla -> Maybe (FoundNode n na fla)
forall a. a -> Maybe a
Just FoundNode n na fla
fnode)
              IO ()
go
        tryAdd :: n -> Maybe (FoundNode n na fla) -> IO ()
tryAdd n
sub_nid Maybe (FoundNode n na fla)
mfnode = do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ n -> Weaver n na fla -> Bool
forall n na la. (Eq n, Hashable n) => n -> Weaver n na la -> Bool
Weaver.isVisited n
sub_nid Weaver n na fla
init_weaver) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            IORef (Weaver n na fla)
-> (Weaver n na fla -> Weaver n na fla) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Weaver n na fla)
ref_weaver ((Weaver n na fla -> Weaver n na fla) -> IO ())
-> (Weaver n na fla -> Weaver n na fla) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Weaver n na fla
w ->
              case Maybe (FoundNode n na fla)
mfnode of
                Maybe (FoundNode n na fla)
Nothing -> n -> Weaver n na fla -> Weaver n na fla
forall n na la.
(Eq n, Hashable n) =>
n -> Weaver n na la -> Weaver n na la
Weaver.markAsVisited n
sub_nid Weaver n na fla
w
                Just FoundNode n na fla
fnode -> FoundNode n na fla -> Weaver n na fla -> Weaver n na fla
forall n na la.
(Eq n, Hashable n) =>
FoundNode n na la -> Weaver n na la -> Weaver n na la
Weaver.addFoundNode FoundNode n na fla
fnode Weaver n na fla
w

-- | Recursively traverse the history graph based on the query to get
-- the FoundNodes.
--
-- It returns an action that emits the visited Node IDs and
-- 'FoundNode's the node has. Those items are emitted as a single
-- stream, in a mixed and unordered fashion. If it reaches to the end
-- of the stream, the action returns 'Nothing'.
traverseFoundNodes :: (ToJSON n, NodeAttributes na, LinkAttributes fla, FromGraphSON n)
                   => Spider n na fla
                   -> Interval Timestamp -- ^ query time interval.
                   -> FoundNodePolicy n na -- ^ query found node policy
                   -> n -- ^ the starting node
                   -> IO (IO (Maybe (Either n (FoundNode n na fla))))
traverseFoundNodes :: Spider n na fla
-> Interval Timestamp
-> FoundNodePolicy n na
-> n
-> IO (IO (Maybe (Either n (FoundNode n na fla))))
traverseFoundNodes Spider n na fla
spider Interval Timestamp
time_interval FoundNodePolicy n na
fn_policy n
start_nid = do
  ResultHandle (PMap Single GValue)
rhandle <- Client
-> GTraversal Transform () (PMap Single GValue)
-> Maybe Object
-> IO (ResultHandle (PMap Single GValue))
forall g r v.
(ToGreskell g, r ~ GreskellReturn g, AsIterator r,
 v ~ IteratorItem r, FromGraphSON v) =>
Client -> g -> Maybe Object -> IO (ResultHandle v)
Gr.submit (Spider n na fla -> Client
forall n na fla. Spider n na fla -> Client
spiderClient Spider n na fla
spider) GTraversal Transform () (PMap Single GValue)
gr_query (Object -> Maybe Object
forall a. a -> Maybe a
Just Object
gr_binding)
  IO (Maybe (Either n (FoundNode n na fla)))
-> IO (IO (Maybe (Either n (FoundNode n na fla))))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (Maybe (Either n (FoundNode n na fla)))
 -> IO (IO (Maybe (Either n (FoundNode n na fla)))))
-> IO (Maybe (Either n (FoundNode n na fla)))
-> IO (IO (Maybe (Either n (FoundNode n na fla))))
forall a b. (a -> b) -> a -> b
$ do
    Maybe (PMap Single GValue)
msmap <- ResultHandle (PMap Single GValue)
-> IO (Maybe (PMap Single GValue))
forall v. ResultHandle v -> IO (Maybe v)
Gr.nextResult ResultHandle (PMap Single GValue)
rhandle
    IO (Maybe (Either n (FoundNode n na fla)))
-> (PMap Single GValue
    -> IO (Maybe (Either n (FoundNode n na fla))))
-> Maybe (PMap Single GValue)
-> IO (Maybe (Either n (FoundNode n na fla)))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Either n (FoundNode n na fla))
-> IO (Maybe (Either n (FoundNode n na fla)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either n (FoundNode n na fla))
forall a. Maybe a
Nothing) ((Either n (FoundNode n na fla)
 -> Maybe (Either n (FoundNode n na fla)))
-> IO (Either n (FoundNode n na fla))
-> IO (Maybe (Either n (FoundNode n na fla)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either n (FoundNode n na fla)
-> Maybe (Either n (FoundNode n na fla))
forall a. a -> Maybe a
Just (IO (Either n (FoundNode n na fla))
 -> IO (Maybe (Either n (FoundNode n na fla))))
-> (PMap Single GValue -> IO (Either n (FoundNode n na fla)))
-> PMap Single GValue
-> IO (Maybe (Either n (FoundNode n na fla)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PMap Single GValue -> IO (Either n (FoundNode n na fla))
extractSMap) Maybe (PMap Single GValue)
msmap
  where
    sourceVNode :: Binder (GTraversal Transform () VNode)
sourceVNode = Spider n na fla -> n -> Binder (Walk Transform VNode VNode)
forall n c na fla.
(ToJSON n, WalkType c) =>
Spider n na fla -> n -> Binder (Walk c VNode VNode)
gHasNodeID Spider n na fla
spider n
start_nid Binder (Walk Transform VNode VNode)
-> Binder (GTraversal Transform () VNode)
-> Binder (GTraversal Transform () VNode)
forall (f :: * -> *) c b d a.
Applicative f =>
f (Walk c b d) -> f (GTraversal c a b) -> f (GTraversal c a d)
<*.> GTraversal Transform () VNode
-> Binder (GTraversal Transform () VNode)
forall (f :: * -> *) a. Applicative f => a -> f a
pure GTraversal Transform () VNode
gAllNodes
    walkLatestFoundNodeIfOverwrite :: Walk Transform VFoundNode VFoundNode
walkLatestFoundNodeIfOverwrite =
      case FoundNodePolicy n na
fn_policy of
        FoundNodePolicy n na
PolicyOverwrite -> Walk Transform VFoundNode VFoundNode
gLatestFoundNode
        FoundNodePolicy n na
PolicyAppend -> Walk Transform VFoundNode VFoundNode
forall c s. WalkType c => Walk c s s
gIdentity
    walkSelectFoundNode :: Binder (Walk Transform VNode VFoundNode)
walkSelectFoundNode = Walk Transform VFoundNode VFoundNode
-> Walk Transform VNode VFoundNode
-> Walk Transform VNode VFoundNode
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(<<<) Walk Transform VFoundNode VFoundNode
walkLatestFoundNodeIfOverwrite
                          (Walk Transform VNode VFoundNode
 -> Walk Transform VNode VFoundNode)
-> Binder (Walk Transform VNode VFoundNode)
-> Binder (Walk Transform VNode VFoundNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Walk Filter VFoundNode VFoundNode
 -> Walk Transform VNode VFoundNode)
-> Binder (Walk Filter VFoundNode VFoundNode)
-> Binder (Walk Transform VNode VFoundNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Walk Filter VFoundNode VFoundNode
-> Walk Transform VNode VFoundNode
gSelectFoundNode (Interval Timestamp -> Binder (Walk Filter VFoundNode VFoundNode)
gFilterFoundNodeByTime Interval Timestamp
time_interval)
    repeat_until :: Maybe a
repeat_until = Maybe a
forall a. Maybe a
Nothing -- TODO: specify the maximum number of traversals.
    ((GTraversal Transform () (PMap Single GValue)
gr_query, AsLabel Text
label_smap_type, AsLabel n
label_subject, AsLabel (VFoundNodeData na)
label_vfnd, AsLabel [PMap Single GValue]
label_efs, AsLabel (EFindsData fla)
label_efd, AsLabel n
label_target), Object
gr_binding) = Binder
  (GTraversal Transform () (PMap Single GValue), AsLabel Text,
   AsLabel n, AsLabel (VFoundNodeData na),
   AsLabel [PMap Single GValue], AsLabel (EFindsData fla), AsLabel n)
-> ((GTraversal Transform () (PMap Single GValue), AsLabel Text,
     AsLabel n, AsLabel (VFoundNodeData na),
     AsLabel [PMap Single GValue], AsLabel (EFindsData fla), AsLabel n),
    Object)
forall a. Binder a -> (a, Object)
runBinder (Binder
   (GTraversal Transform () (PMap Single GValue), AsLabel Text,
    AsLabel n, AsLabel (VFoundNodeData na),
    AsLabel [PMap Single GValue], AsLabel (EFindsData fla), AsLabel n)
 -> ((GTraversal Transform () (PMap Single GValue), AsLabel Text,
      AsLabel n, AsLabel (VFoundNodeData na),
      AsLabel [PMap Single GValue], AsLabel (EFindsData fla), AsLabel n),
     Object))
-> Binder
     (GTraversal Transform () (PMap Single GValue), AsLabel Text,
      AsLabel n, AsLabel (VFoundNodeData na),
      AsLabel [PMap Single GValue], AsLabel (EFindsData fla), AsLabel n)
-> ((GTraversal Transform () (PMap Single GValue), AsLabel Text,
     AsLabel n, AsLabel (VFoundNodeData na),
     AsLabel [PMap Single GValue], AsLabel (EFindsData fla), AsLabel n),
    Object)
forall a b. (a -> b) -> a -> b
$ do
      Walk Transform VNode VFoundNode
walk_select_fnode <- Binder (Walk Transform VNode VFoundNode)
walkSelectFoundNode
      AsLabel Text
lsmap_type <- Binder (AsLabel Text)
forall a. Binder (AsLabel a)
newAsLabel
      AsLabel n
lsubject <- Binder (AsLabel n)
forall a. Binder (AsLabel a)
newAsLabel
      AsLabel (EFindsData fla)
lefd <- Binder (AsLabel (EFindsData fla))
forall a. Binder (AsLabel a)
newAsLabel
      AsLabel n
ltarget <- Binder (AsLabel n)
forall a. Binder (AsLabel a)
newAsLabel
      AsLabel (VFoundNodeData na)
lvfnd <- Binder (AsLabel (VFoundNodeData na))
forall a. Binder (AsLabel a)
newAsLabel
      AsLabel [PMap Single GValue]
lefs <- Binder (AsLabel [PMap Single GValue])
forall a. Binder (AsLabel a)
newAsLabel
      let walk_select_mixed :: Walk Transform VNode (Either VNode VFoundNode)
walk_select_mixed = Walk Transform VNode (Either VNode VFoundNode)
-> Walk Transform VNode (Either VNode VFoundNode)
forall (g :: * -> * -> * -> *) c s e.
(ToGTraversal g, WalkType c) =>
g c s e -> Walk c s e
gLocal (Walk Transform VNode (Either VNode VFoundNode)
 -> Walk Transform VNode (Either VNode VFoundNode))
-> Walk Transform VNode (Either VNode VFoundNode)
-> Walk Transform VNode (Either VNode VFoundNode)
forall a b. (a -> b) -> a -> b
$ Walk Transform VNode VFoundNode
-> Walk Transform VNode (Either VNode VFoundNode)
gNodeMix Walk Transform VNode VFoundNode
walk_select_fnode -- gLocal is necessary because we may have .limit() step inside.
          walk_finds_and_target :: Walk Transform VFoundNode (PMap Single GValue)
walk_finds_and_target =
            LabeledByProjection EFinds
-> [LabeledByProjection EFinds]
-> Walk Transform EFinds (PMap Single GValue)
forall s.
LabeledByProjection s
-> [LabeledByProjection s] -> Walk Transform s (PMap Single GValue)
gProject
            ( AsLabel
  (ProjectionLikeEnd (Walk Transform EFinds (EFindsData fla)))
-> Walk Transform EFinds (EFindsData fla)
-> LabeledByProjection
     (ProjectionLikeStart (Walk Transform EFinds (EFindsData fla)))
forall p.
(ProjectionLike p, ToGreskell p) =>
AsLabel (ProjectionLikeEnd p)
-> p -> LabeledByProjection (ProjectionLikeStart p)
gByL AsLabel
  (ProjectionLikeEnd (Walk Transform EFinds (EFindsData fla)))
AsLabel (EFindsData fla)
lefd Walk Transform EFinds (EFindsData fla)
forall la. Walk Transform EFinds (EFindsData la)
gEFindsData )
            [ AsLabel (ProjectionLikeEnd (Walk Transform EFinds n))
-> Walk Transform EFinds n
-> LabeledByProjection
     (ProjectionLikeStart (Walk Transform EFinds n))
forall p.
(ProjectionLike p, ToGreskell p) =>
AsLabel (ProjectionLikeEnd p)
-> p -> LabeledByProjection (ProjectionLikeStart p)
gByL AsLabel n
AsLabel (ProjectionLikeEnd (Walk Transform EFinds n))
ltarget (Spider n na fla -> Walk Transform VNode n
forall n na fla. Spider n na fla -> Walk Transform VNode n
gNodeID Spider n na fla
spider Walk Transform VNode n
-> Walk Transform EFinds VNode -> Walk Transform EFinds n
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Walk Transform EFinds VNode
gFindsTarget)
            ]
            Walk Transform EFinds (PMap Single GValue)
-> Walk Transform VFoundNode EFinds
-> Walk Transform VFoundNode (PMap Single GValue)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Walk Transform VFoundNode EFinds
gFinds
          walk_construct_result :: Walk Transform (Either VNode VFoundNode) (PMap Single GValue)
walk_construct_result = Walk Transform VNode (PMap Single GValue)
-> Walk Transform VFoundNode (PMap Single GValue)
-> Walk Transform (Either VNode VFoundNode) (PMap Single GValue)
forall a.
Walk Transform VNode a
-> Walk Transform VFoundNode a
-> Walk Transform (Either VNode VFoundNode) a
gEitherNodeMix Walk Transform VNode (PMap Single GValue)
walk_construct_vnode Walk Transform VFoundNode (PMap Single GValue)
walk_construct_vfnode
          walk_construct_vnode :: Walk Transform VNode (PMap Single GValue)
walk_construct_vnode =
            LabeledByProjection VNode
-> [LabeledByProjection VNode]
-> Walk Transform VNode (PMap Single GValue)
forall s.
LabeledByProjection s
-> [LabeledByProjection s] -> Walk Transform s (PMap Single GValue)
gProject
            ( AsLabel (ProjectionLikeEnd (Walk Transform VNode Text))
-> Walk Transform VNode Text
-> LabeledByProjection
     (ProjectionLikeStart (Walk Transform VNode Text))
forall p.
(ProjectionLike p, ToGreskell p) =>
AsLabel (ProjectionLikeEnd p)
-> p -> LabeledByProjection (ProjectionLikeStart p)
gByL AsLabel Text
AsLabel (ProjectionLikeEnd (Walk Transform VNode Text))
lsmap_type (Greskell Text -> Walk Transform VNode Text
forall a s. Greskell a -> Walk Transform s a
gConstant (Greskell Text
"vn" :: Greskell Text)) )
            [ AsLabel (ProjectionLikeEnd (Walk Transform VNode n))
-> Walk Transform VNode n
-> LabeledByProjection
     (ProjectionLikeStart (Walk Transform VNode n))
forall p.
(ProjectionLike p, ToGreskell p) =>
AsLabel (ProjectionLikeEnd p)
-> p -> LabeledByProjection (ProjectionLikeStart p)
gByL AsLabel n
AsLabel (ProjectionLikeEnd (Walk Transform VNode n))
lsubject (Spider n na fla -> Walk Transform VNode n
forall n na fla. Spider n na fla -> Walk Transform VNode n
gNodeID Spider n na fla
spider)
            ]
          walk_construct_vfnode :: Walk Transform VFoundNode (PMap Single GValue)
walk_construct_vfnode =
            LabeledByProjection VFoundNode
-> [LabeledByProjection VFoundNode]
-> Walk Transform VFoundNode (PMap Single GValue)
forall s.
LabeledByProjection s
-> [LabeledByProjection s] -> Walk Transform s (PMap Single GValue)
gProject
            ( AsLabel (ProjectionLikeEnd (Walk Transform VFoundNode Text))
-> Walk Transform VFoundNode Text
-> LabeledByProjection
     (ProjectionLikeStart (Walk Transform VFoundNode Text))
forall p.
(ProjectionLike p, ToGreskell p) =>
AsLabel (ProjectionLikeEnd p)
-> p -> LabeledByProjection (ProjectionLikeStart p)
gByL AsLabel Text
AsLabel (ProjectionLikeEnd (Walk Transform VFoundNode Text))
lsmap_type (Greskell Text -> Walk Transform VFoundNode Text
forall a s. Greskell a -> Walk Transform s a
gConstant (Greskell Text
"vfn" :: Greskell Text)) )
            [ AsLabel (ProjectionLikeEnd (Walk Transform VFoundNode n))
-> Walk Transform VFoundNode n
-> LabeledByProjection
     (ProjectionLikeStart (Walk Transform VFoundNode n))
forall p.
(ProjectionLike p, ToGreskell p) =>
AsLabel (ProjectionLikeEnd p)
-> p -> LabeledByProjection (ProjectionLikeStart p)
gByL AsLabel n
AsLabel (ProjectionLikeEnd (Walk Transform VFoundNode n))
lsubject (Spider n na fla -> Walk Transform VFoundNode n
forall n na fla. Spider n na fla -> Walk Transform VFoundNode n
gSubjectNodeID Spider n na fla
spider),
              AsLabel
  (ProjectionLikeEnd (Walk Transform VFoundNode (VFoundNodeData na)))
-> Walk Transform VFoundNode (VFoundNodeData na)
-> LabeledByProjection
     (ProjectionLikeStart
        (Walk Transform VFoundNode (VFoundNodeData na)))
forall p.
(ProjectionLike p, ToGreskell p) =>
AsLabel (ProjectionLikeEnd p)
-> p -> LabeledByProjection (ProjectionLikeStart p)
gByL AsLabel
  (ProjectionLikeEnd (Walk Transform VFoundNode (VFoundNodeData na)))
AsLabel (VFoundNodeData na)
lvfnd Walk Transform VFoundNode (VFoundNodeData na)
forall na. Walk Transform VFoundNode (VFoundNodeData na)
gVFoundNodeData,
              AsLabel
  (ProjectionLikeEnd
     (Walk Transform VFoundNode [PMap Single GValue]))
-> Walk Transform VFoundNode [PMap Single GValue]
-> LabeledByProjection
     (ProjectionLikeStart
        (Walk Transform VFoundNode [PMap Single GValue]))
forall p.
(ProjectionLike p, ToGreskell p) =>
AsLabel (ProjectionLikeEnd p)
-> p -> LabeledByProjection (ProjectionLikeStart p)
gByL AsLabel [PMap Single GValue]
AsLabel
  (ProjectionLikeEnd
     (Walk Transform VFoundNode [PMap Single GValue]))
lefs (Walk Transform (PMap Single GValue) [PMap Single GValue]
forall a. Walk Transform a [a]
gFold Walk Transform (PMap Single GValue) [PMap Single GValue]
-> Walk Transform VFoundNode (PMap Single GValue)
-> Walk Transform VFoundNode [PMap Single GValue]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Walk Transform VFoundNode (PMap Single GValue)
walk_finds_and_target)
            ]
      GTraversal Transform () (PMap Single GValue)
gt <- Walk Transform (Either VNode VFoundNode) (PMap Single GValue)
walk_construct_result
            Walk Transform (Either VNode VFoundNode) (PMap Single GValue)
-> Binder (GTraversal Transform () (Either VNode VFoundNode))
-> Binder (GTraversal Transform () (PMap Single GValue))
forall (f :: * -> *) c b d a.
Functor f =>
Walk c b d -> f (GTraversal c a b) -> f (GTraversal c a d)
<$.> Walk Transform (Either VNode VFoundNode) (Either VNode VFoundNode)
gDedupNodes
            Walk Transform (Either VNode VFoundNode) (Either VNode VFoundNode)
-> Binder (GTraversal Transform () (Either VNode VFoundNode))
-> Binder (GTraversal Transform () (Either VNode VFoundNode))
forall (f :: * -> *) c b d a.
Functor f =>
Walk c b d -> f (GTraversal c a b) -> f (GTraversal c a d)
<$.> Maybe RepeatLabel
-> Maybe
     (RepeatPos, RepeatUntil Transform (Either VNode VFoundNode))
-> Maybe
     (RepeatPos, RepeatEmit Transform (Either VNode VFoundNode))
-> Walk
     Transform (Either VNode VFoundNode) (Either VNode VFoundNode)
-> Walk
     Transform (Either VNode VFoundNode) (Either VNode VFoundNode)
forall (g :: * -> * -> * -> *) c s.
(ToGTraversal g, WalkType c) =>
Maybe RepeatLabel
-> Maybe (RepeatPos, RepeatUntil c s)
-> Maybe (RepeatPos, RepeatEmit c s)
-> g c s s
-> Walk c s s
gRepeat Maybe RepeatLabel
forall a. Maybe a
Nothing Maybe (RepeatPos, RepeatUntil Transform (Either VNode VFoundNode))
forall a. Maybe a
repeat_until Maybe (RepeatPos, RepeatEmit Transform (Either VNode VFoundNode))
forall c s. Maybe (RepeatPos, RepeatEmit c s)
gEmitHead
                 (Walk Transform VNode (Either VNode VFoundNode)
walk_select_mixed Walk Transform VNode (Either VNode VFoundNode)
-> Walk Transform (Either VNode VFoundNode) VNode
-> Walk
     Transform (Either VNode VFoundNode) (Either VNode VFoundNode)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Walk Transform VNode VNode
forall c s. WalkType c => Walk c s s
gSimplePath Walk Transform VNode VNode
-> Walk Transform (Either VNode VFoundNode) VNode
-> Walk Transform (Either VNode VFoundNode) VNode
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Walk Transform VFoundNode VNode
gTraverseViaFinds Walk Transform VFoundNode VNode
-> Walk Transform (Either VNode VFoundNode) VFoundNode
-> Walk Transform (Either VNode VFoundNode) VNode
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Walk Transform (Either VNode VFoundNode) VFoundNode
gFoundNodeOnly)
            Walk Transform (Either VNode VFoundNode) (Either VNode VFoundNode)
-> Binder (GTraversal Transform () (Either VNode VFoundNode))
-> Binder (GTraversal Transform () (Either VNode VFoundNode))
forall (f :: * -> *) c b d a.
Functor f =>
Walk c b d -> f (GTraversal c a b) -> f (GTraversal c a d)
<$.> Walk Transform VNode (Either VNode VFoundNode)
walk_select_mixed
            Walk Transform VNode (Either VNode VFoundNode)
-> Binder (GTraversal Transform () VNode)
-> Binder (GTraversal Transform () (Either VNode VFoundNode))
forall (f :: * -> *) c b d a.
Functor f =>
Walk c b d -> f (GTraversal c a b) -> f (GTraversal c a d)
<$.> Binder (GTraversal Transform () VNode)
sourceVNode
      (GTraversal Transform () (PMap Single GValue), AsLabel Text,
 AsLabel n, AsLabel (VFoundNodeData na),
 AsLabel [PMap Single GValue], AsLabel (EFindsData fla), AsLabel n)
-> Binder
     (GTraversal Transform () (PMap Single GValue), AsLabel Text,
      AsLabel n, AsLabel (VFoundNodeData na),
      AsLabel [PMap Single GValue], AsLabel (EFindsData fla), AsLabel n)
forall (m :: * -> *) a. Monad m => a -> m a
return (GTraversal Transform () (PMap Single GValue)
gt, AsLabel Text
lsmap_type, AsLabel n
lsubject, AsLabel (VFoundNodeData na)
lvfnd, AsLabel [PMap Single GValue]
lefs, AsLabel (EFindsData fla)
lefd, AsLabel n
ltarget)
    extractSMap :: PMap Single GValue -> IO (Either n (FoundNode n na fla))
extractSMap PMap Single GValue
smap = do
      Text
got_type <- AsLabel Text -> PMap Single GValue -> IO Text
forall k (c :: * -> *) a (m :: * -> *).
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a,
 MonadThrow m) =>
k -> PMap c GValue -> m a
lookupAsM AsLabel Text
label_smap_type PMap Single GValue
smap
      case Text
got_type of
        Text
"vn" -> (n -> Either n (FoundNode n na fla))
-> IO n -> IO (Either n (FoundNode n na fla))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> Either n (FoundNode n na fla)
forall a b. a -> Either a b
Left (IO n -> IO (Either n (FoundNode n na fla)))
-> IO n -> IO (Either n (FoundNode n na fla))
forall a b. (a -> b) -> a -> b
$ PMap Single GValue -> IO n
extractSubjectNodeID PMap Single GValue
smap
        Text
"vfn" -> (FoundNode n na fla -> Either n (FoundNode n na fla))
-> IO (FoundNode n na fla) -> IO (Either n (FoundNode n na fla))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FoundNode n na fla -> Either n (FoundNode n na fla)
forall a b. b -> Either a b
Right (IO (FoundNode n na fla) -> IO (Either n (FoundNode n na fla)))
-> IO (FoundNode n na fla) -> IO (Either n (FoundNode n na fla))
forall a b. (a -> b) -> a -> b
$ PMap Single GValue -> IO (FoundNode n na fla)
extractFoundNode PMap Single GValue
smap
        Text
_ -> Host -> IO (Either n (FoundNode n na fla))
forall (m :: * -> *) a. (MonadThrow m, HasCallStack) => Host -> m a
throwString (Host
"Unknow type of traversal result: " Host -> Host -> Host
forall a. [a] -> [a] -> [a]
++ Text -> Host
forall a. Show a => a -> Host
show Text
got_type)
        -- TODO: make decent exception type
    extractSubjectNodeID :: PMap Single GValue -> IO n
extractSubjectNodeID PMap Single GValue
smap = AsLabel n -> PMap Single GValue -> IO n
forall k (c :: * -> *) a (m :: * -> *).
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a,
 MonadThrow m) =>
k -> PMap c GValue -> m a
lookupAsM AsLabel n
label_subject PMap Single GValue
smap
    extractFoundNode :: PMap Single GValue -> IO (FoundNode n na fla)
extractFoundNode PMap Single GValue
smap = do
      n
sub_nid <- AsLabel n -> PMap Single GValue -> IO n
forall k (c :: * -> *) a (m :: * -> *).
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a,
 MonadThrow m) =>
k -> PMap c GValue -> m a
lookupAsM AsLabel n
label_subject PMap Single GValue
smap
      VFoundNodeData na
vfnd <- AsLabel (VFoundNodeData na)
-> PMap Single GValue -> IO (VFoundNodeData na)
forall k (c :: * -> *) a (m :: * -> *).
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a,
 MonadThrow m) =>
k -> PMap c GValue -> m a
lookupAsM AsLabel (VFoundNodeData na)
label_vfnd PMap Single GValue
smap
      [PMap Single GValue]
efs <- AsLabel [PMap Single GValue]
-> PMap Single GValue -> IO [PMap Single GValue]
forall k (c :: * -> *) a (m :: * -> *).
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a,
 MonadThrow m) =>
k -> PMap c GValue -> m a
lookupAsM AsLabel [PMap Single GValue]
label_efs PMap Single GValue
smap
      [(EFindsData fla, n)]
parsed_efs <- (PMap Single GValue -> IO (EFindsData fla, n))
-> [PMap Single GValue] -> IO [(EFindsData fla, n)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PMap Single GValue -> IO (EFindsData fla, n)
extractHopFromSMap [PMap Single GValue]
efs
      FoundNode n na fla -> IO (FoundNode n na fla)
forall (m :: * -> *) a. Monad m => a -> m a
return (FoundNode n na fla -> IO (FoundNode n na fla))
-> FoundNode n na fla -> IO (FoundNode n na fla)
forall a b. (a -> b) -> a -> b
$ n
-> (VFoundNodeData na, [(EFindsData fla, n)]) -> FoundNode n na fla
forall n na fla.
n
-> (VFoundNodeData na, [(EFindsData fla, n)]) -> FoundNode n na fla
makeFoundNodeFromHops n
sub_nid (VFoundNodeData na
vfnd, [(EFindsData fla, n)]
parsed_efs)
    extractHopFromSMap :: PMap Single GValue -> IO (EFindsData fla, n)
extractHopFromSMap PMap Single GValue
smap =
      (,)
      (EFindsData fla -> n -> (EFindsData fla, n))
-> IO (EFindsData fla) -> IO (n -> (EFindsData fla, n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsLabel (EFindsData fla)
-> PMap Single GValue -> IO (EFindsData fla)
forall k (c :: * -> *) a (m :: * -> *).
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a,
 MonadThrow m) =>
k -> PMap c GValue -> m a
lookupAsM AsLabel (EFindsData fla)
label_efd PMap Single GValue
smap
      IO (n -> (EFindsData fla, n)) -> IO n -> IO (EFindsData fla, n)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AsLabel n -> PMap Single GValue -> IO n
forall k (c :: * -> *) a (m :: * -> *).
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a,
 MonadThrow m) =>
k -> PMap c GValue -> m a
lookupAsM AsLabel n
label_target PMap Single GValue
smap

makeFoundNodeFromHops :: n -- ^ Subject node ID
                       -> (VFoundNodeData na, [(EFindsData fla, n)]) -- ^ (FoundNode data, hops)
                       -> FoundNode n na fla
makeFoundNodeFromHops :: n
-> (VFoundNodeData na, [(EFindsData fla, n)]) -> FoundNode n na fla
makeFoundNodeFromHops n
subject_nid (VFoundNodeData na
vfnd, [(EFindsData fla, n)]
efs) =
  n -> VFoundNodeData na -> [FoundLink n fla] -> FoundNode n na fla
forall n na la.
n -> VFoundNodeData na -> [FoundLink n la] -> FoundNode n na la
makeFoundNode n
subject_nid VFoundNodeData na
vfnd ([FoundLink n fla] -> FoundNode n na fla)
-> [FoundLink n fla] -> FoundNode n na fla
forall a b. (a -> b) -> a -> b
$ ((EFindsData fla, n) -> FoundLink n fla)
-> [(EFindsData fla, n)] -> [FoundLink n fla]
forall a b. (a -> b) -> [a] -> [b]
map (EFindsData fla, n) -> FoundLink n fla
forall la n. (EFindsData la, n) -> FoundLink n la
toFoundLink [(EFindsData fla, n)]
efs
  where
    toFoundLink :: (EFindsData la, n) -> FoundLink n la
toFoundLink (EFindsData la
ef, n
target_nid) = n -> EFindsData la -> FoundLink n la
forall n la. n -> EFindsData la -> FoundLink n la
makeFoundLink n
target_nid EFindsData la
ef


-- debugShowState :: Show n => SnapshotState n na fla -> String
-- debugShowState state = unvisited ++ visited_nodes ++ visited_links
--   where
--     unvisited = "unvisitedNodes: "
--                 ++ (intercalate ", " $ map show $ toList $ ssUnvisitedNodes state)
--                 ++ "\n"
--     visited_nodes = "visitedNodes: "
--                     ++ (intercalate ", " $ map (uncurry showVisitedNode) $ HM.toList $ ssVisitedNodes state)
--                     ++ "\n"
--     showVisitedNode nid mvfn = show nid ++ "(" ++ (show $ fmap vfnTimestamp mvfn )  ++  ")"
--     visited_links = "visitedLinks: "
--                     ++ (intercalate ", " $ map show $ HM.keys $ ssVisitedLinks state)