net-spider 0.3.0.0 → 0.3.1.0

raw patch · 9 files changed

+823/−18 lines, 9 filesdep +scientificdep ~aesondep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: scientific

Dependency ranges changed: aeson, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +13/−0
• net-spider.cabal +12/−7
• src/NetSpider/GraphML/Writer.hs +427/−0
• src/NetSpider/Snapshot.hs +5/−3
• src/NetSpider/Snapshot/Internal.hs +7/−1
• src/NetSpider/Spider.hs +3/−3
• src/NetSpider/Spider/Internal/Spider.hs +4/−0
• src/NetSpider/Timestamp.hs +71/−4
• test/NetSpider/GraphML/WriterSpec.hs +281/−0

@@ -1,5 +1,18 @@ # Revision history for net-spider +## 0.3.1.0  -- 2019-07-15++* Add `GraphML.Writer` module.++### Snapshot module++* Add `SnapshotGraph` type synonym.++### Timestamp module++* Add `toTime`, `toSystemTime` and `showTimestamp` functions.++ ## 0.3.0.0  -- 2019-05-03  * Export `Snapshot.Internal` module. This module is only for internal

@@ -1,5 +1,5 @@ name:                   net-spider-version:                0.3.0.0+version:                0.3.1.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -21,7 +21,9 @@   other-extensions:     OverloadedStrings,                         GeneralizedNewtypeDeriving,                         TypeFamilies,-                        FlexibleInstances+                        FlexibleInstances,+                        DeriveGeneric,+                        TypeSynonymInstances   exposed-modules:      NetSpider,                         NetSpider.Input,                         NetSpider.Output,@@ -35,7 +37,8 @@                         NetSpider.Pair,                         NetSpider.Query,                         NetSpider.Log,-                        NetSpider.Snapshot.Internal+                        NetSpider.Snapshot.Internal,+                        NetSpider.GraphML.Writer   other-modules:        NetSpider.Graph.Internal,                         NetSpider.Spider.Internal.Graph,                         NetSpider.Spider.Internal.Log,@@ -55,7 +58,8 @@                         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+                        monad-logger >=0.3.28.1 && <0.4,+                        scientific >=0.3.6.2 && <0.4  -- executable net-spider --   default-language:     Haskell2010@@ -74,9 +78,10 @@   ghc-options:          -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"   main-is:              Spec.hs   -- default-extensions:   -  -- other-extensions:     -  -- other-modules:        -  build-depends:        base, net-spider, vector,+  other-extensions:     OverloadedStrings,+                        DeriveGeneric+  other-modules:        NetSpider.GraphML.WriterSpec+  build-depends:        base, net-spider, vector, text, aeson,                         hspec >=2.4.4  flag server-test

