net-spider 0.1.0.0 → 0.2.0.0

raw patch · 17 files changed

+925/−217 lines, 17 filesdep +data-intervaldep +doctestdep +doctest-discoverdep ~basedep ~containersdep ~greskellPVP ok

version bump matches the API change (PVP)

Dependencies added: data-interval, doctest, doctest-discover, extended-reals, monad-logger

Dependency ranges changed: base, containers, greskell, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +43/−0
• net-spider.cabal +24/−7
• src/NetSpider.hs +1/−2
• src/NetSpider/Log.hs +34/−0
• src/NetSpider/Query.hs +67/−5
• src/NetSpider/Query/Internal.hs +19/−0
• src/NetSpider/Spider.hs +157/−86
• src/NetSpider/Spider/Config.hs +14/−24
• src/NetSpider/Spider/Internal/Graph.hs +32/−8
• src/NetSpider/Spider/Internal/Log.hs +36/−0
• src/NetSpider/Spider/Internal/Spider.hs +32/−0
• src/NetSpider/Timestamp.hs +184/−6
• src/NetSpider/Unify.hs +31/−12
• test/DocTest.hs +1/−0
• test/ServerTest/Attributes.hs +2/−2
• test/ServerTest/Common.hs +3/−3
• test/ServerTest/Snapshot.hs +245/−62

@@ -1,5 +1,48 @@ # Revision history for net-spider +## 0.2.0.0  -- 2018-12-10++* Add `Log` module.+* Confirmed test with base-4.12, time-1.9, containers-0.6++### Query module++* Add `timeInterval` and `foundNodePolicy` fields to `Query` type.+* Add `FoundNodePolicy` type.+* Add `secUpTo`, `policyOverwrite` and `policyAppend` functions.+* Re-export symbols from Data.Interval.++### Spider module++* Fix bug that the Spider visits a node multiple times. The result was+  correct, but it took extra time.+* Now it may produce log messages.++### Spider.Config module++* [BREAKING CHANGE] Now `Spider` type's internal is hidden. It was+  just a mistake.+* [BREAKING CHANGE] Now `getSnapshot` and `getSnapshotSimple` requires+  `(Show n)` constraint for logging.+* Add `logThreshold` field.+* Export `LogLevel` type.++### Timestamp module++* [BREAKING CHANGE] Rename `fromEpochSecond` to+  `fromEpochMillisecond`. Now `Timestamp` represents milliseconds+  since the epoch.+* Add `now`, `addSec`, `parseTimestamp`, `fromS`, `fromZonedTime`,+  `fromUTCTime`, `fromSystemTime`, `fromLocalTime`, `showEpochTime`.++### Unify modulem++* [BREAKING CHANGE] Now `LinkSampleUnifier` returns `WriterLoggingM`+  monad.+* [BREAKING CHANGE] Now `unifyToOne`, `unifyToMany` and `unifyStd`+  require `(Show n)` constraint.++ ## 0.1.0.0  -- 2018-09-24  * First version. Released on an unsuspecting world.

@@ -1,5 +1,5 @@ name:                   net-spider-version:                0.1.0.0+version:                0.2.0.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -32,22 +32,29 @@                         NetSpider.Snapshot,                         NetSpider.Graph,                         NetSpider.Pair,-                        NetSpider.Query+                        NetSpider.Query,+                        NetSpider.Log   other-modules:        NetSpider.Snapshot.Internal,                         NetSpider.Graph.Internal,                         NetSpider.Spider.Internal.Graph,-                        NetSpider.Queue-  build-depends:        base >=4.10.1 && <4.12,-                        time >=1.8.0.2 && <1.9,+                        NetSpider.Spider.Internal.Log,+                        NetSpider.Spider.Internal.Spider,+                        NetSpider.Queue,+                        NetSpider.Query.Internal+  build-depends:        base >=4.10.1 && <4.13,+                        time >=1.8.0.2 && <1.10,                         vector >=0.12.0.1 && <0.13,                         greskell-websocket >=0.1.1 && <0.2,-                        greskell >=0.2.1 && <0.3,+                        greskell >=0.2.2 && <0.3,                         aeson >=1.2.4 && <1.5,                         safe-exceptions >=0.1.6 && <0.2,                         text >=1.2.2.2 && <1.3,                         unordered-containers >=0.2.8 && <0.3,                         hashable >=1.2.6.1 && <1.3,-                        containers >=0.5.10.2 && <0.6+                        containers >=0.5.10.2 && <0.7,+                        data-interval >=1.3.0 && <1.4,+                        extended-reals >=0.2.3.0 && <0.3,+                        monad-logger >=0.3.28.1 && <0.4  -- executable net-spider --   default-language:     Haskell2010@@ -94,6 +101,16 @@                           hspec-need-env >=0.1.0.0 && <0.2   else     buildable: False++test-suite doctest+  type:                 exitcode-stdio-1.0+  default-language:     Haskell2010+  hs-source-dirs:       test+  ghc-options:          -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"+  main-is:              DocTest.hs+  build-depends:        base,+                        doctest >=0.13 && <0.17,+                        doctest-discover >=0.1.0.7 && <0.3   source-repository head

@@ -33,7 +33,6 @@ -- == Utility -- -- * "NetSpider.Pair"+-- * "NetSpider.Log" module NetSpider        () where--

@@ -0,0 +1,34 @@+-- |+-- Module: NetSpider.Log+-- Description: Types and functions for basic logging+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- This module is rather for internal use, but end-users can use it,+-- e.g. to implement the unifier.+--+-- @since 0.2.0.0+module NetSpider.Log+       ( LogLine,+         WriterLoggingM,+         runWriterLoggingM,+         logDebugW,+         spack+       ) where++import qualified Control.Monad.Logger as Log+import Data.Functor.Identity (Identity, runIdentity)+import Data.Text (Text, pack)++type LogLine = (Log.Loc, Log.LogSource, Log.LogLevel, Log.LogStr)++type WriterLoggingM = Log.WriterLoggingT Identity++runWriterLoggingM :: WriterLoggingM a -> (a, [LogLine])+runWriterLoggingM = runIdentity . Log.runWriterLoggingT++logDebugW :: Text -> WriterLoggingM ()+logDebugW = Log.logDebugN++spack :: Show a => a -> Text+spack = pack . show+

