{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
-- |
-- Module: NetSpider.Weaver
-- Description: On-memory builder for snapshot graphs
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- @since 0.4.2.0
module NetSpider.Weaver
  ( -- * Type
    Weaver,
    -- * Construction
    newWeaver,
    -- * Add FoundNode
    addFoundNode,
    markAsVisited,
    -- * Query
    getSnapshot,
    getSnapshot',
    isVisited,
    getFoundNodes,
    getBoundaryNodes,
    -- * Misc.
    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

-- | 'Weaver' is an on-memory builder for snapshot graphs. It builds a
-- 'SnapshotGraph' from 'FoundNode's without using an external graph
-- database.
data Weaver n na la =
  Weaver
  { Weaver n na la -> HashMap n [FoundNode n na la]
visitedNodes :: HashMap n [FoundNode n na la],
    -- ^ Node IDs for visited nodes are kept as the key. The value is
    -- empty if there is no observation for that visited node.
    Weaver n na la -> FoundNodePolicy n na
foundNodePolicy :: FoundNodePolicy n na
    -- ^ Policy to maintain the value of 'visitedNodes'.
  }
  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)

-- | Make a new 'Weaver'.
--
-- The 'FoundNodePolicy' controls the behavior of 'addFoundNode'. If
-- it's 'policyOverwrite', 'Weaver' maintains only the 'FoundNode'
-- with the latest timestamp for each node. If it's 'policyAppend',
-- 'Weaver' maintains all 'FoundNode's added.
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

-- | Add a 'FoundNode' to the 'Weaver'. See also 'newWeaver'.
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

-- | Mark the node ID as visited in the 'Weaver' without any
-- 'FoundNode'. If there is already some 'FoundNode' for the node ID,
-- this function does nothing.
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

-- | Returns 'True' if the node ID is already visited in the 'Weaver'.
--
-- A visited node is the one that has at least one 'FoundNode' added,
-- or on which 'markAsVisited' has executed.
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)

-- | Get the 'FoundNode's for the given node ID kept in 'Weaver'.
--
-- It returns 'Nothing' if the node ID is not visited. It returns an
-- empty list if the node ID is visited (by 'markAsVisited'), but
-- doesn't have any 'FoundNode'.
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)

-- | Make 'SnapshotGraph' from the current 'Weaver'.
--
-- The 'SnapshotGraph' is constructed from all 'FoundNode's added to
-- the 'Weaver' so far.
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

-- | Get boundary nodes from the 'Weaver'.
--
-- A boundary node is a node that has been observed as a target of
-- some links but not visited yet. This function returns the set of
-- unique boundary nodes.
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)

-- | (Basically for testing): run 'markAsVisited' on all boundary
-- nodes.
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)

-- | Same as 'getSnapshot', but it also returns logs.
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

-- | The input 'LinkSample's must be for the equivalent
-- 'LinkSampleID'. The output is list of 'SnapshotLink's, each of
-- which corresponds to a subgroup of 'LinkSample's.
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
                   }