@@ -0,0 +1,427 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeSynonymInstances, FlexibleInstances #-}+-- |+-- Module: NetSpider.GraphML.Writer+-- Description: Serialize a Snapshot graph into GraphML format.+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- This module defines tools to serialize a 'SnapshotGraph' into+-- [GraphML](http://graphml.graphdrawing.org/primer/graphml-primer.html)+-- format.+--+-- @since 0.3.1.0+module NetSpider.GraphML.Writer+  ( -- * Functions+    writeGraphML,+    writeGraphMLWith,+    -- * Options+    WriteOption,+    defWriteOption,+    -- ** accessors for WriteOption+    woptDefaultDirected,+    -- * NodeID+    NodeID,+    ToNodeID(..),+    nodeIDByShow,+    -- * Attributes+    AttributeKey,+    AttributeValue(..),+    ToAttributes(..),+    valueFromAeson,+    attributesFromAeson+  ) where++import qualified Data.Aeson as Aeson+import Data.Foldable (foldl')+import Data.Greskell.Graph+  ( PropertyMap, Property(..), allProperties+  )+import Data.Hashable (Hashable(..))+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Maybe (catMaybes)+import Data.Monoid ((<>), Monoid(..), mconcat)+import qualified Data.Scientific as Sci+import Data.Semigroup (Semigroup(..))+import Data.Text (Text, pack, unpack)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+import Data.Time (TimeZone(..))+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Generics (Generic)++import NetSpider.Snapshot+  ( SnapshotNode, nodeId, nodeTimestamp, isOnBoundary, nodeAttributes,+    SnapshotLink, sourceNode, destinationNode, linkTimestamp, isDirected, linkAttributes,+    SnapshotGraph+  )+import NetSpider.Timestamp+  ( Timestamp(epochTime, timeZone),+    showTimestamp+  )++-- | Node ID in GraphML.+type NodeID = Text++class ToNodeID a where+  toNodeID :: a -> NodeID++nodeIDByShow :: Show a => a -> NodeID+nodeIDByShow = pack . show++instance ToNodeID Text where+  toNodeID = id++instance ToNodeID TL.Text where+  toNodeID = TL.toStrict++instance ToNodeID String where+  toNodeID = pack++instance ToNodeID Int where+  toNodeID = nodeIDByShow++instance ToNodeID Int8 where+  toNodeID = nodeIDByShow++instance ToNodeID Int16 where+  toNodeID = nodeIDByShow++instance ToNodeID Int32 where+  toNodeID = nodeIDByShow++instance ToNodeID Int64 where+  toNodeID = nodeIDByShow++instance ToNodeID Word where+  toNodeID = nodeIDByShow++instance ToNodeID Word8 where+  toNodeID = nodeIDByShow++instance ToNodeID Word16 where+  toNodeID = nodeIDByShow++instance ToNodeID Word32 where+  toNodeID = nodeIDByShow++instance ToNodeID Integer where+  toNodeID = nodeIDByShow++instance ToNodeID Float where+  toNodeID = nodeIDByShow++instance ToNodeID Double where+  toNodeID = nodeIDByShow++instance ToNodeID Bool where+  toNodeID True = "true"+  toNodeID False = "false"++-- | Key of attribute.+type AttributeKey = Text++-- | Typed value of attribute.+data AttributeValue = AttrBoolean Bool+                    | AttrInt Int+                    | AttrLong Integer+                    | AttrFloat Float+                    | AttrDouble Double+                    | AttrString Text+                    deriving (Show,Eq,Ord)++-- | Type that can be converted to list of attributes.+class ToAttributes a where+  toAttributes :: a -> [(AttributeKey, AttributeValue)]++instance ToAttributes () where+  toAttributes _ = []++instance ToAttributes [(AttributeKey, AttributeValue)] where+  toAttributes = id++instance (PropertyMap m, Property p) => ToAttributes (m p AttributeValue) where+  toAttributes = toAttributes . map toPair . allProperties+    where+      toPair p = (propertyKey p, propertyValue p)++-- | 'Nothing' is mapped to empty attributes.+instance ToAttributes a => ToAttributes (Maybe a) where+  toAttributes Nothing = []+  toAttributes (Just a) = toAttributes a++-- | Make 'AttributeValue' from aeson's 'Aeson.Value'. It returns+-- 'Nothing', if the input is null, an object or an array. If the+-- input is a number, the output uses 'AttrDouble'.+valueFromAeson :: Aeson.Value -> Maybe AttributeValue+valueFromAeson v =+  case v of+    Aeson.String t -> Just $ AttrString t+    Aeson.Bool b -> Just $ AttrBoolean b+    Aeson.Number n -> Just $ AttrDouble $ Sci.toRealFloat n+    _ -> Nothing++-- | Make attributes from aeson's 'Aeson.Value'. It assumes the input+-- is an object, and its values can be converted by+-- 'valueFromAeson'. Otherwise, it returns 'Nothing'.+attributesFromAeson :: Aeson.Value -> Maybe [(AttributeKey, AttributeValue)]+attributesFromAeson v =+  case v of+    Aeson.Object o -> mapM convElem $ HM.toList o+    _ -> Nothing+  where+    convElem (k, val) = fmap ((,) k) $ valueFromAeson val++sbuild :: Show a => a -> TLB.Builder+sbuild = TLB.fromString . show++showAttributeValue :: AttributeValue -> TLB.Builder+showAttributeValue v =+  case v of+    AttrBoolean False -> "false"+    AttrBoolean True -> "true"+    AttrInt i -> sbuild i+    AttrLong i -> sbuild i+    AttrFloat f -> sbuild f+    AttrDouble d -> sbuild d+    AttrString t -> encodeXML t++-- | Type specifier of 'AttributeValue'+data AttributeType = ATBoolean+                   | ATInt+                   | ATLong+                   | ATFloat+                   | ATDouble+                   | ATString+                   deriving (Show,Eq,Ord,Generic)++instance Hashable AttributeType++valueType :: AttributeValue -> AttributeType+valueType v =+  case v of+    AttrBoolean _ -> ATBoolean+    AttrInt _ -> ATInt+    AttrLong _ -> ATLong+    AttrFloat _ -> ATFloat+    AttrDouble _ -> ATDouble+    AttrString _ -> ATString++showAttributeType :: AttributeType -> TLB.Builder+showAttributeType t =+  case t of+    ATBoolean -> "boolean"+    ATInt -> "int"+    ATLong -> "long"+    ATFloat -> "float"+    ATDouble -> "double"+    ATString -> "string"++-- | Domain (`for` field of the key) of attribute.+data AttributeDomain = DomainGraph+                     | DomainNode+                     | DomainEdge+                     | DomainAll+                     deriving (Show,Eq,Ord,Generic)++instance Hashable AttributeDomain++showDomain :: AttributeDomain -> TLB.Builder+showDomain d =+  case d of+    DomainGraph -> "graph"+    DomainNode -> "node"+    DomainEdge -> "edge"+    DomainAll -> "all"++-- | Meta data for a key.+data KeyMeta =+  KeyMeta+  { kmName :: AttributeKey,+    kmType :: AttributeType,+    kmDomain :: AttributeDomain+  }+  deriving (Show,Eq,Ord,Generic)++instance Hashable KeyMeta++makeMetaValue :: AttributeDomain -> AttributeKey -> AttributeValue -> (KeyMeta, AttributeValue)+makeMetaValue d k v = (meta, v)+  where+    meta = KeyMeta { kmName = k,+                     kmType = valueType v,+                     kmDomain = d+                   }++-- | Storage of key metadata.+data KeyStore =+  KeyStore+  { ksMetas :: [KeyMeta],+    ksIndexFor :: HashMap KeyMeta Int+  }+  deriving (Show,Eq,Ord)++emptyKeyStore :: KeyStore+emptyKeyStore = KeyStore { ksMetas = [],+                           ksIndexFor = HM.empty+                         }++addKey :: KeyMeta -> KeyStore -> KeyStore+addKey new_meta ks = KeyStore { ksMetas = if HM.member new_meta $ ksIndexFor ks+                                          then ksMetas ks+                                          else new_meta : ksMetas ks,+                                ksIndexFor = HM.insertWith (\_ old -> old) new_meta (length $ ksMetas ks) $ ksIndexFor ks+                              }++keyIndex :: KeyStore -> KeyMeta -> Maybe Int+keyIndex ks km = HM.lookup km $ ksIndexFor ks++showAllKeys :: TLB.Builder -> KeyStore -> TLB.Builder+showAllKeys prefix ks = mconcat $ map (prefix <>) $ catMaybes $ map (showKeyMeta ks) $ reverse $ ksMetas ks++showKeyMeta :: KeyStore -> KeyMeta -> Maybe TLB.Builder+showKeyMeta ks km = fmap (\i -> showKeyMetaWithIndex i km) $ keyIndex ks km++showAttributeID :: Int -> TLB.Builder+showAttributeID index = "d" <> sbuild index++showKeyMetaWithIndex :: Int -> KeyMeta -> TLB.Builder+showKeyMetaWithIndex index km = "<key id=\"" <> id_str <> "\" for=\"" <> domain_str+                                <> "\" attr.name=\"" <> name_str <> "\" attr.type=\"" <> type_str <> "\"/>\n"+  where+    id_str = showAttributeID index+    domain_str = showDomain $ kmDomain km+    name_str = encodeXML $ kmName km+    type_str = showAttributeType $ kmType km++timestampAttrs :: Timestamp -> [(AttributeKey, AttributeValue)]+timestampAttrs t =+  [ ("@timestamp", AttrLong $ toInteger $ epochTime t),+    ("@timestamp_str", AttrString $ showTimestamp t)+  ] ++ timezone_attrs+  where+    timezone_attrs =+      case timeZone t of+        Nothing -> []+        Just tz -> [ ("@tz_offset_min", AttrInt $ timeZoneMinutes tz),+                     ("@tz_summer_only", AttrBoolean $ timeZoneSummerOnly tz),+                     ("@tz_name", AttrString $ pack $ timeZoneName tz)+                   ]++nodeMetaKeys :: ToAttributes na => SnapshotNode n na -> [KeyMeta]+nodeMetaKeys n = map fst $ nodeMetaValues n++nodeMetaValues :: ToAttributes na => SnapshotNode n na -> [(KeyMeta, AttributeValue)]+nodeMetaValues n = map convert $ base <> attrs+  where+    timestamp = case nodeTimestamp n of+                  Nothing -> []+                  Just t -> timestampAttrs t+    base = timestamp <> [("@is_on_boundary", AttrBoolean $ isOnBoundary n)]+    attrs = toAttributes $ nodeAttributes n+    convert (k, v) = makeMetaValue DomainNode k v++linkMetaKeys :: ToAttributes la => SnapshotLink n la -> [KeyMeta]+linkMetaKeys l = map fst $ linkMetaValues l++linkMetaValues :: ToAttributes la => SnapshotLink n la -> [(KeyMeta, AttributeValue)]+linkMetaValues l = map convert $ base <> attrs+  where+    base = timestampAttrs $ linkTimestamp l+    attrs = toAttributes $ linkAttributes l+    convert (k, v) = makeMetaValue DomainEdge k v++showAttribute :: KeyStore -> KeyMeta -> AttributeValue -> TLB.Builder+showAttribute ks km val =+  case keyIndex ks km of+    Nothing -> ""+    Just index -> "<data key=\"" <> key_id_str <> "\">" <> val_str <> "</data>\n"+      where+        key_id_str = showAttributeID index+        val_str = showAttributeValue val++-- | Options to write GraphML. Use 'defWriteOption' to get the default+-- values.+data WriteOption =+  WriteOption+  { woptDefaultDirected :: Bool+    -- ^ If 'True', set GraphML's @edgedefault@ attribute to+    -- @directed@. If 'False', set it to @undirected@. Note that+    -- regardless of this option, each @edge@ element specifies+    -- @directed@ attribute explicitly.+    --+    -- Default: 'True'+  }+  deriving (Show,Eq,Ord)++defWriteOption :: WriteOption+defWriteOption =+  WriteOption+  { woptDefaultDirected = True+  }++-- | 'writeGraphMLWith' the default options.+writeGraphML :: (ToNodeID n, ToAttributes na, ToAttributes la)+             => SnapshotGraph n na la+             -> TL.Text+writeGraphML = writeGraphMLWith defWriteOption++writeGraphMLWith :: (ToNodeID n, ToAttributes na, ToAttributes la)+                 => WriteOption+                 -> SnapshotGraph n na la+                 -> TL.Text+writeGraphMLWith wopt (input_nodes, input_links) =+  TLB.toLazyText ( xml_header+                   <> graphml_header+                   <> keys+                   <> graph_header+                   <> nodes+                   <> edges+                   <> graph_footer+                   <> graphml_footer+                 )+  where+    xml_header = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"+    graphml_header = "<graphml xmlns=\"http://graphml.graphdrawing.org/xmlns\"\n"+                     <> " xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"\n"+                     <> " xsi:schemaLocation=\"http://graphml.graphdrawing.org/xmlns http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd\">\n"+    graphml_footer = "</graphml>\n"+    keys = showAllKeys "" key_store+    key_metas = concat $ map nodeMetaKeys input_nodes <> map linkMetaKeys input_links+    key_store = foldl' (\acc m -> addKey m acc) emptyKeyStore key_metas+    edgedefault_str = if woptDefaultDirected wopt+                      then "directed"+                      else "undirected"+    graph_header = "<graph edgedefault=\"" <> edgedefault_str <> "\">\n"+    graph_footer = "</graph>\n"+    nodes = mconcat $ map writeNode input_nodes+    edges = mconcat $ map writeLink input_links+    showAttribute' (k,v) = ("    " <> ) $ showAttribute key_store k v+    writeNode n = "  <node id=\"" <> (encodeNodeID $ nodeId n) <> "\">\n"+                  <> (mconcat $ map showAttribute' $ nodeMetaValues n)+                  <> "  </node>\n"+    writeLink l = "  <edge source=\"" <> (encodeNodeID $ sourceNode l)+                  <> "\" target=\"" <> (encodeNodeID $ destinationNode l)+                  <> "\" directed=\"" <> showDirected l <> "\">\n"+                  <> (mconcat $ map showAttribute' $ linkMetaValues l)+                  <> "  </edge>\n"+    showDirected l = if isDirected l+                     then "true"+                     else "false"++encodeNodeID :: ToNodeID n => n -> TLB.Builder+encodeNodeID = encodeXML . toNodeID++encodeXML :: Text -> TLB.Builder+encodeXML = mconcat . map escape . unpack+  where+    escape c =+      case c of+        '<' -> "&lt;"+        '>' -> "&gt;"+        '&' -> "&amp;"+        '"' -> "&quot;"+        '\'' -> "&apos;"+        '\n' -> "&#x0a;"+        '\r' -> "&#x0d;"+        _ -> TLB.singleton c

