diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,17 @@ # Revision history for net-spider +## 0.4.3.0 -- 2020-04-18 + +* Add SeqID module. + +### Snapshot module + +* Add `graphTimestamp` function. + +### Log module + +* Add `logInfoW`, `logWarnW` and `logErrorW` functions. + ## 0.4.2.0 -- 2020-03-21 * Add Weaver module. diff --git a/net-spider.cabal b/net-spider.cabal --- a/net-spider.cabal +++ b/net-spider.cabal @@ -1,5 +1,5 @@ name: net-spider -version: 0.4.2.0 +version: 0.4.3.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -45,7 +45,8 @@ NetSpider.GraphML.Writer, NetSpider.GraphML.Attribute, NetSpider.Interval, - NetSpider.Weaver + NetSpider.Weaver, + NetSpider.SeqID other-modules: NetSpider.Graph.Internal, NetSpider.Spider.Internal.Graph, NetSpider.Spider.Internal.Log, @@ -93,7 +94,8 @@ NetSpider.TimestampSpec, NetSpider.FoundSpec, NetSpider.SnapshotSpec, - NetSpider.WeaverSpec + NetSpider.WeaverSpec, + NetSpider.SeqIDSpec, JSONUtil, SnapshotTestCase, TestCommon diff --git a/src/NetSpider.hs b/src/NetSpider.hs --- a/src/NetSpider.hs +++ b/src/NetSpider.hs @@ -41,7 +41,8 @@ -- -- == Utility -- --- * "NetSpider.Pair" +-- * "NetSpider.Pair": Swap-insensitive two-element homogeneous tuple -- * "NetSpider.Log" +-- * "NetSpider.SeqID": Utility to generate sequential node IDs. module NetSpider () where diff --git a/src/NetSpider/Log.hs b/src/NetSpider/Log.hs --- a/src/NetSpider/Log.hs +++ b/src/NetSpider/Log.hs @@ -12,6 +12,9 @@ WriterLoggingM, runWriterLoggingM, logDebugW, + logInfoW, + logWarnW, + logErrorW, spack ) where @@ -28,6 +31,18 @@ logDebugW :: Text -> WriterLoggingM () logDebugW = Log.logDebugN + +-- | @since 0.4.3.0 +logInfoW :: Text -> WriterLoggingM () +logInfoW = Log.logInfoN + +-- | @since 0.4.3.0 +logWarnW :: Text -> WriterLoggingM () +logWarnW = Log.logWarnN + +-- | @since 0.4.3.0 +logErrorW :: Text -> WriterLoggingM () +logErrorW = Log.logErrorN spack :: Show a => a -> Text spack = pack . show diff --git a/src/NetSpider/SeqID.hs b/src/NetSpider/SeqID.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/SeqID.hs @@ -0,0 +1,109 @@ +-- | +-- Module: NetSpider.SeqID +-- Description: Sequential node IDs +-- Maintainer: Toshio Ito +-- +-- @since 0.4.3.0 +module NetSpider.SeqID + ( -- * Type + SeqIDMaker, + -- * Construction + newSeqIDMaker, + -- * Conversion + convertGraph, + convertLink, + convertNode, + convertNodeID, + originalIDFor + ) where + +import Data.Foldable (foldl') +import Data.List (reverse) +import Data.Hashable (Hashable) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HM + +import NetSpider.Snapshot.Internal + ( SnapshotNode(_nodeId), + SnapshotLink(_sourceNode, _destinationNode), + SnapshotGraph + ) + + +-- | 'SeqIDMaker' converts node ID type @n@ into the new node ID type +-- @i@. The type @i@ is supposed to be an 'Enum', and it generates the +-- node ID of type @i@ sequentially for each node ID of type @n@. +-- +-- 'SeqIDMaker' is useful to convert the 'SnapshotGraph' into a graph +-- representation of another graph library such as +-- [fgl](https://hackage.haskell.org/package/fgl). Note that the +-- target graph library can provide a better way for conversion. For +-- example, fgl has @NodeMap@ type to do basically the same thing. +data SeqIDMaker n i = + SeqIDMaker + { toSeqID :: HashMap n i, + fromSeqID :: HashMap i n, + nextID :: i + } + deriving (Show,Eq) + +-- | Make a 'SeqIDMaker' with the given initial ID. +newSeqIDMaker :: i -- ^ Initial ID + -> SeqIDMaker n i +newSeqIDMaker init_id = SeqIDMaker HM.empty HM.empty init_id + +-- | Convert the given node ID of type @n@ into the sequential ID of +-- type @i@. +convertNodeID :: (Eq n, Hashable n, Enum i, Eq i, Hashable i) + => SeqIDMaker n i + -> n -- ^ Old ID + -> (SeqIDMaker n i, i) -- ^ Updated 'SeqIDMaker' and the new ID. +convertNodeID maker nid = + case HM.lookup nid $ toSeqID maker of + Just existing_id -> (maker, existing_id) + Nothing -> (new_maker, new_id) + where + new_id = nextID maker + new_next_id = succ $ new_id + new_maker = maker { toSeqID = new_to, + fromSeqID = new_from, + nextID = new_next_id + } + new_to = HM.insert nid new_id $ toSeqID maker + new_from = HM.insert new_id nid $ fromSeqID maker + +-- | Convert node IDs in the 'SnapshotGraph'. +convertGraph :: (Eq n, Hashable n, Enum i, Eq i, Hashable i) + => SeqIDMaker n i -> SnapshotGraph n na la -> (SeqIDMaker n i, SnapshotGraph i na la) +convertGraph maker (nodes, links) = (new_maker, (new_nodes, new_links)) + where + (inter_maker, new_nodes_rev) = foldl' nodeFolder (maker, []) nodes + nodeFolder (m, ns) node = let (step_m, new_node) = convertNode m node + in (step_m, new_node : ns) + new_nodes = reverse new_nodes_rev + (new_maker, new_links_rev) = foldl' linkFolder (inter_maker, []) links + linkFolder (m, ls) link = let (step_m, new_link) = convertLink m link + in (step_m, new_link : ls) + new_links = reverse new_links_rev + +-- | Convert node IDs in the 'SnapshotLink'. +convertLink :: (Eq n, Hashable n, Enum i, Eq i, Hashable i) + => SeqIDMaker n i -> SnapshotLink n la -> (SeqIDMaker n i, SnapshotLink i la) +convertLink maker link = (new_maker, new_link) + where + (inter_maker, seq_source) = convertNodeID maker $ _sourceNode link + (new_maker, seq_dest) = convertNodeID inter_maker $ _destinationNode link + new_link = link { _sourceNode = seq_source, _destinationNode = seq_dest } + +-- | Convert node ID in the 'SnapshotNode'. +convertNode :: (Eq n, Hashable n, Enum i, Eq i, Hashable i) + => SeqIDMaker n i -> SnapshotNode n na -> (SeqIDMaker n i, SnapshotNode i na) +convertNode maker node = (new_maker, new_node) + where + (new_maker, seq_id) = convertNodeID maker $ _nodeId node + new_node = node { _nodeId = seq_id } + +-- | Get the original ID of type @n@ for the new ID of type @i@. +originalIDFor :: (Eq i, Hashable i) + => SeqIDMaker n i -> i -> Maybe n +originalIDFor maker seq_id = HM.lookup seq_id $ fromSeqID maker diff --git a/src/NetSpider/Snapshot.hs b/src/NetSpider/Snapshot.hs --- a/src/NetSpider/Snapshot.hs +++ b/src/NetSpider/Snapshot.hs @@ -8,6 +8,7 @@ module NetSpider.Snapshot ( -- * SnapshotGraph SnapshotGraph, + graphTimestamp, -- * SnapshotNode SnapshotNode, nodeId, @@ -25,6 +26,8 @@ linkAttributes ) where +import Data.Maybe (catMaybes) + import NetSpider.Snapshot.Internal ( SnapshotGraph, SnapshotNode(..), @@ -33,6 +36,18 @@ linkNodePair ) import NetSpider.Timestamp (Timestamp) + +-- | Get the timestamp of the graph. It's the latest timestamp of the +-- nodes and links. +-- +-- @since 0.4.3.0 +graphTimestamp :: SnapshotGraph n na la -> Maybe Timestamp +graphTimestamp (nodes, links) = maximum' (node_times ++ link_times) + where + maximum' [] = Nothing + maximum' ts = Just $ maximum ts + node_times = catMaybes $ map nodeTimestamp nodes + link_times = map linkTimestamp links nodeId :: SnapshotNode n na -> n nodeId = _nodeId diff --git a/test/NetSpider/SeqIDSpec.hs b/test/NetSpider/SeqIDSpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/SeqIDSpec.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedStrings #-} +module NetSpider.SeqIDSpec (main,spec) where + +import Data.Text (Text) +import Test.Hspec + +import NetSpider.SeqID + ( newSeqIDMaker, convertNodeID, convertGraph, originalIDFor + ) +import NetSpider.Snapshot.Internal (SnapshotNode(..), SnapshotLink(..)) +import NetSpider.Snapshot (nodeId, linkNodeTuple) +import NetSpider.Timestamp (fromEpochMillisecond) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "SeqIDMaker" $ do + specify "first ID" $ do + let m = newSeqIDMaker (0 :: Int) + (got_m, got) = convertNodeID m ("hoge" :: Text) + got `shouldBe` 0 + (snd $ convertNodeID got_m "hoge") `shouldBe` 0 + originalIDFor got_m 0 `shouldBe` Just "hoge" + originalIDFor got_m 1 `shouldBe` Nothing + originalIDFor got_m 2 `shouldBe` Nothing + specify "second ID" $ do + let m = newSeqIDMaker (0 :: Int) + (m1, _) = convertNodeID m ("bar" :: Text) + (got_m, got) = convertNodeID m1 ("foo" :: Text) + got `shouldBe` 1 + (snd $ convertNodeID got_m "bar") `shouldBe` 0 + (snd $ convertNodeID got_m "foo") `shouldBe` 1 + originalIDFor got_m 0 `shouldBe` Just "bar" + originalIDFor got_m 1 `shouldBe` Just "foo" + originalIDFor got_m 2 `shouldBe` Nothing + specify "duplicate ID" $ do + let m = newSeqIDMaker (5 :: Int) + (m1, id1) = convertNodeID m ("bar" :: Text) + (got_m, id2) = convertNodeID m1 ("bar" :: Text) + id1 `shouldBe` 5 + id2 `shouldBe` 5 + originalIDFor got_m 0 `shouldBe` Nothing + originalIDFor got_m 5 `shouldBe` Just "bar" + specify "convertGraph" $ do + let input = (nodes, links) + mkNode :: Text -> SnapshotNode Text () + mkNode nid = SnapshotNode + { _nodeId = nid, + _isOnBoundary = False, + _nodeTimestamp = Just $ fromEpochMillisecond 100, + _nodeAttributes = Just () + } + mkLink :: Text -> Text -> SnapshotLink Text () + mkLink source dest = SnapshotLink + { _sourceNode = source, + _destinationNode = dest, + _isDirected = True, + _linkTimestamp = fromEpochMillisecond 100, + _linkAttributes = () + } + nodes = [ mkNode "n1", + mkNode "n2", + mkNode "n3", + mkNode "n4", + mkNode "n5" + ] + links = [ mkLink "n1" "n3", + mkLink "n4" "n2", + mkLink "n3" "n5", + mkLink "n5" "n2" + ] + (got_m, (got_nodes, got_links)) = convertGraph (newSeqIDMaker (1 :: Int)) input + map nodeId got_nodes `shouldBe` [1,2,3,4,5] + map linkNodeTuple got_links `shouldBe` + [ (1, 3), (4, 2), (3, 5), (5, 2) + ] + map (originalIDFor got_m) [1 .. 6] `shouldBe` + [ Just "n1", Just "n2", Just "n3", Just "n4", Just "n5", Nothing + ] +