@@ -5,15 +5,33 @@ -- --  module NetSpider.Query-       ( -- * Query type+       ( -- * Query          Query,          defQuery,          -- ** accessor functions          startsFrom,-         unifyLinkSamples+         unifyLinkSamples,+         timeInterval,+         foundNodePolicy,+         -- * FoundNodePolicy+         FoundNodePolicy,+         policyOverwrite,+         policyAppend,+         -- * Utilities+         secUpTo,+         -- * Re-exports+         Interval, (<=..<=), (<..<=), (<=..<), (<..<),+         Extended(..)        ) where +import Data.ExtendedReal (Extended(..))+import Data.Int (Int64)+import Data.Interval (Interval, (<=..<=), (<..<=), (<=..<), (<..<))+import qualified Data.Interval as Interval++import NetSpider.Timestamp (Timestamp, addSec) import NetSpider.Unify (LinkSampleUnifier, unifyToOne)+import NetSpider.Query.Internal (FoundNodePolicy(..))  -- | Query for snapshot graph. You can get the default 'Query' by -- 'defQuery' function, and customize its fields by the accessor@@ -29,18 +47,62 @@   { startsFrom :: [n],     -- ^ Nodes from which the Spider starts traversing the history     -- graph.-    unifyLinkSamples :: LinkSampleUnifier n na fla sla+    unifyLinkSamples :: LinkSampleUnifier n na fla sla,     -- ^ See the document of 'LinkSampleUnifier'.     --     -- Default: 'unifyToOne'.+    timeInterval :: Interval Timestamp,+    -- ^ Time interval to query. Only the local findings observed+    -- during this interval are used to make the snapshot graph.+    --+    -- Default: (-infinity, +infinity)+    --+    -- @since 0.2.0.0+    foundNodePolicy :: FoundNodePolicy n na+    -- ^ Policy to treat 'FoundNode's (local findings).+    --+    -- Default: 'policyOverwrite'+    --+    -- @since 0.2.0.0   }  -- | The default 'Query'.-defQuery :: Eq n+defQuery :: (Eq n, Show n)          => [n] -- ^ 'startsFrom' field.          -> Query n na fla fla defQuery ns = Query               { startsFrom = ns,-                unifyLinkSamples = unifyToOne+                unifyLinkSamples = unifyToOne,+                timeInterval = Interval.whole,+                foundNodePolicy = policyOverwrite               } +-- | @s `secUpTo` ts@ returns the time interval of length @s@ (in+-- seconds) and up to @ts@. The interval is inclusive for both ends.+--+-- @since 0.2.0.0+secUpTo :: Int64 -> Timestamp -> Interval Timestamp+secUpTo len end = Finite start <=..<= Finite end+  where+    start = addSec (-len) end++-- | A 'FoundNode' always overwrites old 'FoundNode's, so only the+-- latest one is valid.+--+-- This policy is appropriate when you can always get the complete+-- neighbor information of a given node at once.+--+-- @since 0.2.0.0+policyOverwrite :: FoundNodePolicy n na+policyOverwrite = PolicyOverwrite++-- | A 'FoundNode' appends neighbor information to old+-- 'FoundNode's. When the spider makes the snapshot graph, it+-- aggregates all 'FoundNode's in the query range.+--+-- This policy is appropriate when you can only get part of neighbor+-- information of a given node at once.+--+-- @since 0.2.0.0+policyAppend :: FoundNodePolicy n na+policyAppend = PolicyAppend

@@ -0,0 +1,19 @@+-- |+-- Module: NetSpider.Query.Internal+-- Description: +-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- +module NetSpider.Query.Internal+       ( FoundNodePolicy(..)+       ) where++-- | Policy to treat 'FoundNode's (local findings) when the spider+-- creates the snapshot graph.+--+-- @since 0.2.0.0+data FoundNodePolicy n na=+    PolicyOverwrite+  | PolicyAppend+  deriving (Show)+

@@ -21,14 +21,15 @@        ) where  import Control.Exception.Safe (throwString)-import Control.Monad (void)+import Control.Monad (void, mapM_, mapM) import Data.Aeson (ToJSON) import Data.Foldable (foldr', toList)-import Data.Hashable (Hashable)+import Data.List (intercalate) import Data.Greskell   ( runBinder, ($.), (<$.>), (<*.>),     Binder, ToGreskell(GreskellReturn), AsIterator(IteratorItem), FromGraphSON,-    liftWalk, gLimit, gIdentity+    liftWalk, gLimit, gIdentity, gSelectN, gAs,+    lookupAsM, newAsLabel   ) import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap)@@ -36,8 +37,10 @@ import Data.HashSet (HashSet) import qualified Data.HashSet as HS import Data.IORef (IORef, modifyIORef, newIORef, readIORef, atomicModifyIORef')-import Data.Maybe (catMaybes, mapMaybe)-import Data.Monoid (mempty)+import Data.Maybe (catMaybes, mapMaybe, listToMaybe)+import Data.Monoid (mempty, (<>))+import Data.List (sortOn)+import Data.Text (Text, pack) import Data.Vector (Vector) import qualified Data.Vector as V import Network.Greskell.WebSocket (Host, Port)@@ -46,15 +49,27 @@ import NetSpider.Graph (EID, LinkAttributes, NodeAttributes) import NetSpider.Graph.Internal (VFoundNode(..), EFinds(..)) import NetSpider.Found (FoundNode(..), FoundLink(..), LinkState(..))+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)+import NetSpider.Query+  ( Query, defQuery, startsFrom, unifyLinkSamples, timeInterval,+    foundNodePolicy,+    Interval+  )+import NetSpider.Query.Internal (FoundNodePolicy(..)) import NetSpider.Snapshot.Internal (SnapshotNode(..), SnapshotLink(..))-import NetSpider.Spider.Config (Spider(..), Config(..), defConfig)+import NetSpider.Spider.Config (Config(..), defConfig) import NetSpider.Spider.Internal.Graph   ( gMakeFoundNode, gAllNodes, gHasNodeID, gHasNodeEID, gNodeEID, gNodeID, gMakeNode, gClearAll,-    gLatestFoundNode, gSelectFoundNode, gFinds, gHasFoundNodeEID, gAllFoundNode+    gLatestFoundNode, gSelectFoundNode, gFinds, gFindsTarget, gHasFoundNodeEID, gAllFoundNode,+    gFilterFoundNodeByTime   )+import NetSpider.Spider.Internal.Log+  ( runLogger, logDebug, logWarn, logLine+  )+import NetSpider.Spider.Internal.Spider (Spider(..))+import NetSpider.Timestamp (Timestamp, showEpochTime) import NetSpider.Unify (LinkSampleUnifier, LinkSample(..), LinkSampleID, linkSampleId)  -- | Connect to the WebSocket endpoint of Tinkerpop Gremlin Server@@ -128,7 +143,7 @@ -- -- This function is very simple, and should be used only for small -- graphs.-getSnapshotSimple :: (FromGraphSON n, ToJSON n, Ord n, Hashable n, LinkAttributes fla, NodeAttributes na)+getSnapshotSimple :: (FromGraphSON n, ToJSON n, Ord n, Hashable n, Show n, LinkAttributes fla, NodeAttributes na)                   => Spider n na fla                   -> n -- ^ ID of the node where it starts traversing.                   -> IO ([SnapshotNode n na], [SnapshotLink n fla])@@ -137,100 +152,131 @@  -- | Get the snapshot graph from the history graph as specified by the -- 'Query'.-getSnapshot :: (FromGraphSON n, ToJSON n, Ord n, Hashable n, LinkAttributes fla, NodeAttributes na)+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 ([SnapshotNode n na], [SnapshotLink n sla]) getSnapshot spider query = do   ref_state <- newIORef $ initSnapshotState $ startsFrom query-  recurseVisitNodesForSnapshot spider ref_state-  -- print =<< readIORef ref_state-  fmap (makeSnapshot $ unifyLinkSamples query) $ readIORef ref_state-+  recurseVisitNodesForSnapshot spider query ref_state+  (nodes, links, logs) <- fmap (makeSnapshot $ unifyLinkSamples query) $ readIORef ref_state+  mapM_ (logLine spider) logs+  return (nodes, links) -recurseVisitNodesForSnapshot :: (ToJSON n, Ord n, Hashable n, FromGraphSON n, LinkAttributes fla, NodeAttributes na)+recurseVisitNodesForSnapshot :: (ToJSON n, Ord n, Hashable n, FromGraphSON n, Show n, LinkAttributes fla, NodeAttributes na)                              => Spider n na fla+                             -> Query n na fla sla                              -> IORef (SnapshotState n na fla)                              -> IO ()-recurseVisitNodesForSnapshot spider ref_state = go+recurseVisitNodesForSnapshot spider query ref_state = go   where     go = do       mnext_visit <- getNextVisit       case mnext_visit of        Nothing -> return ()        Just next_visit -> do-         visitNodeForSnapshot spider ref_state next_visit+         visitNodeForSnapshot spider query ref_state next_visit          go     getNextVisit = atomicModifyIORef' ref_state popUnvisitedNode     -- TODO: limit number of steps. -visitNodeForSnapshot :: (ToJSON n, Ord n, Hashable n, FromGraphSON n, LinkAttributes fla, NodeAttributes na)+-- | Returns the result of query: (latest VFoundNode, list of traversed edges)+traverseEFindsOneHop :: (FromGraphSON n, NodeAttributes na, LinkAttributes fla)                      => Spider n na fla+                     -> Interval Timestamp+                     -> EID+                     -> IO (Maybe (VFoundNode na), [(VFoundNode na, EFinds fla, n)])+traverseEFindsOneHop spider time_interval visit_eid = (,) <$> getLatestVFoundNode <*> getTraversedEdges+  where+    foundNodeTraversal = fmap gSelectFoundNode (gFilterFoundNodeByTime time_interval)+                         <*.> gHasNodeEID visit_eid+                         <*.> pure gAllNodes+    getLatestVFoundNode = fmap vToMaybe $ Gr.slurpResults =<< submitQuery+      where+        submitQuery = submitB spider binder+        binder = gLatestFoundNode <$.> foundNodeTraversal+    getTraversedEdges = fmap V.toList $ traverse extractFromSMap =<< Gr.slurpResults =<< submitQuery+      where+        submitQuery = Gr.submit (spiderClient spider) query (Just bindings)+        ((query, label_vfn, label_ef, label_target_nid), bindings) = runBinder $ do+          lvfn <- newAsLabel+          lef <- newAsLabel+          ln <- newAsLabel+          gt <- gSelectN lvfn lef [ln]+                <$.> gAs ln <$.> gNodeID spider <$.> gFindsTarget+                <$.> gAs lef <$.> gFinds <$.> gAs lvfn <$.> foundNodeTraversal+          return (gt, lvfn, lef, ln)+        extractFromSMap smap =+          (,,)+          <$> lookupAsM label_vfn smap +          <*> lookupAsM label_ef smap +          <*> lookupAsM label_target_nid smap ++makeLinkSample :: n -> VFoundNode na -> EFinds la -> n -> LinkSample n la+makeLinkSample subject_nid vfn efinds target_nid = +  LinkSample { lsSubjectNode = subject_nid,+               lsTargetNode = target_nid,+               lsLinkState = efLinkState efinds,+               lsTimestamp = vfnTimestamp vfn,+               lsLinkAttributes = efLinkAttributes efinds+             }++visitNodeForSnapshot :: (ToJSON n, Ord n, Hashable n, FromGraphSON n, Show n, LinkAttributes fla, NodeAttributes na)+                     => Spider n na fla+                     -> Query n na fla sla                      -> IORef (SnapshotState n na fla)                      -> n                      -> IO ()-visitNodeForSnapshot spider ref_state visit_nid = do-  mnode_eid <- getVisitedNodeEID-  case mnode_eid of-   Nothing -> return ()-   Just node_eid -> do-     -- TODO: (2018-09-08) Final VFoundNode is the latest of those in-     -- the query range. however, there should be an option to-     -- traverse ALL "finds" edges in the query range, instead of-     -- those with the latest timestamp. To do that, we may have to-     -- use .as and .select steps to get "finds" edge and both of its-     -- end nodes at once.-     mnext_found <- getNextFoundNode node_eid-     markAsVisited mnext_found-     case mnext_found of-      Nothing -> return ()-      Just next_found -> do-        link_samples <- makeLinkSamples spider visit_nid next_found-        modifyIORef ref_state $ addLinkSamples $ toList link_samples+visitNodeForSnapshot spider query ref_state visit_nid = do+  logDebug spider ("Visiting node " <> spack visit_nid <> " ...")+  cur_state <- readIORef ref_state+  if isAlreadyVisited cur_state visit_nid+    then logAndQuit+    else doVisit   where-    markAsVisited mvfn = modifyIORef ref_state $ addVisitedNode visit_nid mvfn+    logAndQuit = do+      logDebug spider ("Node " <> spack visit_nid <> " is already visited. Skip.")+      return ()+    doVisit = do+      mvisit_eid <- getVisitedNodeEID+      case mvisit_eid of+       Nothing -> do+         logWarn spider ("Node " <> spack visit_nid <> " does not exist.")+         return ()+       Just visit_eid -> do+         (mlatest_vfn, hops) <- traverseEFindsOneHop spider (timeInterval query) visit_eid+         markAsVisited $ mlatest_vfn+         logLatestVFN mlatest_vfn+         let next_hops = filterHops mlatest_vfn $ hops+         -- putStrLn ("-- visit " ++ show visit_nid)+         -- putStrLn ("   latest vfn: " ++ (show $ fmap vfnTimestamp mlatest_vfn))+         -- forM_ next_hops $ \(vfn, _, next_nid) -> do+         --   putStrLn ("   next: " ++ (show $ vfnTimestamp vfn) ++ " -> " ++ show next_nid)+         mapM_ logHop next_hops+         modifyIORef ref_state $ addLinkSamples+           $ map (uncurry3 $ makeLinkSample visit_nid) $ next_hops+         -- cur_state <- readIORef ref_state+         -- putStrLn $ debugShowState cur_state     getVisitedNodeEID = fmap vToMaybe $ Gr.slurpResults =<< submitB spider binder       where         binder = gNodeEID <$.> gHasNodeID spider visit_nid <*.> pure gAllNodes-    getNextFoundNode node_eid = fmap vToMaybe $ Gr.slurpResults =<< submitB spider binder-      where-        binder = gLatestFoundNode-                 <$.> gSelectFoundNode gIdentity -- TODO: select FoundNode to consider-                 <$.> gHasNodeEID node_eid-                 <*.> pure gAllNodes--makeLinkSamples :: (FromGraphSON n, LinkAttributes fla)-                => Spider n na fla-                -> n -- ^ subject node ID.-                -> VFoundNode na-                -> IO (Vector (LinkSample n fla))-makeLinkSamples spider subject_nid vneighbors = do-  finds_edges <- getFinds $ vfnId vneighbors-  traverse toSnapshotLinkEntry finds_edges-  where-    getFinds neighbors_eid = Gr.slurpResults =<< submitB spider binder-      where-        binder = gFinds <$.> gHasFoundNodeEID neighbors_eid <*.> pure gAllFoundNode-    toSnapshotLinkEntry efinds = do-      target_nid <- getNodeID $ efTargetId $ efinds-      let lsample = LinkSample { lsSubjectNode = subject_nid,-                                 lsTargetNode = target_nid,-                                 lsLinkState = efLinkState efinds,-                                 lsTimestamp = vfnTimestamp vneighbors,-                                 lsLinkAttributes = efLinkAttributes efinds-                               }-      return lsample-    getNodeID node_eid = expectOne =<< tryGetNodeID spider node_eid-    -- TODO: Using .as and .select steps, we can get EFinds and its destination vertex simultaneously.-      where-        expectOne (Just r) = return r-        expectOne Nothing = throwString "Expects a Vertex for a NodeID, but nothing found."-        -- TODO: better exception spec.--tryGetNodeID :: FromGraphSON n => Spider n na fla -> EID -> IO (Maybe n)-tryGetNodeID spider node_eid = fmap vToMaybe $ Gr.slurpResults =<< submitB spider binder-  where-    binder = gNodeID spider <$.> gHasNodeEID node_eid <*.> pure gAllNodes+    markAsVisited mvfn = modifyIORef ref_state $ addVisitedNode visit_nid mvfn+    logLatestVFN Nothing = logDebug spider ("No local finding is found for node " <> spack visit_nid)+    logLatestVFN (Just vfn) = logDebug spider ( "Node " <> spack visit_nid+                                                <> ": latest local finding is at "+                                                <> (showEpochTime $ vfnTimestamp vfn)+                                              )+    uncurry3 f (a,b,c) = f a b c+    filterHops mvfn =+      case foundNodePolicy query of+       PolicyOverwrite -> filter (hopHasVFN mvfn)+       PolicyAppend -> id+    hopHasVFN Nothing _ = True+    hopHasVFN (Just vfn1) (vfn2, _, _) = vfnId vfn1 == vfnId vfn2+    logHop (vfn, _, next_nid) = logDebug spider ( "Link " <> spack visit_nid+                                                  <> " -> " <> spack next_nid+                                                  <> " at " <> (showEpochTime $ vfnTimestamp vfn)+                                                )  -- | The state kept while making the snapshot graph. data SnapshotState n na fla =@@ -243,6 +289,19 @@   }   deriving (Show) +-- debugShowState :: Show n => SnapshotState n na fla -> String+-- debugShowState state = unvisited ++ visited_nodes ++ visited_links+--   where+--     unvisited = "unvisitedNodes: "+--                 ++ (intercalate ", " $ map show $ toList $ ssUnvisitedNodes state)+--                 ++ "\n"+--     visited_nodes = "visitedNodes: "+--                     ++ (intercalate ", " $ map (uncurry showVisitedNode) $ HM.toList $ ssVisitedNodes state)+--                     ++ "\n"+--     showVisitedNode nid mvfn = show nid ++ "(" ++ (show $ fmap vfnTimestamp mvfn )  ++  ")"+--     visited_links = "visitedLinks: "+--                     ++ (intercalate ", " $ map show $ HM.keys $ ssVisitedLinks state)+ emptySnapshotState :: (Ord n, Hashable n) => SnapshotState n na fla emptySnapshotState = SnapshotState                      { ssUnvisitedNodes = mempty,@@ -256,6 +315,9 @@ addVisitedNode :: (Eq n, Hashable n) => n -> Maybe (VFoundNode na) -> SnapshotState n na fla -> SnapshotState n na fla addVisitedNode nid mv state = state { ssVisitedNodes = HM.insert nid mv $ ssVisitedNodes state } +isAlreadyVisited :: (Eq n, Hashable n) => SnapshotState n na fla -> n -> Bool+isAlreadyVisited state nid = HM.member nid $ ssVisitedNodes state+ addLinkSample :: (Ord n, Hashable n)               => LinkSample n fla -> SnapshotState n na fla -> SnapshotState n na fla addLinkSample ls state = state { ssVisitedLinks = updatedLinks,@@ -265,7 +327,7 @@     link_id = linkSampleId ls     updatedLinks = HM.insertWith (++) link_id (return ls) $ ssVisitedLinks state     target_nid = lsTargetNode ls-    target_already_visited = HM.member target_nid $ ssVisitedNodes state+    target_already_visited = isAlreadyVisited state target_nid     updatedUnvisited = if target_already_visited                        then ssUnvisitedNodes state                        else pushQueue target_nid $ ssUnvisitedNodes state@@ -280,16 +342,18 @@     updated = state { ssUnvisitedNodes = updatedUnvisited }     (popped, updatedUnvisited) = popQueue $ ssUnvisitedNodes state -makeSnapshot :: (Eq n, Hashable n)+makeSnapshot :: (Eq n, Hashable n, Show n)              => LinkSampleUnifier n na fla sla              -> SnapshotState n na fla-             -> ([SnapshotNode n na], [SnapshotLink n sla])-makeSnapshot unifier state = (nodes, links)+             -> ([SnapshotNode n na], [SnapshotLink n sla], [LogLine])+makeSnapshot unifier state = (nodes, links, logs)   where     nodes = visited_nodes ++ boundary_nodes     visited_nodes = map (makeSnapshotNode state) $ HM.keys $ ssVisitedNodes state     boundary_nodes = map (makeSnapshotNode state) $ toList $ ssUnvisitedNodes state-    links = mconcat $ map (makeSnapshotLinks unifier state) $ HM.elems $ ssVisitedLinks state+    (links, logs) = runWriterLoggingM $ fmap mconcat+                    $ mapM (makeSnapshotLinks unifier state) $ HM.elems $ ssVisitedLinks state+      makeSnapshotNode :: (Eq n, Hashable n) => SnapshotState n na fla -> n -> SnapshotNode n na makeSnapshotNode state nid =@@ -307,17 +371,24 @@ -- | 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)+makeSnapshotLinks :: (Eq n, Hashable n, Show n)                   => LinkSampleUnifier n na fla sla                   -> SnapshotState n na fla                   -> [LinkSample n fla]-                  -> [SnapshotLink n sla]-makeSnapshotLinks _ _ [] = []-makeSnapshotLinks unifier state link_samples@(head_sample : _) =-  mapMaybe makeSnapshotLink $ doUnify link_samples+                  -> WriterLoggingM [SnapshotLink n sla]+makeSnapshotLinks _ _ [] = return []+makeSnapshotLinks unifier state link_samples@(head_sample : _) = do+  unified <- doUnify link_samples+  logUnified unified+  return $ mapMaybe makeSnapshotLink unified   where     makeEndNode getter = makeSnapshotNode state $ getter $ head_sample     doUnify = unifier (makeEndNode lsSubjectNode) (makeEndNode lsTargetNode)+    logUnified unified = logDebugW ( "Unify link [" <> (spack $ lsSubjectNode head_sample) <> "]-["+                                     <> (spack $ lsTargetNode head_sample) <> "]: "+                                     <> "from " <> (spack $ length link_samples) <> " samples "+                                     <> "to " <> (spack $ length unified) <> " samples"+                                   )     makeSnapshotLink unified_sample = do       case lsLinkState unified_sample of        LinkUnused -> Nothing