@@ -6,7 +6,9 @@ -- A snapshot graph is a graph constructed from the NetSpider -- database. It reprensents a graph at specific time. module NetSpider.Snapshot-       ( -- * SnapshotNode+       ( -- * SnapshotGraph+         SnapshotGraph,+         -- * SnapshotNode          SnapshotNode,          nodeId,          isOnBoundary,@@ -24,13 +26,13 @@        ) where  import NetSpider.Snapshot.Internal-  ( SnapshotNode(..),+  ( SnapshotGraph,+    SnapshotNode(..),     SnapshotLink(..),     linkNodeTuple,     linkNodePair   ) import NetSpider.Timestamp (Timestamp)-  nodeId :: SnapshotNode n na -> n nodeId = _nodeId

@@ -10,7 +10,8 @@ -- -- @since 0.3.0.0 module NetSpider.Snapshot.Internal-       ( SnapshotLink(..),+       ( SnapshotGraph,+         SnapshotLink(..),          linkNodeTuple,          linkNodePair,          SnapshotNode(..)@@ -19,6 +20,11 @@ import Data.Bifunctor (Bifunctor(..)) import NetSpider.Pair (Pair(..)) import NetSpider.Timestamp (Timestamp)++-- | The snapshot graph, which is a collection nodes and links.+--+-- @since 0.3.1.0+type SnapshotGraph n na la = ([SnapshotNode n na], [SnapshotLink n la])  -- | A link in the snapshot graph. --

@@ -58,7 +58,7 @@     Interval   ) import NetSpider.Query.Internal (FoundNodePolicy(..))-import NetSpider.Snapshot.Internal (SnapshotNode(..), SnapshotLink(..))+import NetSpider.Snapshot.Internal (SnapshotGraph, SnapshotNode(..), SnapshotLink(..)) import NetSpider.Spider.Config (Config(..), defConfig) import NetSpider.Spider.Internal.Graph   ( gMakeFoundNode, gAllNodes, gHasNodeID, gHasNodeEID, gNodeEID, gNodeID, gMakeNode, gClearAll,@@ -146,7 +146,7 @@ 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])+                  -> IO (SnapshotGraph n na fla) getSnapshotSimple spider start_nid = getSnapshot spider $ defQuery [start_nid]  @@ -155,7 +155,7 @@ 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])+            -> IO (SnapshotGraph n na sla) getSnapshot spider query = do   ref_state <- newIORef $ initSnapshotState $ startsFrom query   recurseVisitNodesForSnapshot spider query ref_state

