{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
module NetSpider.Weaver
(
Weaver,
newWeaver,
addFoundNode,
markAsVisited,
getSnapshot,
getSnapshot',
isVisited,
getFoundNodes,
getBoundaryNodes,
visitAllBoundaryNodes
) where
import Data.Foldable (foldl')
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import Data.List (sort, reverse, sortOn)
import Data.Maybe (listToMaybe, mapMaybe)
import GHC.Exts (groupWith)
import NetSpider.Found (FoundNode(..), LinkState(..), FoundLink(targetNode))
import NetSpider.Log
( runWriterLoggingM, WriterLoggingM, logDebugW, LogLine, spack
)
import NetSpider.Log ()
import NetSpider.Query.Internal (FoundNodePolicy(..))
import NetSpider.Query (policyOverwrite, policyAppend)
import NetSpider.Snapshot.Internal
( SnapshotGraph, SnapshotNode(..), SnapshotLink(..)
)
import NetSpider.Timestamp (Timestamp)
import NetSpider.Unify
( LinkSampleUnifier,
LinkSampleID,
LinkSample(..),
linkSampleId
)
import qualified NetSpider.Unify as Unify
data Weaver n na la =
Weaver
{ Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes :: HashMap n [FoundNode n na la],
Weaver n na la -> FoundNodePolicy n na
foundNodePolicy :: FoundNodePolicy n na
}
deriving (Int -> Weaver n na la -> ShowS
[Weaver n na la] -> ShowS
Weaver n na la -> String
(Int -> Weaver n na la -> ShowS)
-> (Weaver n na la -> String)
-> ([Weaver n na la] -> ShowS)
-> Show (Weaver n na la)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n na la.
(Show n, Show la, Show na) =>
Int -> Weaver n na la -> ShowS
forall n na la.
(Show n, Show la, Show na) =>
[Weaver n na la] -> ShowS
forall n na la.
(Show n, Show la, Show na) =>
Weaver n na la -> String
showList :: [Weaver n na la] -> ShowS
$cshowList :: forall n na la.
(Show n, Show la, Show na) =>
[Weaver n na la] -> ShowS
show :: Weaver n na la -> String
$cshow :: forall n na la.
(Show n, Show la, Show na) =>
Weaver n na la -> String
showsPrec :: Int -> Weaver n na la -> ShowS
$cshowsPrec :: forall n na la.
(Show n, Show la, Show na) =>
Int -> Weaver n na la -> ShowS
Show,Weaver n na la -> Weaver n na la -> Bool
(Weaver n na la -> Weaver n na la -> Bool)
-> (Weaver n na la -> Weaver n na la -> Bool)
-> Eq (Weaver n na la)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall n na la.
(Eq n, Eq la, Eq na) =>
Weaver n na la -> Weaver n na la -> Bool
/= :: Weaver n na la -> Weaver n na la -> Bool
$c/= :: forall n na la.
(Eq n, Eq la, Eq na) =>
Weaver n na la -> Weaver n na la -> Bool
== :: Weaver n na la -> Weaver n na la -> Bool
$c== :: forall n na la.
(Eq n, Eq la, Eq na) =>
Weaver n na la -> Weaver n na la -> Bool
Eq)
newWeaver :: FoundNodePolicy n na -> Weaver n na la
newWeaver :: FoundNodePolicy n na -> Weaver n na la
newWeaver FoundNodePolicy n na
p = HashMap n [FoundNode n na la]
-> FoundNodePolicy n na -> Weaver n na la
forall n na la.
HashMap n [FoundNode n na la]
-> FoundNodePolicy n na -> Weaver n na la
Weaver HashMap n [FoundNode n na la]
forall k v. HashMap k v
HM.empty FoundNodePolicy n na
p
addFoundNode :: (Eq n, Hashable n) => FoundNode n na la -> Weaver n na la -> Weaver n na la
addFoundNode :: FoundNode n na la -> Weaver n na la -> Weaver n na la
addFoundNode FoundNode n na la
fn Weaver n na la
weaver = Weaver n na la
new_weaver
where
nid :: n
nid = FoundNode n na la -> n
forall n na la. FoundNode n na la -> n
subjectNode FoundNode n na la
fn
new_weaver :: Weaver n na la
new_weaver = Weaver n na la
weaver { visitedNodes :: HashMap n [FoundNode n na la]
visitedNodes = ([FoundNode n na la] -> [FoundNode n na la] -> [FoundNode n na la])
-> n
-> [FoundNode n na la]
-> HashMap n [FoundNode n na la]
-> HashMap n [FoundNode n na la]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith [FoundNode n na la] -> [FoundNode n na la] -> [FoundNode n na la]
forall n na la.
[FoundNode n na la] -> [FoundNode n na la] -> [FoundNode n na la]
updater n
nid [FoundNode n na la
fn] (HashMap n [FoundNode n na la] -> HashMap n [FoundNode n na la])
-> HashMap n [FoundNode n na la] -> HashMap n [FoundNode n na la]
forall a b. (a -> b) -> a -> b
$ Weaver n na la -> HashMap n [FoundNode n na la]
forall n na la. Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes Weaver n na la
weaver }
updater :: [FoundNode n na la] -> [FoundNode n na la] -> [FoundNode n na la]
updater =
case Weaver n na la -> FoundNodePolicy n na
forall n na la. Weaver n na la -> FoundNodePolicy n na
foundNodePolicy Weaver n na la
weaver of
FoundNodePolicy n na
PolicyOverwrite -> \[FoundNode n na la]
new [FoundNode n na la]
old -> if [FoundNode n na la] -> Maybe Timestamp
forall n na la. [FoundNode n na la] -> Maybe Timestamp
latestTimeOfNodes [FoundNode n na la]
new Maybe Timestamp -> Maybe Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
>= [FoundNode n na la] -> Maybe Timestamp
forall n na la. [FoundNode n na la] -> Maybe Timestamp
latestTimeOfNodes [FoundNode n na la]
old
then [FoundNode n na la]
new
else [FoundNode n na la]
old
FoundNodePolicy n na
PolicyAppend -> \[FoundNode n na la]
new [FoundNode n na la]
old -> [FoundNode n na la]
new [FoundNode n na la] -> [FoundNode n na la] -> [FoundNode n na la]
forall a. [a] -> [a] -> [a]
++ [FoundNode n na la]
old
latestTimeOfNodes :: [FoundNode n na la] -> Maybe Timestamp
latestTimeOfNodes [FoundNode n na la]
ns = [Timestamp] -> Maybe Timestamp
forall a. [a] -> Maybe a
listToMaybe ([Timestamp] -> Maybe Timestamp) -> [Timestamp] -> Maybe Timestamp
forall a b. (a -> b) -> a -> b
$ [Timestamp] -> [Timestamp]
forall a. [a] -> [a]
reverse ([Timestamp] -> [Timestamp]) -> [Timestamp] -> [Timestamp]
forall a b. (a -> b) -> a -> b
$ [Timestamp] -> [Timestamp]
forall a. Ord a => [a] -> [a]
sort ([Timestamp] -> [Timestamp]) -> [Timestamp] -> [Timestamp]
forall a b. (a -> b) -> a -> b
$ (FoundNode n na la -> Timestamp)
-> [FoundNode n na la] -> [Timestamp]
forall a b. (a -> b) -> [a] -> [b]
map FoundNode n na la -> Timestamp
forall n na la. FoundNode n na la -> Timestamp
foundAt [FoundNode n na la]
ns
markAsVisited :: (Eq n, Hashable n) => n -> Weaver n na la -> Weaver n na la
markAsVisited :: n -> Weaver n na la -> Weaver n na la
markAsVisited n
nid Weaver n na la
w = Weaver n na la
w { visitedNodes :: HashMap n [FoundNode n na la]
visitedNodes = ([FoundNode n na la] -> [FoundNode n na la] -> [FoundNode n na la])
-> n
-> [FoundNode n na la]
-> HashMap n [FoundNode n na la]
-> HashMap n [FoundNode n na la]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith [FoundNode n na la] -> [FoundNode n na la] -> [FoundNode n na la]
forall p p. p -> p -> p
updater n
nid [] (HashMap n [FoundNode n na la] -> HashMap n [FoundNode n na la])
-> HashMap n [FoundNode n na la] -> HashMap n [FoundNode n na la]
forall a b. (a -> b) -> a -> b
$ Weaver n na la -> HashMap n [FoundNode n na la]
forall n na la. Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes Weaver n na la
w }
where
updater :: p -> p -> p
updater p
_ p
old = p
old
isVisited :: (Eq n, Hashable n) => n -> Weaver n na la -> Bool
isVisited :: n -> Weaver n na la -> Bool
isVisited n
n Weaver n na la
w = n -> HashMap n [FoundNode n na la] -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member n
n (Weaver n na la -> HashMap n [FoundNode n na la]
forall n na la. Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes Weaver n na la
w)
getFoundNodes :: (Eq n, Hashable n) => n -> Weaver n na la -> Maybe [FoundNode n na la]
getFoundNodes :: n -> Weaver n na la -> Maybe [FoundNode n na la]
getFoundNodes n
n Weaver n na la
w = n -> HashMap n [FoundNode n na la] -> Maybe [FoundNode n na la]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup n
n (Weaver n na la -> HashMap n [FoundNode n na la]
forall n na la. Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes Weaver n na la
w)
getSnapshot :: (Ord n, Hashable n, Show n) => LinkSampleUnifier n na fla sla -> Weaver n na fla -> SnapshotGraph n na sla
getSnapshot :: LinkSampleUnifier n na fla sla
-> Weaver n na fla -> SnapshotGraph n na sla
getSnapshot LinkSampleUnifier n na fla sla
u Weaver n na fla
w = (SnapshotGraph n na sla, [LogLine]) -> SnapshotGraph n na sla
forall a b. (a, b) -> a
fst ((SnapshotGraph n na sla, [LogLine]) -> SnapshotGraph n na sla)
-> (SnapshotGraph n na sla, [LogLine]) -> SnapshotGraph n na sla
forall a b. (a -> b) -> a -> b
$ 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])
getSnapshot' LinkSampleUnifier n na fla sla
u Weaver n na fla
w
getBoundaryNodes :: (Eq n, Hashable n) => Weaver n na fla -> [n]
getBoundaryNodes :: Weaver n na fla -> [n]
getBoundaryNodes Weaver n na fla
weaver = HashSet n -> [n]
forall a. HashSet a -> [a]
HS.toList HashSet n
boundary_nodes_set
where
boundary_nodes_set :: HashSet n
boundary_nodes_set = [n] -> HashSet n
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([n] -> HashSet n) -> [n] -> HashSet n
forall a b. (a -> b) -> a -> b
$ (n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
filter (\n
nid -> 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
isVisited n
nid Weaver n na fla
weaver) ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ [n]
all_target_nodes
all_target_nodes :: [n]
all_target_nodes = ((FoundLink n fla -> n) -> [FoundLink n fla] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map FoundLink n fla -> n
forall n la. FoundLink n la -> n
targetNode ([FoundLink n fla] -> [n])
-> (FoundNode n na fla -> [FoundLink n fla])
-> FoundNode n na fla
-> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundNode n na fla -> [FoundLink n fla]
forall n na la. FoundNode n na la -> [FoundLink n la]
neighborLinks) (FoundNode n na fla -> [n]) -> [FoundNode n na fla] -> [n]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([[FoundNode n na fla]] -> [FoundNode n na fla]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FoundNode n na fla]] -> [FoundNode n na fla])
-> [[FoundNode n na fla]] -> [FoundNode n na fla]
forall a b. (a -> b) -> a -> b
$ HashMap n [FoundNode n na fla] -> [[FoundNode n na fla]]
forall k v. HashMap k v -> [v]
HM.elems (HashMap n [FoundNode n na fla] -> [[FoundNode n na fla]])
-> HashMap n [FoundNode n na fla] -> [[FoundNode n na fla]]
forall a b. (a -> b) -> a -> b
$ Weaver n na fla -> HashMap n [FoundNode n na fla]
forall n na la. Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes Weaver n na fla
weaver)
visitAllBoundaryNodes :: (Eq n, Hashable n) => Weaver n na fla -> Weaver n na fla
visitAllBoundaryNodes :: Weaver n na fla -> Weaver n na fla
visitAllBoundaryNodes Weaver n na fla
weaver = (Weaver n na fla -> n -> Weaver n na fla)
-> Weaver n na fla -> [n] -> Weaver n na fla
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Weaver n na fla
w n
n -> 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
markAsVisited n
n Weaver n na fla
w) Weaver n na fla
weaver ([n] -> Weaver n na fla) -> [n] -> Weaver n na fla
forall a b. (a -> b) -> a -> b
$ Weaver n na fla -> [n]
forall n na fla. (Eq n, Hashable n) => Weaver n na fla -> [n]
getBoundaryNodes Weaver n na fla
weaver
latestFoundNodeFor :: (Eq n, Hashable n) => n -> Weaver n na fla -> Maybe (FoundNode n na fla)
latestFoundNodeFor :: n -> Weaver n na fla -> Maybe (FoundNode n na fla)
latestFoundNodeFor n
nid Weaver n na fla
weaver = do
[FoundNode n na fla]
found_nodes <- n -> HashMap n [FoundNode n na fla] -> Maybe [FoundNode n na fla]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup n
nid (HashMap n [FoundNode n na fla] -> Maybe [FoundNode n na fla])
-> HashMap n [FoundNode n na fla] -> Maybe [FoundNode n na fla]
forall a b. (a -> b) -> a -> b
$ Weaver n na fla -> HashMap n [FoundNode n na fla]
forall n na la. Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes Weaver n na fla
weaver
[FoundNode n na fla] -> Maybe (FoundNode n na fla)
forall a. [a] -> Maybe a
listToMaybe ([FoundNode n na fla] -> Maybe (FoundNode n na fla))
-> [FoundNode n na fla] -> Maybe (FoundNode n na fla)
forall a b. (a -> b) -> a -> b
$ [FoundNode n na fla] -> [FoundNode n na fla]
forall a. [a] -> [a]
reverse ([FoundNode n na fla] -> [FoundNode n na fla])
-> [FoundNode n na fla] -> [FoundNode n na fla]
forall a b. (a -> b) -> a -> b
$ (FoundNode n na fla -> Timestamp)
-> [FoundNode n na fla] -> [FoundNode n na fla]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn FoundNode n na fla -> Timestamp
forall n na la. FoundNode n na la -> Timestamp
foundAt ([FoundNode n na fla] -> [FoundNode n na fla])
-> [FoundNode n na fla] -> [FoundNode n na fla]
forall a b. (a -> b) -> a -> b
$ [FoundNode n na fla]
found_nodes
makeSnapshotNode :: (Eq n, Hashable n) => Weaver n na fla -> n -> SnapshotNode n na
makeSnapshotNode :: Weaver n na fla -> n -> SnapshotNode n na
makeSnapshotNode Weaver n na fla
weaver n
nid =
SnapshotNode :: forall n na.
n -> Bool -> Maybe Timestamp -> Maybe na -> SnapshotNode n na
SnapshotNode { _nodeId :: n
_nodeId = n
nid,
_isOnBoundary :: Bool
_isOnBoundary = 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
isVisited n
nid Weaver n na fla
weaver,
_nodeTimestamp :: Maybe Timestamp
_nodeTimestamp = Maybe Timestamp
m_timestamp,
_nodeAttributes :: Maybe na
_nodeAttributes = Maybe na
m_attributes
}
where
mfn :: Maybe (FoundNode n na fla)
mfn = n -> Weaver n na fla -> Maybe (FoundNode n na fla)
forall n na fla.
(Eq n, Hashable n) =>
n -> Weaver n na fla -> Maybe (FoundNode n na fla)
latestFoundNodeFor n
nid Weaver n na fla
weaver
m_timestamp :: Maybe Timestamp
m_timestamp = (FoundNode n na fla -> Timestamp)
-> Maybe (FoundNode n na fla) -> Maybe Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FoundNode n na fla -> Timestamp
forall n na la. FoundNode n na la -> Timestamp
foundAt Maybe (FoundNode n na fla)
mfn
m_attributes :: Maybe na
m_attributes = (FoundNode n na fla -> na)
-> Maybe (FoundNode n na fla) -> Maybe na
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FoundNode n na fla -> na
forall n na la. FoundNode n na la -> na
nodeAttributes Maybe (FoundNode n na fla)
mfn
allLinkSamples :: Weaver n na la -> [LinkSample n la]
allLinkSamples :: Weaver n na la -> [LinkSample n la]
allLinkSamples Weaver n na la
w = FoundNode n na la -> [LinkSample n la]
forall n na la. FoundNode n na la -> [LinkSample n la]
Unify.toLinkSamples (FoundNode n na la -> [LinkSample n la])
-> [FoundNode n na la] -> [LinkSample n la]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([[FoundNode n na la]] -> [FoundNode n na la]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FoundNode n na la]] -> [FoundNode n na la])
-> [[FoundNode n na la]] -> [FoundNode n na la]
forall a b. (a -> b) -> a -> b
$ HashMap n [FoundNode n na la] -> [[FoundNode n na la]]
forall k v. HashMap k v -> [v]
HM.elems (HashMap n [FoundNode n na la] -> [[FoundNode n na la]])
-> HashMap n [FoundNode n na la] -> [[FoundNode n na la]]
forall a b. (a -> b) -> a -> b
$ Weaver n na la -> HashMap n [FoundNode n na la]
forall n na la. Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes Weaver n na la
w)
getSnapshot' :: (Ord n, Hashable n, Show n)
=> LinkSampleUnifier n na fla sla
-> Weaver n na fla
-> (SnapshotGraph n na sla, [LogLine])
getSnapshot' :: LinkSampleUnifier n na fla sla
-> Weaver n na fla -> (SnapshotGraph n na sla, [LogLine])
getSnapshot' LinkSampleUnifier n na fla sla
unifier Weaver n na fla
weaver = (([SnapshotNode n na]
nodes, [SnapshotLink n sla]
links), [LogLine]
logs)
where
nodes :: [SnapshotNode n na]
nodes = [SnapshotNode n na]
visited_nodes [SnapshotNode n na] -> [SnapshotNode n na] -> [SnapshotNode n na]
forall a. [a] -> [a] -> [a]
++ [SnapshotNode n na]
boundary_nodes
visited_nodes :: [SnapshotNode n na]
visited_nodes = (n -> SnapshotNode n na) -> [n] -> [SnapshotNode n na]
forall a b. (a -> b) -> [a] -> [b]
map (Weaver n na fla -> n -> SnapshotNode n na
forall n na fla.
(Eq n, Hashable n) =>
Weaver n na fla -> n -> SnapshotNode n na
makeSnapshotNode Weaver n na fla
weaver) ([n] -> [SnapshotNode n na]) -> [n] -> [SnapshotNode n na]
forall a b. (a -> b) -> a -> b
$ HashMap n [FoundNode n na fla] -> [n]
forall k v. HashMap k v -> [k]
HM.keys (HashMap n [FoundNode n na fla] -> [n])
-> HashMap n [FoundNode n na fla] -> [n]
forall a b. (a -> b) -> a -> b
$ Weaver n na fla -> HashMap n [FoundNode n na fla]
forall n na la. Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes Weaver n na fla
weaver
boundary_nodes :: [SnapshotNode n na]
boundary_nodes = (n -> SnapshotNode n na) -> [n] -> [SnapshotNode n na]
forall a b. (a -> b) -> [a] -> [b]
map (Weaver n na fla -> n -> SnapshotNode n na
forall n na fla.
(Eq n, Hashable n) =>
Weaver n na fla -> n -> SnapshotNode n na
makeSnapshotNode Weaver n na fla
weaver) ([n] -> [SnapshotNode n na]) -> [n] -> [SnapshotNode n na]
forall a b. (a -> b) -> a -> b
$ Weaver n na fla -> [n]
forall n na fla. (Eq n, Hashable n) => Weaver n na fla -> [n]
getBoundaryNodes Weaver n na fla
weaver
([SnapshotLink n sla]
links, [LogLine]
logs) = WriterLoggingM [SnapshotLink n sla]
-> ([SnapshotLink n sla], [LogLine])
forall a. WriterLoggingM a -> (a, [LogLine])
runWriterLoggingM (WriterLoggingM [SnapshotLink n sla]
-> ([SnapshotLink n sla], [LogLine]))
-> WriterLoggingM [SnapshotLink n sla]
-> ([SnapshotLink n sla], [LogLine])
forall a b. (a -> b) -> a -> b
$ ([[SnapshotLink n sla]] -> [SnapshotLink n sla])
-> WriterLoggingT Identity [[SnapshotLink n sla]]
-> WriterLoggingM [SnapshotLink n sla]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SnapshotLink n sla]] -> [SnapshotLink n sla]
forall a. Monoid a => [a] -> a
mconcat
(WriterLoggingT Identity [[SnapshotLink n sla]]
-> WriterLoggingM [SnapshotLink n sla])
-> WriterLoggingT Identity [[SnapshotLink n sla]]
-> WriterLoggingM [SnapshotLink n sla]
forall a b. (a -> b) -> a -> b
$ ([LinkSample n fla] -> WriterLoggingM [SnapshotLink n sla])
-> [[LinkSample n fla]]
-> WriterLoggingT Identity [[SnapshotLink n sla]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (LinkSampleUnifier n na fla sla
-> Weaver n na fla
-> [LinkSample n fla]
-> WriterLoggingM [SnapshotLink n sla]
forall n na fla sla.
(Eq n, Hashable n, Show n) =>
LinkSampleUnifier n na fla sla
-> Weaver n na fla
-> [LinkSample n fla]
-> WriterLoggingM [SnapshotLink n sla]
makeSnapshotLinks LinkSampleUnifier n na fla sla
unifier Weaver n na fla
weaver)
([[LinkSample n fla]]
-> WriterLoggingT Identity [[SnapshotLink n sla]])
-> [[LinkSample n fla]]
-> WriterLoggingT Identity [[SnapshotLink n sla]]
forall a b. (a -> b) -> a -> b
$ (LinkSample n fla -> LinkSampleID n)
-> [LinkSample n fla] -> [[LinkSample n fla]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith LinkSample n fla -> LinkSampleID n
forall n la. LinkSample n la -> LinkSampleID n
linkSampleId ([LinkSample n fla] -> [[LinkSample n fla]])
-> [LinkSample n fla] -> [[LinkSample n fla]]
forall a b. (a -> b) -> a -> b
$ Weaver n na fla -> [LinkSample n fla]
forall n na la. Weaver n na la -> [LinkSample n la]
allLinkSamples Weaver n na fla
weaver
makeSnapshotLinks :: (Eq n, Hashable n, Show n)
=> LinkSampleUnifier n na fla sla
-> Weaver n na fla
-> [LinkSample n fla]
-> WriterLoggingM [SnapshotLink n sla]
makeSnapshotLinks :: LinkSampleUnifier n na fla sla
-> Weaver n na fla
-> [LinkSample n fla]
-> WriterLoggingM [SnapshotLink n sla]
makeSnapshotLinks LinkSampleUnifier n na fla sla
_ Weaver n na fla
_ [] = [SnapshotLink n sla] -> WriterLoggingM [SnapshotLink n sla]
forall (m :: * -> *) a. Monad m => a -> m a
return []
makeSnapshotLinks LinkSampleUnifier n na fla sla
unifier Weaver n na fla
weaver link_samples :: [LinkSample n fla]
link_samples@(LinkSample n fla
head_sample : [LinkSample n fla]
_) = do
[LinkSample n sla]
unified <- [LinkSample n fla] -> WriterLoggingM [LinkSample n sla]
doUnify [LinkSample n fla]
link_samples
[LinkSample n sla] -> WriterLoggingM ()
forall (t :: * -> *) a. Foldable t => t a -> WriterLoggingM ()
logUnified [LinkSample n sla]
unified
[SnapshotLink n sla] -> WriterLoggingM [SnapshotLink n sla]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SnapshotLink n sla] -> WriterLoggingM [SnapshotLink n sla])
-> [SnapshotLink n sla] -> WriterLoggingM [SnapshotLink n sla]
forall a b. (a -> b) -> a -> b
$ (LinkSample n sla -> Maybe (SnapshotLink n sla))
-> [LinkSample n sla] -> [SnapshotLink n sla]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LinkSample n sla -> Maybe (SnapshotLink n sla)
forall n la. LinkSample n la -> Maybe (SnapshotLink n la)
makeSnapshotLink [LinkSample n sla]
unified
where
makeEndNode :: (LinkSample n fla -> n) -> SnapshotNode n na
makeEndNode LinkSample n fla -> n
getter = Weaver n na fla -> n -> SnapshotNode n na
forall n na fla.
(Eq n, Hashable n) =>
Weaver n na fla -> n -> SnapshotNode n na
makeSnapshotNode Weaver n na fla
weaver (n -> SnapshotNode n na) -> n -> SnapshotNode n na
forall a b. (a -> b) -> a -> b
$ LinkSample n fla -> n
getter (LinkSample n fla -> n) -> LinkSample n fla -> n
forall a b. (a -> b) -> a -> b
$ LinkSample n fla
head_sample
doUnify :: [LinkSample n fla] -> WriterLoggingM [LinkSample n sla]
doUnify = LinkSampleUnifier n na fla sla
unifier ((LinkSample n fla -> n) -> SnapshotNode n na
makeEndNode LinkSample n fla -> n
forall n la. LinkSample n la -> n
lsSubjectNode) ((LinkSample n fla -> n) -> SnapshotNode n na
makeEndNode LinkSample n fla -> n
forall n la. LinkSample n la -> n
lsTargetNode)
logUnified :: t a -> WriterLoggingM ()
logUnified t a
unified = Text -> WriterLoggingM ()
logDebugW ( Text
"Unify link [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (n -> Text
forall a. Show a => a -> Text
spack (n -> Text) -> n -> Text
forall a b. (a -> b) -> a -> b
$ LinkSample n fla -> n
forall n la. LinkSample n la -> n
lsSubjectNode LinkSample n fla
head_sample) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]-["
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (n -> Text
forall a. Show a => a -> Text
spack (n -> Text) -> n -> Text
forall a b. (a -> b) -> a -> b
$ LinkSample n fla -> n
forall n la. LinkSample n la -> n
lsTargetNode LinkSample n fla
head_sample) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text
forall a. Show a => a -> Text
spack (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [LinkSample n fla] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinkSample n fla]
link_samples) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" samples "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text
forall a. Show a => a -> Text
spack (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
unified) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" samples"
)
makeSnapshotLink :: LinkSample n la -> Maybe (SnapshotLink n la)
makeSnapshotLink LinkSample n la
unified_sample = do
case LinkSample n la -> LinkState
forall n la. LinkSample n la -> LinkState
lsLinkState LinkSample n la
unified_sample of
LinkState
LinkUnused -> Maybe (SnapshotLink n la)
forall a. Maybe a
Nothing
LinkState
LinkToTarget -> SnapshotLink n la -> Maybe (SnapshotLink n la)
forall a. a -> Maybe a
Just (SnapshotLink n la -> Maybe (SnapshotLink n la))
-> SnapshotLink n la -> Maybe (SnapshotLink n la)
forall a b. (a -> b) -> a -> b
$ LinkSample n la -> Bool -> Bool -> SnapshotLink n la
forall n la. LinkSample n la -> Bool -> Bool -> SnapshotLink n la
sampleToLink LinkSample n la
unified_sample Bool
True Bool
True
LinkState
LinkToSubject -> SnapshotLink n la -> Maybe (SnapshotLink n la)
forall a. a -> Maybe a
Just (SnapshotLink n la -> Maybe (SnapshotLink n la))
-> SnapshotLink n la -> Maybe (SnapshotLink n la)
forall a b. (a -> b) -> a -> b
$ LinkSample n la -> Bool -> Bool -> SnapshotLink n la
forall n la. LinkSample n la -> Bool -> Bool -> SnapshotLink n la
sampleToLink LinkSample n la
unified_sample Bool
False Bool
True
LinkState
LinkBidirectional -> SnapshotLink n la -> Maybe (SnapshotLink n la)
forall a. a -> Maybe a
Just (SnapshotLink n la -> Maybe (SnapshotLink n la))
-> SnapshotLink n la -> Maybe (SnapshotLink n la)
forall a b. (a -> b) -> a -> b
$ LinkSample n la -> Bool -> Bool -> SnapshotLink n la
forall n la. LinkSample n la -> Bool -> Bool -> SnapshotLink n la
sampleToLink LinkSample n la
unified_sample Bool
True Bool
False
sampleToLink :: LinkSample n la -> Bool -> Bool -> SnapshotLink n la
sampleToLink LinkSample n la
sample Bool
to_target Bool
is_directed =
SnapshotLink :: forall n la. n -> n -> Bool -> Timestamp -> la -> SnapshotLink n la
SnapshotLink { _sourceNode :: n
_sourceNode = (if Bool
to_target then LinkSample n la -> n
forall n la. LinkSample n la -> n
lsSubjectNode else LinkSample n la -> n
forall n la. LinkSample n la -> n
lsTargetNode) LinkSample n la
sample,
_destinationNode :: n
_destinationNode = (if Bool
to_target then LinkSample n la -> n
forall n la. LinkSample n la -> n
lsTargetNode else LinkSample n la -> n
forall n la. LinkSample n la -> n
lsSubjectNode) LinkSample n la
sample,
_isDirected :: Bool
_isDirected = Bool
is_directed,
_linkTimestamp :: Timestamp
_linkTimestamp = LinkSample n la -> Timestamp
forall n la. LinkSample n la -> Timestamp
lsTimestamp LinkSample n la
sample,
_linkAttributes :: la
_linkAttributes = LinkSample n la -> la
forall n la. LinkSample n la -> la
lsLinkAttributes LinkSample n la
sample
}