@@ -4,15 +4,16 @@ -- Description: Configuration of Spider -- Maintainer: Toshio Ito <debug.ito@gmail.com> ----- +-- module NetSpider.Spider.Config-       ( Spider(..),-         Config(..),+       ( Config(..),          defConfig,          Host,-         Port+         Port,+         LogLevel(..)        ) where +import Control.Monad.Logger (LogLevel(..)) import Data.Greskell (Key) import Network.Greskell.WebSocket (Host, Port) @@ -20,24 +21,6 @@  import NetSpider.Graph (VNode) --- | An IO agent of the NetSpider database.------ - Type @n@: node ID. Note that type of node ID has nothing to do---   with type of vertex ID used by Gremlin implementation. Node ID---   (in net-spider) is stored as a vertex property. See 'nodeIdKey'---   config field.--- - Type @na@: node attributes. It should implement---   'NetSpider.Graph.NodeAttributes' class. You can set this to @()@---   if you don't need node attributes.--- - Type @fla@: attributes of found links. It should implement---   'NetSpider.Graph.LinkAttributes' class. You can set this to @()@---   if you don't need link attributes.-data Spider n na fla =-  Spider-  { spiderConfig :: Config n na fla,-    spiderClient :: Gr.Client-  }- -- | Configuration to create a 'Spider' object. data Config n na fla =   Config@@ -47,9 +30,14 @@     wsPort :: Gr.Port,     -- ^ Port of WebSocket endpoint of Tinkerpop Gremlin     -- Server. Default: 8182-    nodeIdKey :: Key VNode n+    nodeIdKey :: Key VNode n,     -- ^ Name of vertex property that stores the node ID. Default:     -- \"@node_id\".+    logThreshold :: LogLevel+    -- ^ Logs with the level higher than or equal to this threshold+    -- are printed. Default: 'LevelWarn'.+    --+    -- @since 0.2.0.0   }  defConfig :: Config n na fla@@ -57,6 +45,8 @@   Config   { wsHost = "localhost",     wsPort = 8182,-    nodeIdKey = "@node_id"+    nodeIdKey = "@node_id",+    logThreshold = LevelWarn   }+ 

@@ -20,8 +20,10 @@          gMakeFoundNode,          gSelectFoundNode,          gLatestFoundNode,+         gFilterFoundNodeByTime,          -- * EFinds-         gFinds+         gFinds,+         gFindsTarget        ) where  import Control.Category ((<<<))@@ -32,13 +34,16 @@   ( WalkType, AEdge,     GTraversal, Filter, Transform, SideEffect, Walk, liftWalk,     Binder, newBind,-    source, sV, sV', sAddV, gHasLabel, gHasId, gHas2, gId, gProperty, gPropertyV, gV,-    gAddE, gSideEffect, gTo, gFrom, gDrop, gOut, gOrder, gBy2, gValues, gOutE,+    source, sV, sV', sAddV, gHasLabel, gHasId, gHas2, gHas2P, gId, gProperty, gPropertyV, gV,+    gNot, gIdentity',+    gAddE, gSideEffect, gTo, gFrom, gDrop, gOut, gOrder, gBy2, gValues, gOutE, gInV,     ($.), (<*.>), (=:),     ToGTraversal,-    Key, oDecr, gLimit+    Key, oDecr, gLimit,+    pGt, pGte, pLt, pLte   ) import Data.Int (Int64)+import Data.Interval (lowerBound', upperBound') import Data.Text (Text, pack) import Data.Time.LocalTime (TimeZone(..)) import Data.Traversable (traverse)@@ -48,8 +53,10 @@     LinkAttributes(..), NodeAttributes(..)   ) import NetSpider.Found (FoundLink(..), LinkState(..), FoundNode(..), linkStateToText)-import NetSpider.Timestamp (Timestamp(..), fromEpochSecond)-import NetSpider.Spider.Config (Spider(..), Config(..))+import NetSpider.Query (Interval, Extended(..))+import NetSpider.Timestamp (Timestamp(..))+import NetSpider.Spider.Config (Config(..))+import NetSpider.Spider.Internal.Spider (Spider(..))  spiderNodeIdKey :: Spider n na fla -> Key VNode n spiderNodeIdKey = nodeIdKey . spiderConfig@@ -150,8 +157,25 @@ gLatestFoundNode :: Walk Transform (VFoundNode na) (VFoundNode na) gLatestFoundNode = gLimit 1 <<< gOrder [gBy2 keyTimestamp oDecr] +gFilterFoundNodeByTime :: Interval Timestamp -> Binder (Walk Filter (VFoundNode na) (VFoundNode na))+gFilterFoundNodeByTime interval = do+  fl <- filterLower+  fh <- filterUpper+  return (fh <<< fl)+  where+    filterLower = case lowerBound' interval of+      (PosInf, _) -> return $ gNot gIdentity'+      (NegInf, _) -> return $ gIdentity'+      (Finite ts, False) -> fmap (gHas2P keyTimestamp) $ fmap pGt  $ newBind $ epochTime ts+      (Finite ts, True)  -> fmap (gHas2P keyTimestamp) $ fmap pGte $ newBind $ epochTime ts+    filterUpper = case upperBound' interval of+      (PosInf, _) -> return $ gIdentity'+      (NegInf, _) -> return $ gNot gIdentity'+      (Finite ts, False) -> fmap (gHas2P keyTimestamp) $ fmap pLt  $ newBind $ epochTime ts+      (Finite ts, True)  -> fmap (gHas2P keyTimestamp) $ fmap pLte $ newBind $ epochTime ts+ gFinds :: Walk Transform (VFoundNode na) (EFinds la) gFinds = gOutE ["finds"] -  -        +gFindsTarget :: Walk Transform (EFinds la) VNode+gFindsTarget = gInV

@@ -0,0 +1,36 @@+-- |+-- Module: NetSpider.Spider.Internal.Log+-- Description: Logging functions related to Spider+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- __this module is internal. End-users should not use it.__+module NetSpider.Spider.Internal.Log+       ( runLogger,+         logLine,+         logDebug,+         logWarn+       ) where++import Control.Monad.Logger (LogLevel, LoggingT)+import qualified Control.Monad.Logger as Log+import Data.Functor.Identity (Identity, runIdentity)+import Data.Text (Text)++import NetSpider.Log (LogLine)+import NetSpider.Spider.Internal.Spider (Spider(..))+import NetSpider.Spider.Config (Config(..))++runLogger :: Spider n na fla -> LoggingT IO a -> IO a+runLogger spider act = Log.runStderrLoggingT $ Log.filterLogger fil act+  where+    fil _ level = level >= (logThreshold $ spiderConfig spider)++logLine :: Spider n na fla -> LogLine -> IO ()+logLine spider (loc, src, level, msg) = runLogger spider $ Log.monadLoggerLog loc src level msg++logDebug :: Spider n na fla -> Text -> IO ()+logDebug spider msg = runLogger spider $ Log.logDebugN msg++logWarn :: Spider n na fla -> Text -> IO ()+logWarn spider msg = runLogger spider $ Log.logWarnN msg+

@@ -0,0 +1,32 @@+-- |+-- Module: NetSpider.Spider.Internal.Spider+-- Description: Spider type and its internal+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- __this module is internal. End-users should not use it.__+module NetSpider.Spider.Internal.Spider+       ( Spider(..)+       ) where++import qualified Network.Greskell.WebSocket as Gr++import NetSpider.Spider.Config (Config)++-- | An IO agent of the NetSpider database.+--+-- - Type @n@: node ID. Note that type of node ID has nothing to do+--   with type of vertex ID used by Gremlin implementation. Node ID+--   (in net-spider) is stored as a vertex property. See 'nodeIdKey'+--   config field.+-- - Type @na@: node attributes. It should implement+--   'NetSpider.Graph.NodeAttributes' class. You can set this to @()@+--   if you don't need node attributes.+-- - Type @fla@: attributes of found links. It should implement+--   'NetSpider.Graph.LinkAttributes' class. You can set this to @()@+--   if you don't need link attributes.+data Spider n na fla =+  Spider+  { spiderConfig :: Config n na fla,+    spiderClient :: Gr.Client+  }+

@@ -5,17 +5,45 @@ -- --  module NetSpider.Timestamp-       ( Timestamp(..),-         fromEpochSecond+       ( -- * The type+         Timestamp(..),+         -- * Construction+         fromEpochMillisecond,+         now,+         -- * Manipulation+         addSec,+         -- * Conversion+         parseTimestamp,+         fromS,+         fromZonedTime,+         fromUTCTime,+         fromSystemTime,+         fromLocalTime,+         showEpochTime        ) where +import Control.Applicative ((<$>), (<*>), (<*), (*>), optional)+import Data.Char (isDigit) import Data.Int (Int64)-import Data.Time.LocalTime (TimeZone)+import Data.List (sortOn)+import Data.Text (Text, pack)+import Data.Time.Calendar (Day, fromGregorian)+import Data.Time.LocalTime+  ( TimeZone(..), getZonedTime, ZonedTime(..), zonedTimeToUTC, LocalTime(LocalTime), localTimeToUTC,+    TimeOfDay(TimeOfDay)+  )+import qualified Data.Time.LocalTime as LocalTime+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.System (utcToSystemTime, SystemTime(..))+import qualified Text.ParserCombinators.ReadP as P+import Text.Read (readEither)  -- | Timestamp when graph elements are observed. data Timestamp =   Timestamp   { epochTime :: !Int64,+    -- ^ Milliseconds since the epoch. The epoch is usually the+    -- beginning of year 1970.     timeZone :: !(Maybe TimeZone)   }   deriving (Show,Eq)@@ -24,7 +52,157 @@ instance Ord Timestamp where   compare l r = compare (epochTime l) (epochTime r) --- | Make 'Timestamp' from seconds from the epoch. 'timeZone' is+-- | Make 'Timestamp' from milliseconds from the epoch. 'timeZone' is -- 'Nothing'.-fromEpochSecond :: Int64 -> Timestamp-fromEpochSecond sec = Timestamp sec Nothing+--+-- @since 0.2.0.0+fromEpochMillisecond :: Int64 -> Timestamp+fromEpochMillisecond msec = Timestamp msec Nothing++-- | Show 'epochTime' of 'Timestamp' as 'Text'.+--+-- @since 0.2.0.0+showEpochTime :: Timestamp -> Text+showEpochTime = pack . show . epochTime++-- | Get the current system time.+--+-- @since 0.2.0.0+now :: IO Timestamp+now = fmap fromZonedTime $ getZonedTime++-- | @since 0.2.0.0+fromZonedTime :: ZonedTime -> Timestamp+fromZonedTime zt =+  (fromUTCTime $ zonedTimeToUTC zt) { timeZone = Just $ zonedTimeZone zt }++-- | @since 0.2.0.0+fromUTCTime :: UTCTime -> Timestamp+fromUTCTime ut = (fromSystemTime $ utcToSystemTime ut) { timeZone = Just LocalTime.utc }++-- | @since 0.2.0.0+fromSystemTime :: SystemTime -> Timestamp+fromSystemTime stime = Timestamp { epochTime = epoch_time,+                                   timeZone = Nothing+                                 }+  where+    epoch_time = (systemSeconds stime * 1000)+                 + fromIntegral (systemNanoseconds stime `div` 1000000)++-- | Covert 'LocalTime' to 'Timestamp' assuming it's in UTC time+-- zone. The 'timeZone' field is 'Nothing'.+--+-- @since 0.2.0.0+fromLocalTime :: LocalTime -> Timestamp+fromLocalTime lt = (fromUTCTime $ localTimeToUTC LocalTime.utc lt) { timeZone = Nothing }++-- | Add time difference (in seconds) to the 'Timestamp'.+--+-- @since 0.2.0.0+addSec :: Int64 -> Timestamp -> Timestamp+addSec diff ts = ts { epochTime = (+ (diff * 1000)) $ epochTime ts }++-- | Unsafe version of 'parseTimestamp'.+--+-- @since 0.2.0.0+fromS :: String -> Timestamp+fromS s = maybe (error msg) id $ parseTimestamp s+  where+    msg = "Fail to parse " ++ s++-- | Parse a string into 'Timestamp'. The format is like ISO8601 with+-- a little relaxation.+--+-- >>> let timeAndOffset ts = (epochTime ts, fmap timeZoneMinutes $ timeZone ts)+-- >>> fmap timeAndOffset $ parseTimestamp "2018-10-11T11:20:10"+-- Just (1539256810000,Nothing)+-- >>> fmap timeAndOffset $ parseTimestamp "2018-10-11 11:20:10"+-- Just (1539256810000,Nothing)+-- >>> fmap timeAndOffset $ parseTimestamp "2015-03-23 03:33Z"+-- Just (1427081580000,Just 0)+-- >>> fmap timeAndOffset $ parseTimestamp "1999-01-05 20:34:44.211+09:00"+-- Just (915536084211,Just 540)+-- >>> fmap timeAndOffset $ parseTimestamp "2007/08/20T22:25-07:00"+-- Just (1187673900000,Just (-420))+--+-- @since 0.2.0.0+parseTimestamp :: String -> Maybe Timestamp+parseTimestamp s = toTs $ sortByLeftover $ P.readP_to_S parserTimestamp s+  where+    sortByLeftover = sortOn $ \(_, leftover) -> length leftover+    toTs ((ret, _) : _) = Just ret+    toTs [] = Nothing++parserTimestamp :: P.ReadP Timestamp+parserTimestamp = do+  day <- parserDay <* delim+  time <- parserTime+  mtz <- optional (parserUTC P.+++ parserOffset)+  let ltime = LocalTime day time+  case mtz of+   Nothing -> return $ fromLocalTime ltime+   Just tz -> return $ fromZonedTime $ ZonedTime ltime tz+  where+    delim = P.choice $ map P.char " T"++parserRead :: Read a => String -> P.ReadP a+parserRead input = either fail return $ readEither input++parserDec :: Read a => P.ReadP a+parserDec = parserRead =<< P.munch1 isDigit++parserFracDec :: Read a => P.ReadP a+parserFracDec = do+  int <- P.munch1 isDigit+  frac <- fmap (maybe "" id) $ optional ((:) <$> P.char '.' <*> P.munch1 isDigit)+  return $ read (int ++ frac)++parserDay :: P.ReadP Day+parserDay = fromGregorian+            <$> (parserDec <* delim)+            <*> (parserDec <* delim)+            <*> parserDec+  where+    delim = P.choice $ map P.char "-/"++parserTime :: P.ReadP TimeOfDay+parserTime = TimeOfDay+             <$> parserDec+             <*> (delim *> parserDec)+             <*> ((delim *> parserFracDec) P.<++ pure 0)+  where+    delim = P.char ':'+++parserUTC :: P.ReadP TimeZone+parserUTC = do+  s <- P.get+  case s of+   'Z' -> return LocalTime.utc+   c -> fail ("Not a UTC symbol: " ++ show c)++data OffsetSign = OffsetPlus+                | OffsetMinus+                deriving (Show,Eq,Ord,Enum,Bounded)++parserOffset :: P.ReadP TimeZone+parserOffset = offsetToTz <$> osign <*> (parserDec <* delim) <*> parserDec+  where+    osign = do+      s <- P.get+      case s of+       '+' -> return OffsetPlus+       '-' -> return OffsetMinus+       c -> fail ("Not a sign symbol: " ++ show c)+    delim = optional $ P.char ':'++offsetToTz :: OffsetSign -> Int -> Int -> TimeZone+offsetToTz osign h m = TimeZone { timeZoneMinutes = intsign * (h * 60 + m),+                                  timeZoneSummerOnly = False,+                                  timeZoneName = ""+                                }+  where+    intsign = case osign of+      OffsetPlus -> 1+      OffsetMinus -> -1+

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | -- Module: NetSpider.Unify -- Description: LinkSampleUnifier type@@ -21,13 +22,16 @@          defNegatesLinkSample        ) where +import Control.Monad (mapM) import Data.Foldable (maximumBy) import Data.Function (on) import Data.Hashable (Hashable(hashWithSalt))-import Data.Maybe (mapMaybe)+import Data.Maybe (catMaybes)+import Data.Monoid ((<>)) import GHC.Exts (groupWith)  import NetSpider.Found (FoundLink, LinkState)+import NetSpider.Log (WriterLoggingM, logDebugW, spack) import NetSpider.Pair (Pair(..)) import NetSpider.Snapshot (SnapshotNode, nodeTimestamp, nodeId, SnapshotLink) import NetSpider.Timestamp (Timestamp)@@ -86,18 +90,18 @@ --   obtained from both of the end nodes to make the link attributes --   of 'SnapshotLink'. This function is supposed to convert the link --   attribute type.-type LinkSampleUnifier n na fla sla = SnapshotNode n na -> SnapshotNode n na -> [LinkSample n fla] -> [LinkSample n sla]+type LinkSampleUnifier n na fla sla = SnapshotNode n na -> SnapshotNode n na -> [LinkSample n fla] -> WriterLoggingM [LinkSample n sla]  -- | Unify 'LinkSample's to one. This is the sensible unifier if there -- is at most one physical link for a given pair of nodes.-unifyToOne :: Eq n => LinkSampleUnifier n na la la+unifyToOne :: (Eq n, Show n) => LinkSampleUnifier n na la la unifyToOne = unifyStd defUnifyStdConfig  -- | Unify 'LinkSample's to possibly multiple samples. The input -- samples are partitioned to groups based on the link sub-ID, defined -- by the given getter function. Each group represents one of the -- final samples.-unifyToMany :: (Eq n, Ord lsid)+unifyToMany :: (Eq n, Show n, Ord lsid)             => (LinkSample n fla -> lsid) -- ^ Getter of the link sub-ID             -> LinkSampleUnifier n na fla fla unifyToMany getKey = unifyStd conf@@ -147,16 +151,31 @@ -- 3. After merge, the link is checked against its end nodes. If --    'negatesLinkSample' returns 'True' for either of the end nodes, --    the link is removed from the final result.-unifyStd :: (Eq n, Ord lsid) => UnifyStdConfig n na fla sla lsid -> LinkSampleUnifier n na fla sla-unifyStd conf lnode rnode = mapMaybe forGroup . groupWith (makeLinkSubId conf)+unifyStd :: (Eq n, Show n, Ord lsid) => UnifyStdConfig n na fla sla lsid -> LinkSampleUnifier n na fla sla+unifyStd conf lnode rnode input_samples = do+  let groups = groupWith (makeLinkSubId conf) input_samples+  logDebug ( "Group " <> (spack $ length input_samples) <> " samples into "+             <> (spack $ length groups) <> " groups by link sub-ID."+           )+  fmap catMaybes $ mapM forGroup $ zip groups ([0 ..] :: [Int])   where-    forGroup samples = maybeNegates rnode-                       =<< maybeNegates lnode-                       =<< mergeSamples conf (samplesFor samples lnode) (samplesFor samples rnode)+    logDebug msg = logDebugW ("unifyStd: " <> msg)     samplesFor samples sn = filter (\s -> nodeId sn == (lsSubjectNode s)) samples-    maybeNegates sn sample = if negatesLinkSample conf sn sample-                             then Nothing-                             else Just sample+    forGroup (samples, group_i) = +      case mergeSamples conf (samplesFor samples lnode) (samplesFor samples rnode) of+       Nothing -> do+         logDebugG ("No link after mergeSamples")+         return Nothing+       ml -> maybeNegates rnode =<< maybeNegates lnode ml+      where+        logDebugG msg = logDebug ("group " <> spack group_i <> ": "  <> msg)+        maybeNegates _ Nothing = return Nothing+        maybeNegates sn (Just sample) =+          if negatesLinkSample conf sn sample+          then do+            logDebugG ("Merged sample is negated by node " <> (spack $ nodeId sn))+            return Nothing+          else return $ Just sample  -- | Get the 'LinkSample' that has the latest (biggest) timestamp. latestLinkSample :: [LinkSample n la] -> Maybe (LinkSample n la)

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF doctest-discover #-}

@@ -25,7 +25,7 @@ import NetSpider.Spider.Config (Host, Port, Config(..), defConfig) import NetSpider.Snapshot (nodeTimestamp, linkTimestamp) import qualified NetSpider.Snapshot as S (nodeAttributes, linkAttributes)-import NetSpider.Timestamp (Timestamp(..), fromEpochSecond)+import NetSpider.Timestamp (Timestamp(..), fromS)  main :: IO () main = hspec spec@@ -42,7 +42,7 @@ typeTestCase test_label conf n1_id n2_id node_attrs link_attrs =   specify test_label $ withSpider' conf $ \spider -> do     let n1 = FoundNode { subjectNode = n1_id,-                         foundAt = fromEpochSecond 128,+                         foundAt = fromS "2018-10-11T11:00:00",                          neighborLinks = return link1,                          nodeAttributes = node_attrs                        }

@@ -26,10 +26,10 @@ import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..), VNode) import NetSpider.Pair (Pair(..)) import NetSpider.Spider.Config-  ( Host, Port, Spider, Config(..), defConfig+  ( Host, Port, Config(..), defConfig, LogLevel(..)   ) import NetSpider.Spider-  ( connectWith, close, clearAll+  ( connectWith, close, clearAll, Spider   ) import NetSpider.Snapshot   ( SnapshotNode, SnapshotLink@@ -42,7 +42,7 @@ withServer = before $ needEnvHostPort Need "NET_SPIDER_TEST"  withSpider :: Eq n => (Spider n na fla -> IO ()) -> (Host, Port) -> IO ()-withSpider = withSpider' defConfig+withSpider = withSpider' $ defConfig { logThreshold = LevelWarn }  withSpider' :: Config n na fla -> (Spider n na fla -> IO ()) -> (Host, Port) -> IO () withSpider' orig_conf action (host, port) = bracket (connectWith conf) close $ \spider -> do

@@ -6,6 +6,7 @@ import Data.Aeson (Value(..)) import qualified Data.HashMap.Strict as HM import Data.List (sortOn, sort)+import Data.Maybe (isNothing) import Data.Monoid ((<>), mempty) import Data.Text (Text, unpack, pack) import qualified Data.Text.IO as TIO@@ -25,7 +26,10 @@ import NetSpider.Found   ( FoundLink(..), LinkState(..), FoundNode(..)   )-import NetSpider.Query (Query, defQuery, startsFrom, unifyLinkSamples)+import NetSpider.Query+  ( Query, defQuery, startsFrom, unifyLinkSamples, timeInterval, foundNodePolicy,+    Extended(..), (<..<), (<..<=), (<=..<=), policyOverwrite, policyAppend+  ) import NetSpider.Snapshot   ( SnapshotLink,     nodeId, linkNodeTuple, isDirected, linkTimestamp,@@ -36,8 +40,12 @@   ( Spider, addFoundNode, getSnapshotSimple, getSnapshot   ) import NetSpider.Spider.Config (defConfig, Config, Host, Port)-import NetSpider.Unify (unifyStd, UnifyStdConfig(..), defUnifyStdConfig, lsLinkAttributes, latestLinkSample)-import NetSpider.Timestamp (fromEpochSecond)+import NetSpider.Unify+  ( unifyStd, UnifyStdConfig(..), defUnifyStdConfig,+    lsLinkAttributes, lsSubjectNode,+    latestLinkSample+  )+import NetSpider.Timestamp (fromS, fromEpochMillisecond)  main :: IO () main = hspec spec@@ -53,7 +61,7 @@                          linkAttributes = ()                        }       nbs = FoundNode { subjectNode = "n1",-                        foundAt = fromEpochSecond 100,+                        foundAt = fromS "2018-12-01T10:00",                         neighborLinks = return link,                         nodeAttributes = ()                       }@@ -76,6 +84,8 @@ spec_getSnapshot = withServer $ describe "getSnapshotSimple, getSnapshot" $ do   spec_getSnapshot1   spec_getSnapshot2+  spec_getSnapshot_timeInterval+  spec_getSnapshot_foundNodePolicy   spec_getSnapshot1 :: SpecWith (Host,Port)@@ -88,7 +98,7 @@           _ -> error ("Unexpected result: got = " ++ show (got_ns, got_ls))     nodeId got_n1 `shouldBe` "n1"     isOnBoundary got_n1 `shouldBe` False-    nodeTimestamp got_n1 `shouldBe` Just (fromEpochSecond 100)+    nodeTimestamp got_n1 `shouldBe` Just (fromS "2018-12-01T10:00")     S.nodeAttributes got_n1 `shouldBe` Just ()     nodeId got_n2 `shouldBe` "n2"     isOnBoundary got_n2 `shouldBe` False@@ -96,12 +106,12 @@     S.nodeAttributes got_n2 `shouldBe` Nothing -- n1 is not observed.     linkNodeTuple got_link `shouldBe` ("n1", "n2")     isDirected got_link `shouldBe` True-    linkTimestamp got_link `shouldBe` fromEpochSecond 100+    linkTimestamp got_link `shouldBe` fromS "2018-12-01T10:00"     S.linkAttributes got_link `shouldBe` ()   specify "no neighbor" $ withSpider $ \spider -> do     let nbs :: FoundNode Text () ()         nbs = FoundNode { subjectNode = "n1",-                          foundAt = fromEpochSecond 200,+                          foundAt = fromS "2018-12-01T20:00",                           neighborLinks = mempty,                           nodeAttributes = ()                         }@@ -112,7 +122,7 @@           _ -> error ("Unexpected result: got = " ++ show (got_ns, got_ls))     nodeId got_n1 `shouldBe` "n1"     isOnBoundary got_n1 `shouldBe` False-    nodeTimestamp got_n1 `shouldBe` Just (fromEpochSecond 200)+    nodeTimestamp got_n1 `shouldBe` Just (fromS "2018-12-01T20:00")     S.nodeAttributes got_n1 `shouldBe` Just ()   specify "missing starting node" $ withSpider $ \spider -> do     makeOneNeighborExample spider@@ -130,12 +140,12 @@                               linkAttributes = ()                             }         nbs1 = FoundNode { subjectNode = "n1",-                           foundAt = fromEpochSecond 100,+                           foundAt = fromS "2018-12-01T10:00",                            neighborLinks = return link_12,                            nodeAttributes = ()                          }         nbs2 = FoundNode { subjectNode = "n2",-                           foundAt = fromEpochSecond 200,+                           foundAt = fromS "2018-12-01T20:00",                            neighborLinks = return link_21,                            nodeAttributes = ()                          }@@ -146,21 +156,21 @@           _ -> error ("Unexpected result: got = " ++ show (got_ns, got_ls))     nodeId got_n1 `shouldBe` "n1"     isOnBoundary got_n1 `shouldBe` False-    nodeTimestamp got_n1 `shouldBe` Just (fromEpochSecond 100)+    nodeTimestamp got_n1 `shouldBe` Just (fromS "2018-12-01T10:00")     S.nodeAttributes got_n1 `shouldBe` Just ()     nodeId got_n2 `shouldBe` "n2"     isOnBoundary got_n2 `shouldBe` False-    nodeTimestamp got_n2 `shouldBe` Just (fromEpochSecond 200)+    nodeTimestamp got_n2 `shouldBe` Just (fromS "2018-12-01T20:00")     S.nodeAttributes got_n2 `shouldBe` Just ()     linkNodeTuple got_l `shouldBe` ("n2", "n1")     isDirected got_l `shouldBe` True-    linkTimestamp got_l `shouldBe` fromEpochSecond 200+    linkTimestamp got_l `shouldBe` fromS "2018-12-01T20:00"     S.linkAttributes got_l `shouldBe` ()   specify "multiple findings for a single node" $ withSpider $ \spider -> do     let fns :: [FoundNode Text AText ()]         fns = [ FoundNode                 { subjectNode = "n1",-                  foundAt = fromEpochSecond 200,+                  foundAt = fromS "2018-12-01T20:00",                   neighborLinks = [ FoundLink                                     { targetNode = "n2",                                       linkState = LinkToTarget,@@ -172,23 +182,23 @@                                       linkAttributes = ()                                     }                                   ],-                  nodeAttributes = AText "at 200"+                  nodeAttributes = AText "at 20:00"                 },                 FoundNode                 { subjectNode = "n1",-                  foundAt = fromEpochSecond 100,+                  foundAt = fromS "2018-12-01T10:00",                   neighborLinks = mempty,-                  nodeAttributes = AText "at 100"+                  nodeAttributes = AText "at 10:00"                 },                 FoundNode                 { subjectNode = "n1",-                  foundAt = fromEpochSecond 150,+                  foundAt = fromS "2018-12-01T15:00",                   neighborLinks = return $ FoundLink                                   { targetNode = "n2",                                     linkState = LinkToTarget,                                     linkAttributes = ()                                   },-                  nodeAttributes = AText "at 150"+                  nodeAttributes = AText "at 15:00"                 }               ]     mapM_ (addFoundNode spider) fns@@ -198,8 +208,8 @@           _ -> error ("Unexpected patter: got = " ++ show (got_ns, got_ls))     nodeId got_n1 `shouldBe` "n1"     isOnBoundary got_n1 `shouldBe` False-    nodeTimestamp got_n1 `shouldBe` Just (fromEpochSecond 200)-    S.nodeAttributes got_n1 `shouldBe` Just (AText "at 200")+    nodeTimestamp got_n1 `shouldBe` Just (fromS "2018-12-01T20:00")+    S.nodeAttributes got_n1 `shouldBe` Just (AText "at 20:00")     nodeId got_n2 `shouldBe` "n2"     isOnBoundary got_n2 `shouldBe` False     nodeTimestamp got_n2 `shouldBe` Nothing@@ -210,15 +220,15 @@     S.nodeAttributes got_n3 `shouldBe` Nothing     linkNodeTuple got_l12 `shouldBe` ("n1", "n2")     isDirected got_l12 `shouldBe` True-    linkTimestamp got_l12 `shouldBe` fromEpochSecond 200+    linkTimestamp got_l12 `shouldBe` fromS "2018-12-01T20:00"     linkNodeTuple got_l31 `shouldBe` ("n3", "n1")     isDirected got_l31 `shouldBe` True-    linkTimestamp got_l31 `shouldBe` fromEpochSecond 200+    linkTimestamp got_l31 `shouldBe` fromS "2018-12-01T20:00"   specify "multi-hop neighbors" $ withSpider $ \spider -> do     let fns :: [FoundNode Text () AText]         fns = [ FoundNode                 { subjectNode = intToNodeId 1,-                  foundAt = fromEpochSecond 100,+                  foundAt = fromS "2018-12-01T10:00",                   neighborLinks = return $ FoundLink                                   { targetNode = intToNodeId 2,                                     linkState = LinkToTarget,@@ -226,12 +236,12 @@                                   },                   nodeAttributes = ()                 },-                middleNode 2 $ fromEpochSecond 50,-                middleNode 3 $ fromEpochSecond 150,-                middleNode 4 $ fromEpochSecond 200,+                middleNode 2 $ fromS "2018-12-01T05:00",+                middleNode 3 $ fromS "2018-12-01T15:00",+                middleNode 4 $ fromS "2018-12-01T20:00",                 FoundNode                 { subjectNode = intToNodeId 5,-                  foundAt = fromEpochSecond 150,+                  foundAt = fromS "2018-12-01T15:00",                   neighborLinks = return $ FoundLink                                   { targetNode = intToNodeId 4,                                     linkState = LinkToSubject,@@ -265,40 +275,40 @@     (got_ns, got_ls) <- fmap sortSnapshotElements $ getSnapshotSimple spider "n1"     nodeId (got_ns ! 0) `shouldBe` "n1"     isOnBoundary (got_ns ! 0) `shouldBe` False-    nodeTimestamp (got_ns ! 0) `shouldBe` Just (fromEpochSecond 100)+    nodeTimestamp (got_ns ! 0) `shouldBe` Just (fromS "2018-12-01T10:00")     S.nodeAttributes (got_ns ! 0) `shouldBe` Just ()     nodeId (got_ns ! 1) `shouldBe` "n2"     isOnBoundary (got_ns ! 1) `shouldBe` False-    nodeTimestamp (got_ns ! 1) `shouldBe` Just (fromEpochSecond 50)+    nodeTimestamp (got_ns ! 1) `shouldBe` Just (fromS "2018-12-01T05:00")     S.nodeAttributes (got_ns ! 1) `shouldBe` Just ()     nodeId (got_ns ! 2) `shouldBe` "n3"     isOnBoundary (got_ns ! 2) `shouldBe` False-    nodeTimestamp (got_ns ! 2) `shouldBe` Just (fromEpochSecond 150)+    nodeTimestamp (got_ns ! 2) `shouldBe` Just (fromS "2018-12-01T15:00")     S.nodeAttributes (got_ns ! 2) `shouldBe` Just ()     nodeId (got_ns ! 3) `shouldBe` "n4"     isOnBoundary (got_ns ! 3) `shouldBe` False-    nodeTimestamp (got_ns ! 3) `shouldBe` Just (fromEpochSecond 200)+    nodeTimestamp (got_ns ! 3) `shouldBe` Just (fromS "2018-12-01T20:00")     S.nodeAttributes (got_ns ! 3) `shouldBe` Just ()     nodeId (got_ns ! 4) `shouldBe` "n5"     isOnBoundary (got_ns ! 4) `shouldBe` False-    nodeTimestamp (got_ns ! 4) `shouldBe` Just (fromEpochSecond 150)+    nodeTimestamp (got_ns ! 4) `shouldBe` Just (fromS "2018-12-01T15:00")     S.nodeAttributes (got_ns ! 4) `shouldBe` Just ()     V.length got_ns `shouldBe` 5     linkNodeTuple (got_ls ! 0) `shouldBe` ("n1", "n2")     isDirected (got_ls ! 0) `shouldBe` True-    linkTimestamp (got_ls ! 0) `shouldBe` fromEpochSecond 100+    linkTimestamp (got_ls ! 0) `shouldBe` fromS "2018-12-01T10:00"     S.linkAttributes (got_ls ! 0) `shouldBe` AText "first"     linkNodeTuple (got_ls ! 1) `shouldBe` ("n2", "n3")     isDirected (got_ls ! 1) `shouldBe` True-    linkTimestamp (got_ls ! 1) `shouldBe` fromEpochSecond 150+    linkTimestamp (got_ls ! 1) `shouldBe` fromS "2018-12-01T15:00"     S.linkAttributes (got_ls ! 1) `shouldBe` AText "n3 to prev"     linkNodeTuple (got_ls ! 2) `shouldBe` ("n3", "n4")     isDirected (got_ls ! 2) `shouldBe` True-    linkTimestamp (got_ls ! 2) `shouldBe` fromEpochSecond 200+    linkTimestamp (got_ls ! 2) `shouldBe` fromS "2018-12-01T20:00"     S.linkAttributes (got_ls ! 2) `shouldBe` AText "n4 to prev"     linkNodeTuple (got_ls ! 3) `shouldBe` ("n4", "n5")     isDirected (got_ls ! 3) `shouldBe` True-    linkTimestamp (got_ls ! 3) `shouldBe` fromEpochSecond 200+    linkTimestamp (got_ls ! 3) `shouldBe` fromS "2018-12-01T20:00"     S.linkAttributes (got_ls ! 3) `shouldBe` AText "n4 to next"     V.length got_ls `shouldBe` 4 @@ -308,7 +318,7 @@     let fns :: [FoundNode Text () ()]         fns = [ FoundNode                 { subjectNode = "n1",-                  foundAt = fromEpochSecond 100,+                  foundAt = fromS "2018-12-01T10:00",                   neighborLinks = [ FoundLink                                     { targetNode = "n2",                                       linkState = LinkToTarget,@@ -319,7 +329,7 @@                 },                 FoundNode                 { subjectNode = "n2",-                  foundAt = fromEpochSecond 150,+                  foundAt = fromS "2018-12-01T15:00",                   neighborLinks = [ FoundLink                                     { targetNode = "n1",                                       linkState = LinkToSubject,@@ -335,7 +345,7 @@                 },                 FoundNode                 { subjectNode = "n3",-                  foundAt = fromEpochSecond 100,+                  foundAt = fromS "2018-12-01T10:00",                   neighborLinks = [ FoundLink                                     { targetNode = "n1",                                       linkState = LinkToTarget,@@ -354,28 +364,28 @@     (got_ns, got_ls) <- fmap sortSnapshotElements $ getSnapshotSimple spider "n1"     nodeId (got_ns ! 0) `shouldBe` "n1"     isOnBoundary (got_ns ! 0) `shouldBe` False-    nodeTimestamp (got_ns ! 0) `shouldBe` Just (fromEpochSecond 100)+    nodeTimestamp (got_ns ! 0) `shouldBe` Just (fromS "2018-12-01T10:00")     nodeId (got_ns ! 1) `shouldBe` "n2"     isOnBoundary (got_ns ! 1) `shouldBe` False-    nodeTimestamp (got_ns ! 1) `shouldBe` Just (fromEpochSecond 150)+    nodeTimestamp (got_ns ! 1) `shouldBe` Just (fromS "2018-12-01T15:00")     nodeId (got_ns ! 2) `shouldBe` "n3"     isOnBoundary (got_ns ! 2) `shouldBe` False-    nodeTimestamp (got_ns ! 2) `shouldBe` Just (fromEpochSecond 100)+    nodeTimestamp (got_ns ! 2) `shouldBe` Just (fromS "2018-12-01T10:00")     V.length got_ns `shouldBe` 3     linkNodeTuple (got_ls ! 0) `shouldBe` ("n1", "n2")     isDirected (got_ls ! 0) `shouldBe` True-    linkTimestamp (got_ls ! 0) `shouldBe` fromEpochSecond 150+    linkTimestamp (got_ls ! 0) `shouldBe` fromS "2018-12-01T15:00"     linkNodeTuple (got_ls ! 1) `shouldBe` ("n2", "n3")     isDirected (got_ls ! 1) `shouldBe` False-    linkTimestamp (got_ls ! 1) `shouldBe` fromEpochSecond 150+    linkTimestamp (got_ls ! 1) `shouldBe` fromS "2018-12-01T15:00"     linkNodeTuple (got_ls ! 2) `shouldBe` ("n3", "n1")     isDirected (got_ls ! 2) `shouldBe` True-    linkTimestamp (got_ls ! 2) `shouldBe` fromEpochSecond 100+    linkTimestamp (got_ls ! 2) `shouldBe` fromS "2018-12-01T10:00"   specify "multiple links between two nodes" $ withSpider $ \spider -> do     let fns :: [FoundNode Text () APorts]         fns = [ FoundNode                 { subjectNode = "n1",-                  foundAt = fromEpochSecond 200,+                  foundAt = fromS "2018-12-01T20:00",                   nodeAttributes = (),                   neighborLinks = [ FoundLink                                     { targetNode = "n2",@@ -396,7 +406,7 @@                 },                 FoundNode                 { subjectNode = "n2",-                  foundAt = fromEpochSecond 100,+                  foundAt = fromS "2018-12-01T10:00",                   nodeAttributes = (),                   neighborLinks = [ FoundLink                                     { targetNode = "n1",@@ -424,19 +434,19 @@     let got_ls = sortLinksWithAttr got_ls_raw     linkNodeTuple (got_ls ! 0) `shouldBe` ("n1", "n2")     S.linkAttributes (got_ls ! 0) `shouldBe` APorts "p3" "p6"-    linkTimestamp (got_ls ! 0) `shouldBe` fromEpochSecond 200+    linkTimestamp (got_ls ! 0) `shouldBe` fromS "2018-12-01T20:00"     linkNodeTuple (got_ls ! 1) `shouldBe` ("n1", "n2")     S.linkAttributes (got_ls ! 1) `shouldBe` APorts "p4" "p8"-    linkTimestamp (got_ls ! 1) `shouldBe` fromEpochSecond 200+    linkTimestamp (got_ls ! 1) `shouldBe` fromS "2018-12-01T20:00"     linkNodeTuple (got_ls ! 2) `shouldBe` ("n1", "n2")     S.linkAttributes (got_ls ! 2) `shouldBe` APorts "p5" "p10"-    linkTimestamp (got_ls ! 2) `shouldBe` fromEpochSecond 200+    linkTimestamp (got_ls ! 2) `shouldBe` fromS "2018-12-01T20:00"     V.length got_ls `shouldBe` 3   specify "link disappears" $ withSpider $ \spider -> do     let fns :: [FoundNode Text () ()]         fns = [ FoundNode                 { subjectNode = "n1",-                  foundAt = fromEpochSecond 100,+                  foundAt = fromS "2018-12-01T10:00",                   nodeAttributes = (),                   neighborLinks = [ FoundLink                                     { targetNode = "n2",@@ -447,7 +457,7 @@                 },                 FoundNode                 { subjectNode = "n2",-                  foundAt = fromEpochSecond 200,+                  foundAt = fromS "2018-12-01T20:00",                   nodeAttributes = (),                   neighborLinks = []                 }@@ -464,7 +474,7 @@     let fns :: [FoundNode Text () ()]         fns = [ FoundNode                 { subjectNode = "n1",-                  foundAt = fromEpochSecond 200,+                  foundAt = fromS "2018-12-01T20:00",                   nodeAttributes = (),                   neighborLinks = [ FoundLink                                     { targetNode = "n2",@@ -475,7 +485,7 @@                 },                 FoundNode                 { subjectNode = "n2",-                  foundAt = fromEpochSecond 100,+                  foundAt = fromS "2018-12-01T10:00",                   nodeAttributes = (),                   neighborLinks = []                 }@@ -487,7 +497,7 @@     V.length got_ns `shouldBe` 2     linkNodeTuple (got_ls ! 0) `shouldBe` ("n1", "n2")     isDirected (got_ls ! 0) `shouldBe` False-    linkTimestamp (got_ls ! 0) `shouldBe` fromEpochSecond 200+    linkTimestamp (got_ls ! 0) `shouldBe` fromS "2018-12-01T20:00"     V.length got_ls `shouldBe` 1     -- the n2 observes at t=100 that there is no link to n1, but n1     -- observes there is a link at t=200.  Spider should consider the@@ -496,13 +506,13 @@     let fns :: [FoundNode Text () APorts]         fns = [ FoundNode                 { subjectNode = "n2",-                  foundAt = fromEpochSecond 200,+                  foundAt = fromS "2018-12-01T20:00",                   nodeAttributes = (),                   neighborLinks = links2                 },                 FoundNode                 { subjectNode = "n1",-                  foundAt = fromEpochSecond 100,+                  foundAt = fromS "2018-12-01T10:00",                   nodeAttributes = (),                   neighborLinks = links1                 }@@ -532,17 +542,17 @@     mapM_ (addFoundNode spider) fns     (got_ns, got_ls_raw) <- fmap sortSnapshotElements $ getSnapshot spider $ queryWithAPorts "n1"     nodeId (got_ns ! 0) `shouldBe` "n1"-    nodeTimestamp (got_ns ! 0) `shouldBe` (Just $ fromEpochSecond 100)+    nodeTimestamp (got_ns ! 0) `shouldBe` (Just $ fromS "2018-12-01T10:00")     nodeId (got_ns ! 1) `shouldBe` "n2"-    nodeTimestamp (got_ns ! 1) `shouldBe` (Just $ fromEpochSecond 200)+    nodeTimestamp (got_ns ! 1) `shouldBe` (Just $ fromS "2018-12-01T20:00")     V.length got_ns `shouldBe` 2     let got_ls = sortLinksWithAttr got_ls_raw     linkNodeTuple (got_ls ! 0) `shouldBe` ("n1", "n2")     S.linkAttributes (got_ls ! 0) `shouldBe` APorts "p12" "p22"-    linkTimestamp (got_ls ! 0) `shouldBe` fromEpochSecond 200+    linkTimestamp (got_ls ! 0) `shouldBe` fromS "2018-12-01T20:00"     linkNodeTuple (got_ls ! 1) `shouldBe` ("n1", "n2") -- TODO: looks like this link is removed. why?     S.linkAttributes (got_ls ! 1) `shouldBe` APorts "p13" "p23"-    linkTimestamp (got_ls ! 1) `shouldBe` fromEpochSecond 200+    linkTimestamp (got_ls ! 1) `shouldBe` fromS "2018-12-01T20:00"     V.length got_ls `shouldBe` 2  @@ -571,3 +581,176 @@     justValue (k, Just v) = [(k, v)]     justValue (_, Nothing) = []     showKeyValue (key, val) = TIO.hPutStrLn stderr (key <> ": " <> val)++sort2 :: (Ord a, Ord b) => ([a], [b]) -> ([a], [b])+sort2 (a, b) = (sort a, sort b)++spec_getSnapshot_timeInterval :: SpecWith (Host,Port)+spec_getSnapshot_timeInterval = do+  let linkTo n = FoundLink+                 { targetNode = n,+                   linkState = LinkToTarget,+                   linkAttributes = ()+                 }+      linksTo ns = map linkTo ns+      node n t ls = FoundNode+                    { subjectNode = n,+                      foundAt = fromS ("2018-12-01T01:" <> t),+                      neighborLinks = ls,+                      nodeAttributes = ()+                    }+      input_fns :: [FoundNode Text () ()]+      input_fns = [ node "n1" "10" $ linksTo ["n2"],+                    node "n1" "20" $ linksTo ["n2", "n3"],+                    node "n1" "30" $ linksTo [],+                    node "n1" "40" $ linksTo ["n3"],+                    node "n2" "15" $ linksTo [],+                    node "n2" "25" $ linksTo ["n4"],+                    node "n2" "35" $ linksTo ["n4", "n3", "n5"],+                    node "n3" "10" $ linksTo ["n4", "n2"],+                    node "n3" "30" $ linksTo ["n4"],+                    node "n4" "05" $ linksTo [],+                    node "n4" "15" $ linksTo ["n1"],+                    node "n4" "25" $ linksTo ["n1", "n5"],+                    node "n4" "35" $ linksTo []+                  ]+      simple_unifier = unifyStd $ defUnifyStdConfig { negatesLinkSample = \_ _ -> False }+                       -- Disable negation to simplify the test.+  specify "only lower bound" $ withSpider $ \spider -> do+    mapM_ (addFoundNode spider) input_fns+    let q = (defQuery ["n1", "n2"]) { unifyLinkSamples = simple_unifier,+                                      timeInterval = (Finite $ fromS "2018-12-01T01:30") <..< PosInf+                                    }+    (got_nodes, got_edges) <- fmap sort2 $ getSnapshot spider q+    map nodeId got_nodes `shouldBe` ["n1", "n2", "n3", "n4", "n5"]+    map (isNothing . S.nodeAttributes) got_nodes `shouldBe` [False, False, True, False, True]+    map linkNodeTuple got_edges `shouldBe`+      [ ("n1", "n3"),+        ("n2", "n3"),+        ("n2", "n4"),+        ("n2", "n5")+      ]+    map linkTimestamp got_edges `shouldBe`+      map (\m -> fromS ("2018-12-01T01:" <> m)) ["40", "35", "35", "35"]+  specify "only upper bound (exclusive)" $ withSpider $ \spider -> do+    mapM_ (addFoundNode spider) input_fns+    let q = (defQuery ["n1"]) { unifyLinkSamples = simple_unifier,+                                timeInterval = NegInf+                                               <..< (Finite $ fromS "2018-12-01T01:30")+                              }+    (got_nodes, got_edges) <- fmap sort2 $ getSnapshot spider q+    map nodeId got_nodes `shouldBe` ["n1", "n2", "n3", "n4", "n5"]+    map (isNothing . S.nodeAttributes) got_nodes `shouldBe` [False, False, False, False, True]+    map linkNodeTuple got_edges `shouldBe`+      [ ("n1", "n2"),+        ("n1", "n3"),+        ("n2", "n4"),+        ("n3", "n2"),+        ("n3", "n4"),+        ("n4", "n1"),+        ("n4", "n5")+      ]+    map linkTimestamp got_edges `shouldBe`+      map (\m -> fromS ("2018-12-01T01:" <> m)) ["20", "20", "25", "10", "10", "25", "25"]+  specify "only upper bound (inclusive)" $ withSpider $ \spider -> do+    mapM_ (addFoundNode spider) input_fns+    let q = (defQuery ["n3"]) { unifyLinkSamples = simple_unifier,+                                timeInterval = NegInf+                                               <..<= (Finite $ fromS "2018-12-01T01:30")+                              }+    (got_nodes, got_edges) <- fmap sort2 $ getSnapshot spider q+    map nodeId got_nodes `shouldBe` ["n1", "n3", "n4", "n5"]+    map (isNothing . S.nodeAttributes) got_nodes `shouldBe` [False, False, False, True]+    map linkNodeTuple got_edges `shouldBe`+      [ ("n3", "n4"),+        ("n4", "n1"),+        ("n4", "n5")+      ]+    map linkTimestamp got_edges `shouldBe`+      map (\m -> fromS ("2018-12-01T01:" <> m)) ["30", "25", "25"]+  specify "both bounded" $ withSpider $ \spider -> do+    mapM_ (addFoundNode spider) input_fns+    let q = (defQuery ["n2"]) { unifyLinkSamples = simple_unifier,+                                timeInterval = (Finite $ fromS "2018-12-01T01:20")+                                               <..<= (Finite $ fromS "2018-12-01T01:25")+                              }+    (got_nodes, got_edges) <- fmap sort2 $ getSnapshot spider q+    map nodeId got_nodes `shouldBe` ["n1", "n2", "n4", "n5"]+    map (isNothing . S.nodeAttributes) got_nodes `shouldBe` [True, False, False, True]+    map linkNodeTuple got_edges `shouldBe`+      [ ("n2", "n4"),+        ("n4", "n1"),+        ("n4", "n5")+      ]+    map linkTimestamp got_edges `shouldBe`+      map (\m -> fromS ("2018-12-01T01:" <> m)) ["25", "25", "25"]++spec_getSnapshot_foundNodePolicy :: SpecWith (Host,Port)+spec_getSnapshot_foundNodePolicy = do+  let linkTo n = FoundLink+                 { targetNode = n,+                   linkState = LinkToTarget,+                   linkAttributes = ()+                 }+      linksTo = map linkTo+      node n t ls = FoundNode+                    { subjectNode = n,+                      foundAt = fromEpochMillisecond t,+                      neighborLinks = ls,+                      nodeAttributes = ()+                    }+      input_fns :: [FoundNode Text () ()]+      input_fns = [ node "n1" 10 $ linksTo ["n2"],+                    node "n1" 20 $ linksTo ["n3"],+                    node "n1" 30 $ linksTo ["n2"],+                    node "n2" 15 $ linksTo ["n1"],+                    node "n2" 25 $ linksTo ["n4"],+                    node "n2" 35 $ linksTo ["n4", "n1"],+                    node "n3" 17 $ linksTo [],+                    node "n3" 27 $ linksTo ["n1", "n4"],+                    node "n3" 37 $ linksTo [],+                    node "n4" 8  $ linksTo ["n2"],+                    node "n4" 18 $ linksTo [],+                    node "n4" 28 $ linksTo ["n2", "n3"]+                  ]+      simple_unifier = unifyStd $ defUnifyStdConfig { makeLinkSubId = \ls -> lsSubjectNode ls,+                                                      negatesLinkSample = \_ _ -> False+                                                    }+  specify "policyOverwrite with timeInterval" $ withSpider $ \spider -> do+    mapM_ (addFoundNode spider) input_fns+    let query = (defQuery ["n1"])+                { timeInterval = NegInf <..<= (Finite $ fromEpochMillisecond 27),+                  foundNodePolicy = policyOverwrite,+                  unifyLinkSamples = simple_unifier+                }+    (got_nodes, got_edges) <- fmap sort2 $ getSnapshot spider query+    map linkNodeTuple got_edges `shouldBe`+      [ ("n1", "n3"),+        ("n3", "n1"),+        ("n3", "n4")+      ]+    map linkTimestamp got_edges `shouldBe` map fromEpochMillisecond [20, 27, 27]+    map nodeId got_nodes `shouldBe` ["n1", "n3", "n4"]+    map (isNothing . S.nodeAttributes) got_nodes `shouldBe` [False, False, False]+  specify "policyAppend with timeInterval" $ withSpider $ \spider -> do+    mapM_ (addFoundNode spider) input_fns+    let query = (defQuery ["n1"])+                { timeInterval = (Finite $ fromEpochMillisecond 15) <=..<= (Finite $ fromEpochMillisecond 30),+                  foundNodePolicy = policyAppend,+                  unifyLinkSamples = simple_unifier+                }+    (got_nodes, got_edges) <- fmap sort2 $ getSnapshot spider query+    map linkNodeTuple got_edges `shouldBe`+      [ ("n1", "n2"),+        ("n1", "n3"),+        ("n2", "n1"),+        ("n2", "n4"),+        ("n3", "n1"),+        ("n3", "n4"),+        ("n4", "n2"),+        ("n4", "n3")+      ]+    map linkTimestamp got_edges `shouldBe`+      map fromEpochMillisecond [30, 20, 15, 25, 27, 27, 28, 28]+    map nodeId got_nodes `shouldBe` ["n1", "n2", "n3", "n4"]+    map (isNothing . S.nodeAttributes) got_nodes `shouldBe` [False, False, False, False]