@@ -30,3 +30,7 @@     spiderClient :: Gr.Client   } +-- Implementation note: Type parameters n, na, fla are phantom. They+-- are used to bind the input types (type arguments for FoundNode etc)+-- and the output types (type arguments for SnapshotNode etc)+

@@ -12,13 +12,17 @@          now,          -- * Manipulation          addSec,-         -- * Conversion+         -- * Convert to Timestamp          parseTimestamp,          fromS,          fromZonedTime,          fromUTCTime,          fromSystemTime,          fromLocalTime,+         -- * Convert from Timestamp+         toTime,+         toSystemTime,+         showTimestamp,          showEpochTime        ) where @@ -26,17 +30,20 @@ import Data.Char (isDigit) import Data.Int (Int64) import Data.List (sortOn)+import Data.Monoid ((<>)) import Data.Text (Text, pack) import Data.Time.Calendar (Day, fromGregorian)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.System (utcToSystemTime, SystemTime(..), systemToUTCTime)+import qualified Data.Time.Format as DTFormat import Data.Time.LocalTime   ( TimeZone(..), getZonedTime, ZonedTime(..), zonedTimeToUTC, LocalTime(LocalTime), localTimeToUTC,-    TimeOfDay(TimeOfDay)+    TimeOfDay(TimeOfDay), utcToLocalTime, utcToZonedTime   ) 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)+import Text.Printf (printf)  -- | Timestamp when graph elements are observed. data Timestamp =@@ -59,11 +66,71 @@ fromEpochMillisecond :: Int64 -> Timestamp fromEpochMillisecond msec = Timestamp msec Nothing +-- | Show 'Timestamp' with a basic ISO 8601 format.+--+-- >>> showTimestamp $ fromS "2019-10-20T12:45:00"+-- "2019-10-20T12:45:00.000"+-- >>> showTimestamp $ fromS "1999-03-21T10:11Z"+-- "1999-03-21T10:11:00.000Z"+-- >>> showTimestamp $ fromS "2016-11-30T22:03:00.034+09:00"+-- "2016-11-30T22:03:00.034+09:00"+-- >>> showTimestamp $ fromS "2000-04-07T09:31-05:00"+-- "2000-04-07T09:31:00.000-05:00"+--+-- @since 0.3.1.0+showTimestamp :: Timestamp -> Text+showTimestamp = pack . either simpleFormat formatZT . toTime+  where+    dtFormat :: DTFormat.FormatTime t => String -> t -> String+    dtFormat = DTFormat.formatTime DTFormat.defaultTimeLocale+    simpleFormat :: DTFormat.FormatTime t => t -> String+    simpleFormat = dtFormat "%Y-%m-%dT%H:%M:%S.%03q"+    formatZT zt = simpleFormat zt <> formatZone (zonedTimeZone zt)+    formatZone z = if timeZoneName z == ""+                   then formatOffset $ timeZoneMinutes z+                   else if z == LocalTime.utc+                        then "Z"+                        else dtFormat "%Z" z+    formatOffset o = sign <> hour <> ":" <> minute+      where+        sign = if o < 0 then "-" else "+"+        abo = abs o+        hour = printf "%02d" (abo `div` 60)+        minute = printf "%02d" (abo `mod` 60)+ -- | Show 'epochTime' of 'Timestamp' as 'Text'. -- -- @since 0.2.0.0 showEpochTime :: Timestamp -> Text showEpochTime = pack . show . epochTime++-- | Convert to 'LocalTime' (if the 'Timestamp' has no time zone) or+-- 'ZonedTime' (otherwise). If it makes the 'LocalTime' as if the time+-- zone was UTC.+--+-- @since 0.3.1.0+toTime :: Timestamp -> Either LocalTime ZonedTime+toTime ts = maybe (Left localtime) (Right . toZT) $ timeZone ts+  where+    utctime = systemToUTCTime $ toSystemTime ts+    localtime = utcToLocalTime LocalTime.utc utctime+    toZT tz = utcToZonedTime tz utctime++-- | Convert 'Timestamp' to 'SystemTime'. It discards 'timeZone'+-- field.+--+-- >>> toSystemTime $ fromEpochMillisecond 1043221+-- MkSystemTime {systemSeconds = 1043, systemNanoseconds = 221000000}+-- >>> toSystemTime $ fromEpochMillisecond (-192332)+-- MkSystemTime {systemSeconds = -193, systemNanoseconds = 668000000}+--+-- @since 0.3.1.0+toSystemTime :: Timestamp -> SystemTime+toSystemTime ts = MkSystemTime sec nsec+  where+    epoch_time = epochTime ts+    sec = epoch_time `div` 1000+    nsec = fromIntegral (epoch_time `mod` 1000) * 1000000  -- | Get the current system time. --

