{-# LANGUAGE OverloadedStrings #-}
module NetSpider.Unify
(
LinkSampleUnifier,
LinkSample(..),
LinkSampleID,
linkSampleId,
toLinkSamples,
unifyToOne,
unifyToMany,
unifyStd,
UnifyStdConfig(..),
defUnifyStdConfig,
latestLinkSample,
defNegatesLinkSample
) where
import Control.Monad (mapM)
import Data.Foldable (maximumBy)
import Data.Function (on)
import Data.Hashable (Hashable(hashWithSalt))
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import GHC.Exts (groupWith)
import NetSpider.Found (FoundLink, LinkState, FoundNode)
import qualified NetSpider.Found as Found
import NetSpider.Log (WriterLoggingM, logDebugW, spack)
import NetSpider.Pair (Pair(..))
import NetSpider.Snapshot (SnapshotNode, nodeTimestamp, nodeId, SnapshotLink)
import NetSpider.Timestamp (Timestamp)
data LinkSample n la =
LinkSample
{ LinkSample n la -> n
lsSubjectNode :: n,
LinkSample n la -> n
lsTargetNode :: n,
LinkSample n la -> LinkState
lsLinkState :: LinkState,
LinkSample n la -> Timestamp
lsTimestamp :: Timestamp,
LinkSample n la -> la
lsLinkAttributes :: la
}
deriving (Int -> LinkSample n la -> ShowS
[LinkSample n la] -> ShowS
LinkSample n la -> String
(Int -> LinkSample n la -> ShowS)
-> (LinkSample n la -> String)
-> ([LinkSample n la] -> ShowS)
-> Show (LinkSample n la)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n la. (Show n, Show la) => Int -> LinkSample n la -> ShowS
forall n la. (Show n, Show la) => [LinkSample n la] -> ShowS
forall n la. (Show n, Show la) => LinkSample n la -> String
showList :: [LinkSample n la] -> ShowS
$cshowList :: forall n la. (Show n, Show la) => [LinkSample n la] -> ShowS
show :: LinkSample n la -> String
$cshow :: forall n la. (Show n, Show la) => LinkSample n la -> String
showsPrec :: Int -> LinkSample n la -> ShowS
$cshowsPrec :: forall n la. (Show n, Show la) => Int -> LinkSample n la -> ShowS
Show,LinkSample n la -> LinkSample n la -> Bool
(LinkSample n la -> LinkSample n la -> Bool)
-> (LinkSample n la -> LinkSample n la -> Bool)
-> Eq (LinkSample n la)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall n la.
(Eq n, Eq la) =>
LinkSample n la -> LinkSample n la -> Bool
/= :: LinkSample n la -> LinkSample n la -> Bool
$c/= :: forall n la.
(Eq n, Eq la) =>
LinkSample n la -> LinkSample n la -> Bool
== :: LinkSample n la -> LinkSample n la -> Bool
$c== :: forall n la.
(Eq n, Eq la) =>
LinkSample n la -> LinkSample n la -> Bool
Eq,Eq (LinkSample n la)
Eq (LinkSample n la)
-> (LinkSample n la -> LinkSample n la -> Ordering)
-> (LinkSample n la -> LinkSample n la -> Bool)
-> (LinkSample n la -> LinkSample n la -> Bool)
-> (LinkSample n la -> LinkSample n la -> Bool)
-> (LinkSample n la -> LinkSample n la -> Bool)
-> (LinkSample n la -> LinkSample n la -> LinkSample n la)
-> (LinkSample n la -> LinkSample n la -> LinkSample n la)
-> Ord (LinkSample n la)
LinkSample n la -> LinkSample n la -> Bool
LinkSample n la -> LinkSample n la -> Ordering
LinkSample n la -> LinkSample n la -> LinkSample n la
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall n la. (Ord n, Ord la) => Eq (LinkSample n la)
forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> Bool
forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> Ordering
forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> LinkSample n la
min :: LinkSample n la -> LinkSample n la -> LinkSample n la
$cmin :: forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> LinkSample n la
max :: LinkSample n la -> LinkSample n la -> LinkSample n la
$cmax :: forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> LinkSample n la
>= :: LinkSample n la -> LinkSample n la -> Bool
$c>= :: forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> Bool
> :: LinkSample n la -> LinkSample n la -> Bool
$c> :: forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> Bool
<= :: LinkSample n la -> LinkSample n la -> Bool
$c<= :: forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> Bool
< :: LinkSample n la -> LinkSample n la -> Bool
$c< :: forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> Bool
compare :: LinkSample n la -> LinkSample n la -> Ordering
$ccompare :: forall n la.
(Ord n, Ord la) =>
LinkSample n la -> LinkSample n la -> Ordering
$cp1Ord :: forall n la. (Ord n, Ord la) => Eq (LinkSample n la)
Ord)
type LinkSampleID n = Pair n
linkSampleId :: LinkSample n la -> LinkSampleID n
linkSampleId :: LinkSample n la -> LinkSampleID n
linkSampleId LinkSample n la
l = (n, n) -> LinkSampleID n
forall a. (a, a) -> Pair a
Pair (LinkSample n la -> n
forall n la. LinkSample n la -> n
lsSubjectNode LinkSample n la
l, LinkSample n la -> n
forall n la. LinkSample n la -> n
lsTargetNode LinkSample n la
l)
toLinkSamples :: FoundNode n na la -> [LinkSample n la]
toLinkSamples :: FoundNode n na la -> [LinkSample n la]
toLinkSamples FoundNode n na la
fn = (FoundLink n la -> LinkSample n la)
-> [FoundLink n la] -> [LinkSample n la]
forall a b. (a -> b) -> [a] -> [b]
map FoundLink n la -> LinkSample n la
forall la. FoundLink n la -> LinkSample n la
fromFoundLink ([FoundLink n la] -> [LinkSample n la])
-> [FoundLink n la] -> [LinkSample n la]
forall a b. (a -> b) -> a -> b
$ FoundNode n na la -> [FoundLink n la]
forall n na la. FoundNode n na la -> [FoundLink n la]
Found.neighborLinks FoundNode n na la
fn
where
fromFoundLink :: FoundLink n la -> LinkSample n la
fromFoundLink FoundLink n la
fl =
LinkSample :: forall n la.
n -> n -> LinkState -> Timestamp -> la -> LinkSample n la
LinkSample
{ lsSubjectNode :: n
lsSubjectNode = FoundNode n na la -> n
forall n na la. FoundNode n na la -> n
Found.subjectNode FoundNode n na la
fn,
lsTargetNode :: n
lsTargetNode = FoundLink n la -> n
forall n la. FoundLink n la -> n
Found.targetNode FoundLink n la
fl,
lsLinkState :: LinkState
lsLinkState = FoundLink n la -> LinkState
forall n la. FoundLink n la -> LinkState
Found.linkState FoundLink n la
fl,
lsTimestamp :: Timestamp
lsTimestamp = FoundNode n na la -> Timestamp
forall n na la. FoundNode n na la -> Timestamp
Found.foundAt FoundNode n na la
fn,
lsLinkAttributes :: la
lsLinkAttributes = FoundLink n la -> la
forall n la. FoundLink n la -> la
Found.linkAttributes FoundLink n la
fl
}
type LinkSampleUnifier n na fla sla = SnapshotNode n na -> SnapshotNode n na -> [LinkSample n fla] -> WriterLoggingM [LinkSample n sla]
unifyToOne :: (Eq n, Show n) => LinkSampleUnifier n na la la
unifyToOne :: LinkSampleUnifier n na la la
unifyToOne = UnifyStdConfig n na la la () -> LinkSampleUnifier n na la la
forall n lsid na fla sla.
(Eq n, Show n, Ord lsid) =>
UnifyStdConfig n na fla sla lsid -> LinkSampleUnifier n na fla sla
unifyStd UnifyStdConfig n na la la ()
forall n na fla. Eq n => UnifyStdConfig n na fla fla ()
defUnifyStdConfig
unifyToMany :: (Eq n, Show n, Ord lsid)
=> (LinkSample n fla -> lsid)
-> LinkSampleUnifier n na fla fla
unifyToMany :: (LinkSample n fla -> lsid) -> LinkSampleUnifier n na fla fla
unifyToMany LinkSample n fla -> lsid
getKey = UnifyStdConfig n na fla fla lsid -> LinkSampleUnifier n na fla fla
forall n lsid na fla sla.
(Eq n, Show n, Ord lsid) =>
UnifyStdConfig n na fla sla lsid -> LinkSampleUnifier n na fla sla
unifyStd UnifyStdConfig n na fla fla lsid
forall na. UnifyStdConfig n na fla fla lsid
conf
where
conf :: UnifyStdConfig n na fla fla lsid
conf = UnifyStdConfig n na fla fla ()
forall n na fla. Eq n => UnifyStdConfig n na fla fla ()
defUnifyStdConfig { makeLinkSubId :: LinkSample n fla -> lsid
makeLinkSubId = LinkSample n fla -> lsid
getKey }
data UnifyStdConfig n na fla sla lsid =
UnifyStdConfig
{ UnifyStdConfig n na fla sla lsid -> LinkSample n fla -> lsid
makeLinkSubId :: LinkSample n fla -> lsid,
UnifyStdConfig n na fla sla lsid
-> [LinkSample n fla]
-> [LinkSample n fla]
-> Maybe (LinkSample n sla)
mergeSamples :: [LinkSample n fla] -> [LinkSample n fla] -> Maybe (LinkSample n sla),
UnifyStdConfig n na fla sla lsid
-> SnapshotNode n na -> LinkSample n sla -> Bool
negatesLinkSample :: SnapshotNode n na -> LinkSample n sla -> Bool
}
defUnifyStdConfig :: Eq n => UnifyStdConfig n na fla fla ()
defUnifyStdConfig :: UnifyStdConfig n na fla fla ()
defUnifyStdConfig = UnifyStdConfig :: forall n na fla sla lsid.
(LinkSample n fla -> lsid)
-> ([LinkSample n fla]
-> [LinkSample n fla] -> Maybe (LinkSample n sla))
-> (SnapshotNode n na -> LinkSample n sla -> Bool)
-> UnifyStdConfig n na fla sla lsid
UnifyStdConfig
{ makeLinkSubId :: LinkSample n fla -> ()
makeLinkSubId = () -> LinkSample n fla -> ()
forall a b. a -> b -> a
const (),
mergeSamples :: [LinkSample n fla]
-> [LinkSample n fla] -> Maybe (LinkSample n fla)
mergeSamples = \[LinkSample n fla]
ls [LinkSample n fla]
rs -> [LinkSample n fla] -> Maybe (LinkSample n fla)
forall n la. [LinkSample n la] -> Maybe (LinkSample n la)
latestLinkSample ([LinkSample n fla]
ls [LinkSample n fla] -> [LinkSample n fla] -> [LinkSample n fla]
forall a. [a] -> [a] -> [a]
++ [LinkSample n fla]
rs),
negatesLinkSample :: SnapshotNode n na -> LinkSample n fla -> Bool
negatesLinkSample = SnapshotNode n na -> LinkSample n fla -> Bool
forall n na la.
Eq n =>
SnapshotNode n na -> LinkSample n la -> Bool
defNegatesLinkSample
}
unifyStd :: (Eq n, Show n, Ord lsid) => UnifyStdConfig n na fla sla lsid -> LinkSampleUnifier n na fla sla
unifyStd :: UnifyStdConfig n na fla sla lsid -> LinkSampleUnifier n na fla sla
unifyStd UnifyStdConfig n na fla sla lsid
conf SnapshotNode n na
lnode SnapshotNode n na
rnode [LinkSample n fla]
input_samples = do
let groups :: [[LinkSample n fla]]
groups = (LinkSample n fla -> lsid)
-> [LinkSample n fla] -> [[LinkSample n fla]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith (UnifyStdConfig n na fla sla lsid -> LinkSample n fla -> lsid
forall n na fla sla lsid.
UnifyStdConfig n na fla sla lsid -> LinkSample n fla -> lsid
makeLinkSubId UnifyStdConfig n na fla sla lsid
conf) [LinkSample n fla]
input_samples
Text -> WriterLoggingM ()
logDebug ( Text
"Group " 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]
input_samples) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" samples into "
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]]
groups) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" groups by link sub-ID."
)
([Maybe (LinkSample n sla)] -> [LinkSample n sla])
-> WriterLoggingT Identity [Maybe (LinkSample n sla)]
-> WriterLoggingM [LinkSample n sla]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (LinkSample n sla)] -> [LinkSample n sla]
forall a. [Maybe a] -> [a]
catMaybes (WriterLoggingT Identity [Maybe (LinkSample n sla)]
-> WriterLoggingM [LinkSample n sla])
-> WriterLoggingT Identity [Maybe (LinkSample n sla)]
-> WriterLoggingM [LinkSample n sla]
forall a b. (a -> b) -> a -> b
$ (([LinkSample n fla], Int)
-> WriterLoggingT Identity (Maybe (LinkSample n sla)))
-> [([LinkSample n fla], Int)]
-> WriterLoggingT Identity [Maybe (LinkSample n sla)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([LinkSample n fla], Int)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
forall b.
Show b =>
([LinkSample n fla], b)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
forGroup ([([LinkSample n fla], Int)]
-> WriterLoggingT Identity [Maybe (LinkSample n sla)])
-> [([LinkSample n fla], Int)]
-> WriterLoggingT Identity [Maybe (LinkSample n sla)]
forall a b. (a -> b) -> a -> b
$ [[LinkSample n fla]] -> [Int] -> [([LinkSample n fla], Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[LinkSample n fla]]
groups ([Int
0 ..] :: [Int])
where
logDebug :: Text -> WriterLoggingM ()
logDebug Text
msg = Text -> WriterLoggingM ()
logDebugW (Text
"unifyStd: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)
samplesFor :: [LinkSample a la] -> SnapshotNode a na -> [LinkSample a la]
samplesFor [LinkSample a la]
samples SnapshotNode a na
sn = (LinkSample a la -> Bool) -> [LinkSample a la] -> [LinkSample a la]
forall a. (a -> Bool) -> [a] -> [a]
filter (\LinkSample a la
s -> SnapshotNode a na -> a
forall n na. SnapshotNode n na -> n
nodeId SnapshotNode a na
sn a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (LinkSample a la -> a
forall n la. LinkSample n la -> n
lsSubjectNode LinkSample a la
s)) [LinkSample a la]
samples
forGroup :: ([LinkSample n fla], b)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
forGroup ([LinkSample n fla]
samples, b
group_i) =
case UnifyStdConfig n na fla sla lsid
-> [LinkSample n fla]
-> [LinkSample n fla]
-> Maybe (LinkSample n sla)
forall n na fla sla lsid.
UnifyStdConfig n na fla sla lsid
-> [LinkSample n fla]
-> [LinkSample n fla]
-> Maybe (LinkSample n sla)
mergeSamples UnifyStdConfig n na fla sla lsid
conf ([LinkSample n fla] -> SnapshotNode n na -> [LinkSample n fla]
forall a la na.
Eq a =>
[LinkSample a la] -> SnapshotNode a na -> [LinkSample a la]
samplesFor [LinkSample n fla]
samples SnapshotNode n na
lnode) ([LinkSample n fla] -> SnapshotNode n na -> [LinkSample n fla]
forall a la na.
Eq a =>
[LinkSample a la] -> SnapshotNode a na -> [LinkSample a la]
samplesFor [LinkSample n fla]
samples SnapshotNode n na
rnode) of
Maybe (LinkSample n sla)
Nothing -> do
Text -> WriterLoggingM ()
logDebugG (Text
"No link after mergeSamples")
Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LinkSample n sla)
forall a. Maybe a
Nothing
Maybe (LinkSample n sla)
ml -> SnapshotNode n na
-> Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
maybeNegates SnapshotNode n na
rnode (Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla)))
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SnapshotNode n na
-> Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
maybeNegates SnapshotNode n na
lnode Maybe (LinkSample n sla)
ml
where
logDebugG :: Text -> WriterLoggingM ()
logDebugG Text
msg = Text -> WriterLoggingM ()
logDebug (Text
"group " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall a. Show a => a -> Text
spack b
group_i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)
maybeNegates :: SnapshotNode n na
-> Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
maybeNegates SnapshotNode n na
_ Maybe (LinkSample n sla)
Nothing = Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LinkSample n sla)
forall a. Maybe a
Nothing
maybeNegates SnapshotNode n na
sn (Just LinkSample n sla
sample) =
if UnifyStdConfig n na fla sla lsid
-> SnapshotNode n na -> LinkSample n sla -> Bool
forall n na fla sla lsid.
UnifyStdConfig n na fla sla lsid
-> SnapshotNode n na -> LinkSample n sla -> Bool
negatesLinkSample UnifyStdConfig n na fla sla lsid
conf SnapshotNode n na
sn LinkSample n sla
sample
then do
Text -> WriterLoggingM ()
logDebugG (Text
"Merged sample is negated by node " 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
$ SnapshotNode n na -> n
forall n na. SnapshotNode n na -> n
nodeId SnapshotNode n na
sn))
Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LinkSample n sla)
forall a. Maybe a
Nothing
else Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla)))
-> Maybe (LinkSample n sla)
-> WriterLoggingT Identity (Maybe (LinkSample n sla))
forall a b. (a -> b) -> a -> b
$ LinkSample n sla -> Maybe (LinkSample n sla)
forall a. a -> Maybe a
Just LinkSample n sla
sample
latestLinkSample :: [LinkSample n la] -> Maybe (LinkSample n la)
latestLinkSample :: [LinkSample n la] -> Maybe (LinkSample n la)
latestLinkSample [] = Maybe (LinkSample n la)
forall a. Maybe a
Nothing
latestLinkSample [LinkSample n la]
samples = LinkSample n la -> Maybe (LinkSample n la)
forall a. a -> Maybe a
Just (LinkSample n la -> Maybe (LinkSample n la))
-> LinkSample n la -> Maybe (LinkSample n la)
forall a b. (a -> b) -> a -> b
$ (LinkSample n la -> LinkSample n la -> Ordering)
-> [LinkSample n la] -> LinkSample n la
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy LinkSample n la -> LinkSample n la -> Ordering
forall n la. LinkSample n la -> LinkSample n la -> Ordering
comp [LinkSample n la]
samples
where
comp :: LinkSample n la -> LinkSample n la -> Ordering
comp = Timestamp -> Timestamp -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Timestamp -> Timestamp -> Ordering)
-> (LinkSample n la -> Timestamp)
-> LinkSample n la
-> LinkSample n la
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LinkSample n la -> Timestamp
forall n la. LinkSample n la -> Timestamp
lsTimestamp
defNegatesLinkSample :: Eq n => SnapshotNode n na -> LinkSample n la -> Bool
defNegatesLinkSample :: SnapshotNode n na -> LinkSample n la -> Bool
defNegatesLinkSample SnapshotNode n na
sn LinkSample n la
l =
case SnapshotNode n na -> Maybe Timestamp
forall n na. SnapshotNode n na -> Maybe Timestamp
nodeTimestamp SnapshotNode n na
sn of
Maybe Timestamp
Nothing -> Bool
False
Just Timestamp
t -> LinkSample n la -> Timestamp
forall n la. LinkSample n la -> Timestamp
lsTimestamp LinkSample n la
l Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
< Timestamp
t Bool -> Bool -> Bool
&& LinkSample n la -> n
forall n la. LinkSample n la -> n
lsSubjectNode LinkSample n la
l n -> n -> Bool
forall a. Eq a => a -> a -> Bool
/= SnapshotNode n na -> n
forall n na. SnapshotNode n na -> n
nodeId SnapshotNode n na
sn