{-# LANGUAGE OverloadedStrings, TypeFamilies #-}
module NetSpider.Spider
(
Spider,
connectWS,
connectWith,
close,
withSpider,
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
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
}
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 :: 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
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
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)
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."
getSnapshotSimple :: (FromGraphSON n, ToJSON n, Ord n, Hashable n, Show n, LinkAttributes fla, NodeAttributes na)
=> Spider n na fla
-> n
-> 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]
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
-> 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
traverseFoundNodes :: (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
-> 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
((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
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)
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
-> (VFoundNodeData na, [(EFindsData fla, n)])
-> 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