@@ -0,0 +1,281 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}+module NetSpider.GraphML.WriterSpec (main,spec) where++import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions)+import Data.List (sortOn)+import Data.Maybe (fromJust)+import Data.Text (Text)+import qualified Data.Text.Lazy as TL+-- import qualified Data.Text.Lazy.IO as TLIO+import GHC.Generics (Generic)+import NetSpider.Snapshot.Internal+  ( SnapshotNode(..), SnapshotLink(..)+  )+import NetSpider.Timestamp (fromEpochMillisecond, fromS)+import Test.Hspec++import NetSpider.GraphML.Writer+  ( writeGraphML,+    ToAttributes(..),+    AttributeValue(..),+    attributesFromAeson,+    writeGraphMLWith,+    defWriteOption,+    woptDefaultDirected+  )++main :: IO ()+main = hspec spec++data Att1 =+  Att1+  { at1Hoge :: Int,+    at1Foo :: Text,+    at1Buzz :: Bool+  }+  deriving (Show,Eq,Ord)++instance ToAttributes Att1 where+  toAttributes a = [ ("hoge", AttrInt $ at1Hoge a),+                     ("foo", AttrString $ at1Foo a),+                     ("buzz", AttrBoolean $ at1Buzz a)+                   ]++data Att2 =+  Att2+  { at2_quux :: Double,+    at2_huga :: Text+  }+  deriving (Show,Eq,Ord,Generic)++instance ToJSON Att2 where+  toEncoding = genericToEncoding defaultOptions++instance ToAttributes Att2 where+  toAttributes a = sortOn fst $ fromJust $ attributesFromAeson $ toJSON a++spec :: Spec+spec = do+  describe "writeGraphML" $ do+    specify "no attribute, directed and undirected mixed, node id escaped" $ do+      let time_with_tz = fromS "2018-09-23T08:48:52+09:00"+          nodes :: [SnapshotNode Text ()]+          nodes = [ SnapshotNode+                    { _nodeId = "\"the root\"",+                      _isOnBoundary = False,+                      _nodeTimestamp = Just $ fromEpochMillisecond 100,+                      _nodeAttributes = Just ()+                    },+                    SnapshotNode+                    { _nodeId = "☃",+                      _isOnBoundary = True,+                      _nodeTimestamp = Nothing,+                      _nodeAttributes = Nothing+                    },+                    SnapshotNode+                    { _nodeId = "<child>",+                      _isOnBoundary = False,+                      _nodeTimestamp = Just $ time_with_tz,+                      _nodeAttributes = Just ()+                    }+                  ]+          links :: [SnapshotLink Text ()]+          links = [ SnapshotLink+                    { _sourceNode = "\"the root\"",+                      _destinationNode = "☃",+                      _isDirected = True,+                      _linkTimestamp = fromEpochMillisecond 100,+                      _linkAttributes = ()+                    },+                    SnapshotLink+                    { _sourceNode = "<child>",+                      _destinationNode = "\"the root\"",+                      _isDirected = False,+                      _linkTimestamp = time_with_tz,+                      _linkAttributes = ()+                    }+                  ]+          expected = mconcat $ map (<> "\n")+                     [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>",+                       "<graphml xmlns=\"http://graphml.graphdrawing.org/xmlns\"",+                       " xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"",+                       " xsi:schemaLocation=\"http://graphml.graphdrawing.org/xmlns http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd\">",+                       "<key id=\"d0\" for=\"node\" attr.name=\"@timestamp\" attr.type=\"long\"/>",+                       "<key id=\"d1\" for=\"node\" attr.name=\"@timestamp_str\" attr.type=\"string\"/>",+                       "<key id=\"d2\" for=\"node\" attr.name=\"@is_on_boundary\" attr.type=\"boolean\"/>",+                       "<key id=\"d3\" for=\"node\" attr.name=\"@tz_offset_min\" attr.type=\"int\"/>",+                       "<key id=\"d4\" for=\"node\" attr.name=\"@tz_summer_only\" attr.type=\"boolean\"/>",+                       "<key id=\"d5\" for=\"node\" attr.name=\"@tz_name\" attr.type=\"string\"/>",+                       "<key id=\"d6\" for=\"edge\" attr.name=\"@timestamp\" attr.type=\"long\"/>",+                       "<key id=\"d7\" for=\"edge\" attr.name=\"@timestamp_str\" attr.type=\"string\"/>",+                       "<key id=\"d8\" for=\"edge\" attr.name=\"@tz_offset_min\" attr.type=\"int\"/>",+                       "<key id=\"d9\" for=\"edge\" attr.name=\"@tz_summer_only\" attr.type=\"boolean\"/>",+                       "<key id=\"d10\" for=\"edge\" attr.name=\"@tz_name\" attr.type=\"string\"/>",+                       "<graph edgedefault=\"directed\">",+                       "  <node id=\"&quot;the root&quot;\">",+                       "    <data key=\"d0\">100</data>",+                       "    <data key=\"d1\">1970-01-01T00:00:00.100</data>",+                       "    <data key=\"d2\">false</data>",+                       "  </node>",+                       "  <node id=\"☃\">",+                       "    <data key=\"d2\">true</data>",+                       "  </node>",+                       "  <node id=\"&lt;child&gt;\">",+                       "    <data key=\"d0\">1537660132000</data>",+                       "    <data key=\"d1\">2018-09-23T08:48:52.000+09:00</data>",+                       "    <data key=\"d3\">540</data>",+                       "    <data key=\"d4\">false</data>",+                       "    <data key=\"d5\"></data>",+                       "    <data key=\"d2\">false</data>",+                       "  </node>",+                       "  <edge source=\"&quot;the root&quot;\" target=\"☃\" directed=\"true\">",+                       "    <data key=\"d6\">100</data>",+                       "    <data key=\"d7\">1970-01-01T00:00:00.100</data>",+                       "  </edge>",+                       "  <edge source=\"&lt;child&gt;\" target=\"&quot;the root&quot;\" directed=\"false\">",+                       "    <data key=\"d6\">1537660132000</data>",+                       "    <data key=\"d7\">2018-09-23T08:48:52.000+09:00</data>",+                       "    <data key=\"d8\">540</data>",+                       "    <data key=\"d9\">false</data>",+                       "    <data key=\"d10\"></data>",+                       "  </edge>",+                       "</graph>",+                       "</graphml>"+                     ]+          got = writeGraphML (nodes, links)+      -- TLIO.putStrLn got+      got `shouldBe` expected+    specify "with attributes" $ do+      let nodes :: [SnapshotNode Int Att1]+          nodes = [ SnapshotNode+                    { _nodeId = 100,+                      _isOnBoundary = False,+                      _nodeTimestamp = Just $ fromEpochMillisecond 155,+                      _nodeAttributes = Just $ Att1+                                        { at1Hoge = 99,+                                          at1Foo = "new\nline",+                                          at1Buzz = False+                                        }+                    },+                    SnapshotNode+                    { _nodeId = 200,+                      _isOnBoundary = False,+                      _nodeTimestamp = Nothing,+                      _nodeAttributes = Just $ Att1+                                        { at1Hoge = 2099,+                                          at1Foo = "",+                                          at1Buzz = True+                                        }+                    }+                  ]+          links :: [SnapshotLink Int Att2]+          links = [ SnapshotLink+                    { _sourceNode = 100,+                      _destinationNode = 200,+                      _isDirected = True,+                      _linkTimestamp = fromEpochMillisecond 155,+                      _linkAttributes = Att2+                                        { at2_quux = 109.25,+                                          at2_huga = "HUGA"+                                        }+                    +                    }+                  ]+          expected = mconcat $ map (<> "\n")+                     [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>",+                       "<graphml xmlns=\"http://graphml.graphdrawing.org/xmlns\"",+                       " xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"",+                       " xsi:schemaLocation=\"http://graphml.graphdrawing.org/xmlns http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd\">",+                       "<key id=\"d0\" for=\"node\" attr.name=\"@timestamp\" attr.type=\"long\"/>",+                       "<key id=\"d1\" for=\"node\" attr.name=\"@timestamp_str\" attr.type=\"string\"/>",+                       "<key id=\"d2\" for=\"node\" attr.name=\"@is_on_boundary\" attr.type=\"boolean\"/>",+                       "<key id=\"d3\" for=\"node\" attr.name=\"hoge\" attr.type=\"int\"/>",+                       "<key id=\"d4\" for=\"node\" attr.name=\"foo\" attr.type=\"string\"/>",+                       "<key id=\"d5\" for=\"node\" attr.name=\"buzz\" attr.type=\"boolean\"/>",+                       "<key id=\"d6\" for=\"edge\" attr.name=\"@timestamp\" attr.type=\"long\"/>",+                       "<key id=\"d7\" for=\"edge\" attr.name=\"@timestamp_str\" attr.type=\"string\"/>",+                       "<key id=\"d8\" for=\"edge\" attr.name=\"at2_huga\" attr.type=\"string\"/>",+                       "<key id=\"d9\" for=\"edge\" attr.name=\"at2_quux\" attr.type=\"double\"/>",+                       "<graph edgedefault=\"directed\">",+                       "  <node id=\"100\">",+                       "    <data key=\"d0\">155</data>",+                       "    <data key=\"d1\">1970-01-01T00:00:00.155</data>",+                       "    <data key=\"d2\">false</data>",+                       "    <data key=\"d3\">99</data>",+                       "    <data key=\"d4\">new&#x0a;line</data>",+                       "    <data key=\"d5\">false</data>",+                       "  </node>",+                       "  <node id=\"200\">",+                       "    <data key=\"d2\">false</data>",+                       "    <data key=\"d3\">2099</data>",+                       "    <data key=\"d4\"></data>",+                       "    <data key=\"d5\">true</data>",+                       "  </node>",+                       "  <edge source=\"100\" target=\"200\" directed=\"true\">",+                       "    <data key=\"d6\">155</data>",+                       "    <data key=\"d7\">1970-01-01T00:00:00.155</data>",+                       "    <data key=\"d8\">HUGA</data>",+                       "    <data key=\"d9\">109.25</data>",+                       "  </edge>",+                       "</graph>",+                       "</graphml>"+                     ]+          got = writeGraphML (nodes, links)+      -- TLIO.putStrLn got+      got `shouldBe` expected+  describe "writeGraphMLWith" $ do+    specify "woptDefaultDirected = False" $ do+      let nodes :: [SnapshotNode Text ()]+          nodes = [ SnapshotNode+                    { _nodeId = "n1",+                      _isOnBoundary = False,+                      _nodeTimestamp = Just $ fromEpochMillisecond 200,+                      _nodeAttributes = Just ()+                    },+                    SnapshotNode+                    { _nodeId = "n2",+                      _isOnBoundary = False,+                      _nodeTimestamp = Nothing,+                      _nodeAttributes = Nothing+                    }+                  ]+          links :: [SnapshotLink Text ()]+          links = [ SnapshotLink+                    { _sourceNode = "n1",+                      _destinationNode = "n2",+                      _isDirected = True,+                      _linkTimestamp = fromEpochMillisecond 200,+                      _linkAttributes = ()+                    }+                  ]+          expected = mconcat $ map (<> "\n")+                     [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>",+                       "<graphml xmlns=\"http://graphml.graphdrawing.org/xmlns\"",+                       " xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"",+                       " xsi:schemaLocation=\"http://graphml.graphdrawing.org/xmlns http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd\">",+                       "<key id=\"d0\" for=\"node\" attr.name=\"@timestamp\" attr.type=\"long\"/>",+                       "<key id=\"d1\" for=\"node\" attr.name=\"@timestamp_str\" attr.type=\"string\"/>",+                       "<key id=\"d2\" for=\"node\" attr.name=\"@is_on_boundary\" attr.type=\"boolean\"/>",+                       "<key id=\"d3\" for=\"edge\" attr.name=\"@timestamp\" attr.type=\"long\"/>",+                       "<key id=\"d4\" for=\"edge\" attr.name=\"@timestamp_str\" attr.type=\"string\"/>",+                       "<graph edgedefault=\"undirected\">",+                       "  <node id=\"n1\">",+                       "    <data key=\"d0\">200</data>",+                       "    <data key=\"d1\">1970-01-01T00:00:00.200</data>",+                       "    <data key=\"d2\">false</data>",+                       "  </node>",+                       "  <node id=\"n2\">",+                       "    <data key=\"d2\">false</data>",+                       "  </node>",+                       "  <edge source=\"n1\" target=\"n2\" directed=\"true\">",+                       "    <data key=\"d3\">200</data>",+                       "    <data key=\"d4\">1970-01-01T00:00:00.200</data>",+                       "  </edge>",+                       "</graph>",+                       "</graphml>"+                     ]+          opt = defWriteOption+                { woptDefaultDirected = False+                }+          got = writeGraphMLWith opt (nodes, links)+      got `shouldBe` expected