packages feed

net-spider 0.4.0.1 → 0.4.1.0

raw patch · 11 files changed

+471/−84 lines, 11 filesdep +bytestringdep +regex-applicativedep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring, regex-applicative

Dependency ranges changed: time

API changes (from Hackage documentation)

- NetSpider.GraphML.Writer: instance GHC.Classes.Eq NetSpider.GraphML.Writer.AttributeValue
- NetSpider.GraphML.Writer: instance GHC.Classes.Ord NetSpider.GraphML.Writer.AttributeValue
- NetSpider.GraphML.Writer: instance GHC.Show.Show NetSpider.GraphML.Writer.AttributeValue
- NetSpider.GraphML.Writer: instance NetSpider.GraphML.Writer.ToAttributes ()
- NetSpider.GraphML.Writer: instance NetSpider.GraphML.Writer.ToAttributes [(NetSpider.GraphML.Writer.AttributeKey, NetSpider.GraphML.Writer.AttributeValue)]
- NetSpider.GraphML.Writer: instance NetSpider.GraphML.Writer.ToAttributes a => NetSpider.GraphML.Writer.ToAttributes (GHC.Maybe.Maybe a)
+ NetSpider.Found: instance (Data.Aeson.Types.FromJSON.FromJSON n, Data.Aeson.Types.FromJSON.FromJSON la) => Data.Aeson.Types.FromJSON.FromJSON (NetSpider.Found.FoundLink n la)
+ NetSpider.Found: instance (Data.Aeson.Types.FromJSON.FromJSON n, Data.Aeson.Types.FromJSON.FromJSON na, Data.Aeson.Types.FromJSON.FromJSON la) => Data.Aeson.Types.FromJSON.FromJSON (NetSpider.Found.FoundNode n na la)
+ NetSpider.Found: instance (Data.Aeson.Types.ToJSON.ToJSON n, Data.Aeson.Types.ToJSON.ToJSON la) => Data.Aeson.Types.ToJSON.ToJSON (NetSpider.Found.FoundLink n la)
+ NetSpider.Found: instance (Data.Aeson.Types.ToJSON.ToJSON n, Data.Aeson.Types.ToJSON.ToJSON na, Data.Aeson.Types.ToJSON.ToJSON la) => Data.Aeson.Types.ToJSON.ToJSON (NetSpider.Found.FoundNode n na la)
+ NetSpider.Found: instance (GHC.Classes.Ord n, GHC.Classes.Ord la, GHC.Classes.Ord na) => GHC.Classes.Ord (NetSpider.Found.FoundNode n na la)
+ NetSpider.Found: instance Data.Aeson.Types.FromJSON.FromJSON NetSpider.Found.LinkState
+ NetSpider.Found: instance Data.Aeson.Types.ToJSON.ToJSON NetSpider.Found.LinkState
+ NetSpider.Found: instance GHC.Generics.Generic (NetSpider.Found.FoundLink n la)
+ NetSpider.Found: instance GHC.Generics.Generic (NetSpider.Found.FoundNode n na la)
+ NetSpider.GraphML.Attribute: AttrBoolean :: Bool -> AttributeValue
+ NetSpider.GraphML.Attribute: AttrDouble :: Double -> AttributeValue
+ NetSpider.GraphML.Attribute: AttrFloat :: Float -> AttributeValue
+ NetSpider.GraphML.Attribute: AttrInt :: Int -> AttributeValue
+ NetSpider.GraphML.Attribute: AttrLong :: Integer -> AttributeValue
+ NetSpider.GraphML.Attribute: AttrString :: Text -> AttributeValue
+ NetSpider.GraphML.Attribute: attributesFromAeson :: Value -> Maybe [(AttributeKey, AttributeValue)]
+ NetSpider.GraphML.Attribute: attributesToAeson :: [(AttributeKey, AttributeValue)] -> Value
+ NetSpider.GraphML.Attribute: class ToAttributes a
+ NetSpider.GraphML.Attribute: data AttributeValue
+ NetSpider.GraphML.Attribute: instance Data.Aeson.Types.FromJSON.FromJSON NetSpider.GraphML.Attribute.AttributeValue
+ NetSpider.GraphML.Attribute: instance Data.Aeson.Types.ToJSON.ToJSON NetSpider.GraphML.Attribute.AttributeValue
+ NetSpider.GraphML.Attribute: instance GHC.Classes.Eq NetSpider.GraphML.Attribute.AttributeValue
+ NetSpider.GraphML.Attribute: instance GHC.Classes.Ord NetSpider.GraphML.Attribute.AttributeValue
+ NetSpider.GraphML.Attribute: instance GHC.Show.Show NetSpider.GraphML.Attribute.AttributeValue
+ NetSpider.GraphML.Attribute: instance NetSpider.GraphML.Attribute.ToAttributes ()
+ NetSpider.GraphML.Attribute: instance NetSpider.GraphML.Attribute.ToAttributes Data.Time.LocalTime.Internal.TimeZone.TimeZone
+ NetSpider.GraphML.Attribute: instance NetSpider.GraphML.Attribute.ToAttributes [(NetSpider.GraphML.Attribute.AttributeKey, NetSpider.GraphML.Attribute.AttributeValue)]
+ NetSpider.GraphML.Attribute: instance NetSpider.GraphML.Attribute.ToAttributes a => NetSpider.GraphML.Attribute.ToAttributes (GHC.Maybe.Maybe a)
+ NetSpider.GraphML.Attribute: toAttributes :: ToAttributes a => a -> [(AttributeKey, AttributeValue)]
+ NetSpider.GraphML.Attribute: type AttributeKey = Text
+ NetSpider.GraphML.Attribute: valueFromAeson :: Value -> Maybe AttributeValue
+ NetSpider.Snapshot.Internal: instance (Data.Aeson.Types.FromJSON.FromJSON n, Data.Aeson.Types.FromJSON.FromJSON la) => Data.Aeson.Types.FromJSON.FromJSON (NetSpider.Snapshot.Internal.SnapshotLink n la)
+ NetSpider.Snapshot.Internal: instance (Data.Aeson.Types.FromJSON.FromJSON n, Data.Aeson.Types.FromJSON.FromJSON na) => Data.Aeson.Types.FromJSON.FromJSON (NetSpider.Snapshot.Internal.SnapshotNode n na)
+ NetSpider.Snapshot.Internal: instance (Data.Aeson.Types.ToJSON.ToJSON n, Data.Aeson.Types.ToJSON.ToJSON la) => Data.Aeson.Types.ToJSON.ToJSON (NetSpider.Snapshot.Internal.SnapshotLink n la)
+ NetSpider.Snapshot.Internal: instance (Data.Aeson.Types.ToJSON.ToJSON n, Data.Aeson.Types.ToJSON.ToJSON na) => Data.Aeson.Types.ToJSON.ToJSON (NetSpider.Snapshot.Internal.SnapshotNode n na)
+ NetSpider.Snapshot.Internal: instance GHC.Generics.Generic (NetSpider.Snapshot.Internal.SnapshotLink n la)
+ NetSpider.Snapshot.Internal: instance GHC.Generics.Generic (NetSpider.Snapshot.Internal.SnapshotNode n na)
+ NetSpider.Timestamp: instance Data.Aeson.Types.FromJSON.FromJSON NetSpider.Timestamp.Timestamp
+ NetSpider.Timestamp: instance Data.Aeson.Types.ToJSON.ToJSON NetSpider.Timestamp.Timestamp
+ NetSpider.Timestamp: instance NetSpider.GraphML.Attribute.ToAttributes NetSpider.Timestamp.Timestamp

Files

ChangeLog.md view
@@ -1,5 +1,29 @@ # Revision history for net-spider +## 0.4.1.0  -- 2020-01-26++* Add `GraphML.Attribute` module. `AttributeValue` and related types+  in `GraphML.Writer` module are moved to `GraphML.Attribute` module.+* Add `ToAttributes` instance to `TimeZone`.+* Add `FromJSON` and `ToJSON` instances to `AttributeValue`.+* Add `attributesToAeson` function.++### Timestamp module++* Add `FromJSON`, `ToJSON` and `ToAttributes` instances to+  `Timestamp`.++### Found module++* Add `FromJSON` and `ToJSON` instances to `LinkState`, `FoundLink`+  and `FoundNode`.+* Add `Ord` instance to `FoundNode`.++### Snapshot module++* Add `FromJSON` and `ToJSON` instances to `SnapshotLink` and+  `SnapshotNode`.+ ## 0.4.0.1  -- 2019-12-29  * Confirm test with `data-interval-2.0.1`.
net-spider.cabal view
@@ -1,5 +1,5 @@ name:                   net-spider-version:                0.4.0.1+version:                0.4.1.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> license:                BSD3@@ -43,6 +43,7 @@                         NetSpider.Log,                         NetSpider.Snapshot.Internal,                         NetSpider.GraphML.Writer,+                        NetSpider.GraphML.Attribute,                         NetSpider.Interval   other-modules:        NetSpider.Graph.Internal,                         NetSpider.Spider.Internal.Graph,@@ -64,7 +65,8 @@                         data-interval >=1.3.0 && <2.1,                         extended-reals >=0.2.3.0 && <0.3,                         monad-logger >=0.3.28.1 && <0.4,-                        scientific >=0.3.6.2 && <0.4+                        scientific >=0.3.6.2 && <0.4,+                        regex-applicative >=0.3.3 && <0.4  -- executable net-spider --   default-language:     Haskell2010@@ -85,8 +87,12 @@   -- default-extensions:      other-extensions:     OverloadedStrings,                         DeriveGeneric-  other-modules:        NetSpider.GraphML.WriterSpec-  build-depends:        base, net-spider, vector, text, aeson,+  other-modules:        NetSpider.GraphML.WriterSpec,+                        NetSpider.TimestampSpec,+                        NetSpider.FoundSpec,+                        NetSpider.SnapshotSpec,+                        JSONUtil+  build-depends:        base, net-spider, vector, text, aeson, bytestring, time,                         hspec >=2.4.4  flag server-test
src/NetSpider/Found.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} -- | -- Module: NetSpider.Found -- Description: Types about local findings@@ -13,9 +13,15 @@          linkStateFromText        ) where +import qualified Control.Monad.Fail as Fail+import Data.Aeson (FromJSON(..), ToJSON(..))+import qualified Data.Aeson as Aeson import Data.Bifunctor (Bifunctor(..))+import Data.Char (isUpper, toLower) import Data.Greskell (FromGraphSON(..)) import Data.Text (Text, unpack)+import GHC.Generics (Generic)+import qualified Text.Regex.Applicative as RE  import NetSpider.Timestamp (Timestamp) @@ -46,13 +52,37 @@   "bidirectional" -> Just LinkBidirectional   _ -> Nothing +linkStateFromTextF :: Fail.MonadFail m => Text -> m LinkState+linkStateFromTextF t = +  case linkStateFromText t of+    Just ls -> return ls+    Nothing -> Fail.fail ("Unrecognized LinkState: " ++ unpack t)+ instance FromGraphSON LinkState where-  parseGraphSON gv = fromText =<< parseGraphSON gv-    where-      fromText t = case linkStateFromText t of-        Just ls -> return ls-        Nothing -> fail ("Unrecognized LinkState: " ++ unpack t)+  parseGraphSON gv = linkStateFromTextF =<< parseGraphSON gv +-- | Parse a JSON string to 'LinkState'.+--+-- @since 0.4.1.0+instance FromJSON LinkState where+  parseJSON v = linkStateFromTextF =<< parseJSON v++-- | Convert 'LinkState' to a JSON string.+--+-- @since 0.4.1.0+instance ToJSON LinkState where+  toJSON = toJSON . linkStateToText++aesonOpt :: Aeson.Options+aesonOpt = Aeson.defaultOptions+           { Aeson.fieldLabelModifier = modifier+           }+  where+    modifier = RE.replace reSnake . RE.replace reAttr+    reAttr = fmap (const "Attrs") $ RE.string "Attributes"+    reSnake = RE.msym $ \c -> if isUpper c then Just ['_', toLower c] else Nothing++ -- | A link found at a 'FoundNode'. The link connects from the subject -- node (the found node) to the target node. The link may be -- directional or non-directional.@@ -65,7 +95,7 @@     linkState :: LinkState,     linkAttributes :: la   }-  deriving (Show,Eq,Ord)+  deriving (Show,Eq,Ord,Generic)  -- | @since 0.3.0.0 instance Functor (FoundLink n) where@@ -77,12 +107,23 @@                        linkAttributes = fla $ linkAttributes l                      } +-- | @since 0.4.1.0+instance (FromJSON n, FromJSON la) => FromJSON (FoundLink n la) where+  parseJSON = Aeson.genericParseJSON aesonOpt++-- | @since 0.4.1.0+instance (ToJSON n, ToJSON la) => ToJSON (FoundLink n la) where+  toJSON = Aeson.genericToJSON aesonOpt+  toEncoding = Aeson.genericToEncoding aesonOpt+ -- | 'FoundNode' is a node (the subject node) observed at a specific -- time. It has a set of neighbor links found at the moment. -- -- - type @n@: node ID. -- - type @na@: node attributes. -- - type @la@: link attributes.+--+-- 'Ord' instance is added in net-spider-0.4.1.0. data FoundNode n na la =   FoundNode   { subjectNode :: n,@@ -90,7 +131,7 @@     neighborLinks :: [FoundLink n la],     nodeAttributes :: na   }-  deriving (Show,Eq)+  deriving (Show,Eq,Ord,Generic)  -- | @since 0.3.0.0 instance Functor (FoundNode n na) where@@ -101,3 +142,12 @@   bimap fna fla n = n { neighborLinks = (fmap . fmap) fla $ neighborLinks n,                         nodeAttributes = fna $ nodeAttributes n                       }++-- | @since 0.4.1.0+instance (FromJSON n, FromJSON na, FromJSON la) => FromJSON (FoundNode n na la) where+  parseJSON = Aeson.genericParseJSON aesonOpt++-- | @since 0.4.1.0+instance (ToJSON n, ToJSON na, ToJSON la) => ToJSON (FoundNode n na la) where+  toJSON = Aeson.genericToJSON aesonOpt+  toEncoding = Aeson.genericToEncoding aesonOpt
+ src/NetSpider/GraphML/Attribute.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}+-- |+-- Module: NetSpider.GraphML.Attribute+-- Description: GraphML attribute types+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- @since 0.4.1.0+module NetSpider.GraphML.Attribute+  ( AttributeKey,+    AttributeValue(..),+    ToAttributes(..),+    valueFromAeson,+    attributesFromAeson,+    attributesToAeson+  ) where++import Control.Applicative (empty)+import Data.Aeson (FromJSON(..), ToJSON(..))+import qualified Data.Aeson as Aeson+import qualified Data.HashMap.Strict as HM+import qualified Data.Scientific as Sci+import Data.Text (Text, pack)+import Data.Time (TimeZone(..))++-- | 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)++-- | Based on 'valueFromAeson'.+--+-- @since 0.4.1.0+instance FromJSON AttributeValue where+  parseJSON v = maybe empty return $ valueFromAeson v++-- | @since 0.4.1.0+instance ToJSON AttributeValue where+  toJSON v =+    case v of+      AttrBoolean b -> toJSON b+      AttrInt i -> toJSON i+      AttrLong l -> toJSON l+      AttrFloat f -> toJSON f+      AttrDouble d -> toJSON d+      AttrString t -> toJSON t++-- | 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++-- | 'Nothing' is mapped to empty attributes.+instance ToAttributes a => ToAttributes (Maybe a) where+  toAttributes Nothing = []+  toAttributes (Just a) = toAttributes a++-- | @since 0.4.1.0+instance ToAttributes TimeZone where+  toAttributes tz =+    [ ("@tz_offset_min", AttrInt $ timeZoneMinutes tz),+      ("@tz_summer_only", AttrBoolean $ timeZoneSummerOnly tz),+      ("@tz_name", AttrString $ pack $ timeZoneName tz)+    ]++-- | 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++-- | Make aeson 'Aeson.Object' as 'Aeson.Value' from attributes.+--+-- @since 0.4.1.0+attributesToAeson :: [(AttributeKey, AttributeValue)] -> Aeson.Value+attributesToAeson = Aeson.Object . HM.fromList . (fmap . fmap) toJSON
src/NetSpider/GraphML/Writer.hs view
@@ -22,7 +22,7 @@     NodeID,     ToNodeID(..),     nodeIDByShow,-    -- * Attributes+    -- * Attributes (re-exports)     AttributeKey,     AttributeValue(..),     ToAttributes(..),@@ -30,7 +30,6 @@     attributesFromAeson   ) where -import qualified Data.Aeson as Aeson import Data.Foldable (foldl') import Data.Greskell.Graph (Property(..)) import Data.Hashable (Hashable(..))@@ -39,7 +38,6 @@ 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@@ -48,6 +46,13 @@ import Data.Word (Word8, Word16, Word32, Word64) import GHC.Generics (Generic) +import NetSpider.GraphML.Attribute+  ( AttributeKey,+    AttributeValue(..),+    ToAttributes(..),+    valueFromAeson,+    attributesFromAeson+  ) import NetSpider.Snapshot   ( SnapshotNode, nodeId, nodeTimestamp, isOnBoundary, nodeAttributes,     SnapshotLink, sourceNode, destinationNode, linkTimestamp, isDirected, linkAttributes,@@ -118,55 +123,6 @@   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---- | '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 @@ -289,20 +245,6 @@     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 @@ -311,7 +253,7 @@   where     timestamp = case nodeTimestamp n of                   Nothing -> []-                  Just t -> timestampAttrs t+                  Just t -> toAttributes t     base = timestamp <> [("@is_on_boundary", AttrBoolean $ isOnBoundary n)]     attrs = toAttributes $ nodeAttributes n     convert (k, v) = makeMetaValue DomainNode k v@@ -322,7 +264,7 @@ linkMetaValues :: ToAttributes la => SnapshotLink n la -> [(KeyMeta, AttributeValue)] linkMetaValues l = map convert $ base <> attrs   where-    base = timestampAttrs $ linkTimestamp l+    base = toAttributes $ linkTimestamp l     attrs = toAttributes $ linkAttributes l     convert (k, v) = makeMetaValue DomainEdge k v 
src/NetSpider/Snapshot/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} -- | -- Module: NetSpider.Snapshot.Internal -- Description: Implementation of Snapshot graph types@@ -17,9 +18,15 @@          SnapshotNode(..)        ) where +import Control.Applicative (many, (*>))+import Data.Aeson (ToJSON(..), FromJSON(..))+import qualified Data.Aeson as Aeson import Data.Bifunctor (Bifunctor(..))+import Data.Char (isUpper, toLower)+import GHC.Generics (Generic) import NetSpider.Pair (Pair(..)) import NetSpider.Timestamp (Timestamp)+import qualified Text.Regex.Applicative as RE  -- | The snapshot graph, which is a collection nodes and links. --@@ -45,7 +52,7 @@     -- Maybe it's a good idea to include 'observationLogs', which can     -- contain warnings or other logs about making this SnapshotLink.   }-  deriving (Show,Eq)+  deriving (Show,Eq,Generic)  -- | Comparison by node-tuple (source node, destination node). instance (Ord n, Eq la) => Ord (SnapshotLink n la) where@@ -62,6 +69,32 @@                        _destinationNode = fn $ _destinationNode l                      } +aesonOpt :: Aeson.Options+aesonOpt = Aeson.defaultOptions+           { Aeson.fieldLabelModifier = modifier+           }+  where+    modifier = RE.replace reSnake . RE.replace reAttr . RE.replace reDest . RE.replace reTime+    reDest = fmap (const "dest") $ RE.string "destination"+    reAttr = fmap (const "Attrs") $ RE.string "Attributes"+    reTime = fmap (const "timestamp") (many RE.anySym *> RE.string "Timestamp")+    reSnake = RE.msym $ \c ->+      if c == '_'+      then Just ""+      else if isUpper c+           then Just ['_', toLower c]+           else Nothing++-- | @since 0.4.1.0+instance (FromJSON n, FromJSON la) => FromJSON (SnapshotLink n la) where+  parseJSON = Aeson.genericParseJSON aesonOpt++-- | @since 0.4.1.0+instance (ToJSON n, ToJSON la) => ToJSON (SnapshotLink n la) where+  toJSON = Aeson.genericToJSON aesonOpt+  toEncoding = Aeson.genericToEncoding aesonOpt+  + -- | Node-tuple (source node, destination node) of the link. linkNodeTuple :: SnapshotLink n la -> (n, n) linkNodeTuple link = (_sourceNode link, _destinationNode link)@@ -78,7 +111,7 @@     _nodeTimestamp :: Maybe Timestamp,     _nodeAttributes :: Maybe na   }-  deriving (Show,Eq)+  deriving (Show,Eq,Generic)  -- | Comparison by node ID. instance (Ord n, Eq na) => Ord (SnapshotNode n na) where@@ -93,3 +126,13 @@   bimap fn fna n = n { _nodeAttributes = fmap fna $ _nodeAttributes n,                        _nodeId = fn $ _nodeId n                      }++-- | @since 0.4.1.0+instance (FromJSON n, FromJSON na) => FromJSON (SnapshotNode n na) where+  parseJSON = Aeson.genericParseJSON aesonOpt++-- | @since 0.4.1.0+instance (ToJSON n, ToJSON na) => ToJSON (SnapshotNode n na) where+  toJSON = Aeson.genericToJSON aesonOpt+  toEncoding = Aeson.genericToEncoding aesonOpt+
src/NetSpider/Timestamp.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | -- Module: NetSpider.Timestamp -- Description: Timestamp type@@ -26,12 +27,15 @@          showEpochTime        ) where -import Control.Applicative ((<$>), (<*>), (<*), (*>), optional)+import Control.Applicative ((<$>), (<*>), (<*), (*>), optional, empty)+import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), (.:), (.=))+import qualified Data.Aeson as Aeson import Data.Char (isDigit) import Data.Int (Int64) import Data.List (sortOn) import Data.Monoid ((<>))-import Data.Text (Text, pack)+import Data.Text (Text, pack, unpack)+import qualified Data.Text as Text import Data.Time.Calendar (Day, fromGregorian) import Data.Time.Clock (UTCTime) import Data.Time.Clock.System (utcToSystemTime, SystemTime(..), systemToUTCTime)@@ -45,6 +49,11 @@ import Text.Read (readEither) import Text.Printf (printf) +import NetSpider.GraphML.Attribute+  ( ToAttributes(..),+    AttributeValue(..)+  )+ -- | Timestamp when graph elements are observed. data Timestamp =   Timestamp@@ -58,6 +67,48 @@ -- | Compare by 'epochTime' only. 'timeZone' is not used. instance Ord Timestamp where   compare l r = compare (epochTime l) (epochTime r)+++-- | It can parse JSON string or object. If the input is a JSON+-- string, it is parsed by 'parseTimestamp'.+--+-- @since 0.4.1.0+instance FromJSON Timestamp where+  parseJSON (String t) = maybe (fail err_msg) return $ parseTimestamp ts+    where+      ts = unpack t+      err_msg = "Invalid Timestamp string: " ++ ts+  parseJSON (Object o) = Timestamp <$> (o .: "epoch_time") <*> parseTZ o+    where+      parseTZ ob = optional $ TimeZone+                   <$> (ob .: "tz_offset_min")+                   <*> (ob .: "tz_summer_only")+                   <*> (ob .: "tz_name")+  parseJSON _ = empty+  +++-- | Convert to a JSON object.+--+-- @since 0.4.1.0+instance ToJSON Timestamp where+  toJSON t = Aeson.object $+             [ "epoch_time" .= epochTime t+             ]+             ++ tz_fields+    where+      tz_fields = (fmap . fmap) toJSON $ map fixKeyPrefix $ toAttributes $ timeZone t+      fixKeyPrefix (k, v) = (Text.tail k, v)+++-- | @since 0.4.1.0+instance ToAttributes Timestamp where+  toAttributes t =+    [ ("@timestamp", AttrLong $ toInteger $ epochTime t),+      ("@timestamp_str", AttrString $ showTimestamp t)+    ] ++ timezone_attrs+    where+      timezone_attrs = maybe [] toAttributes $ timeZone t  -- | Make 'Timestamp' from milliseconds from the epoch. 'timeZone' is -- 'Nothing'.
+ test/JSONUtil.hs view
@@ -0,0 +1,24 @@+module JSONUtil+  ( specJSONFromTo+  ) where++import Data.Aeson (FromJSON, ToJSON)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as BSL+import Data.Either (isRight)+import Test.Hspec++specJSONFromTo :: (FromJSON a, ToJSON a, Show a, Eq a)+               => String -- ^ spec name+               -> BSL.ByteString -- ^ JSON document+               -> a -- ^ expected data+               -> Spec+specJSONFromTo spec_name json_doc exp_data = do+  specify ("JSONFromTo: " ++ spec_name) $ do+    let got_dec = Aeson.eitherDecode json_doc+        got_enc_v :: Either String Aeson.Value+        got_enc_v = Aeson.eitherDecode $ Aeson.encode exp_data+        exp_enc = Aeson.eitherDecode json_doc+    got_dec `shouldBe` Right exp_data+    isRight exp_enc `shouldBe` True+    got_enc_v `shouldBe` exp_enc
+ test/NetSpider/FoundSpec.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}+module NetSpider.FoundSpec (main,spec) where++import qualified Data.Aeson as Aeson+import Data.Monoid ((<>))+import Data.Text (Text)+import Test.Hspec++import JSONUtil (specJSONFromTo)++import NetSpider.Found (FoundLink(..), LinkState(..), FoundNode(..))+import NetSpider.Timestamp (fromEpochMillisecond)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "FoundLink" $ do+    specJSONFromTo+      "Int attribute"+      "{\"target_node\":\"target\", \"link_state\": \"to_target\", \"link_attrs\":125}"+      FoundLink+      { targetNode = ("target" :: Text),+        linkState = LinkToTarget,+        linkAttributes = (125 :: Int)+      }+  describe "FoundNode" $ do+    specJSONFromTo+      "Text attribute, () attribute (encoded as an empty array [])"+      (    "{\"subject_node\": \"foobar\","+        <> " \"found_at\": {\"epoch_time\": 99200},"+        <> " \"node_attrs\": \"hoge\","+        <> " \"neighbor_links\": ["+        <> "   {\"target_node\": \"quux\", \"link_state\": \"to_subject\", \"link_attrs\": []}"+        <> " ]}"+      )+      FoundNode+      { subjectNode = ("foobar" :: Text),+        foundAt = fromEpochMillisecond 99200,+        nodeAttributes = ("hoge" :: Text),+        neighborLinks =+          [ FoundLink+            { targetNode = ("quux" :: Text),+              linkState = LinkToSubject,+              linkAttributes = ()+            }+          ]+      }
+ test/NetSpider/SnapshotSpec.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+module NetSpider.SnapshotSpec (main,spec) where++import Data.Monoid ((<>))+import Data.Text (Text)+import Test.Hspec++import JSONUtil (specJSONFromTo)++import NetSpider.Timestamp (fromEpochMillisecond)+import NetSpider.Snapshot.Internal (SnapshotLink(..), SnapshotNode(..))++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "SnapshotLink" $ do+    specJSONFromTo+      "Text ID, () link attribute"+      (    "{\"source_node\": \"s\", \"dest_node\": \"d\","+        <> " \"is_directed\": false, \"link_attrs\": [],"+        <> " \"timestamp\": {\"epoch_time\": 5000} }"+      )+      SnapshotLink+      { _sourceNode = ("s" :: Text),+        _destinationNode = ("d" :: Text),+        _isDirected = False,+        _linkTimestamp = fromEpochMillisecond 5000,+        _linkAttributes = ()+      }+  describe "SnapshotNode" $ do+    specJSONFromTo+      "Int ID, null timestamp, Text attribute"+      (    "{\"node_id\": 999, \"is_on_boundary\": true,"+        <> " \"timestamp\": null, \"node_attrs\": \"foobar\"}"+      )+      SnapshotNode+      { _nodeId = (999 :: Int),+        _isOnBoundary = True,+        _nodeTimestamp = Nothing,+        _nodeAttributes = Just ("foobar" :: Text)+      }
+ test/NetSpider/TimestampSpec.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+module NetSpider.TimestampSpec (main,spec) where++import Data.Aeson (encode, eitherDecode, ToJSON(..))+import qualified Data.ByteString.Lazy as BSL+import Data.Time (TimeZone(..))+import Test.Hspec++import NetSpider.Timestamp (Timestamp(..), fromS, fromEpochMillisecond)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "FromJSON and ToJSON" $ do+    specTS $ fromS "2019-12-31T18:46"+    specTS $ fromS "2019-12-31T18:46:10"+    specTS $ fromS "2019-12-31 18:46:11.037"+    specTS $ fromS "2019-09-21T00:32Z"+    specTS $ fromS "2019-08-07 11:18:43+07:00"+    specTS $ fromS "2019-08-07T11:18:43.112-02:30"+  describe "ToJSON" $ do+    specToJSON (fromEpochMillisecond 1000) "{\"epoch_time\":1000}"+    specToJSON (fromS "2019-09-21T00:32Z")+      "{\"epoch_time\":1569025920000, \"tz_offset_min\": 0, \"tz_summer_only\":false, \"tz_name\":\"UTC\"}"+    specToJSON (fromS "2019-08-07 11:18:43+07:00")+      "{\"epoch_time\":1565151523000, \"tz_offset_min\": 420, \"tz_summer_only\": false, \"tz_name\":\"\"}"+  describe "FromJSON - string" $ do+    specFromJSON "\"2019-12-31 18:46:11.037\"" (Timestamp 1577817971037 Nothing)+    specFromJSON "\"2020-08-07T11:18:43.112-02:30\"" (Timestamp 1596808123112 $ Just $ TimeZone (-150) False "")+  describe "FromJSON - object" $ do+    specFromJSON "{\"epoch_time\": 1000}" (Timestamp 1000 Nothing)+    specFromJSON "{\"epoch_time\": 1000, \"tz_offset_min\": 180, \"tz_summer_only\": true, \"tz_name\": \"\"}"+      (Timestamp 1000 $ Just $ TimeZone 180 True "")+    specFromJSON "{\"epoch_time\": 1000, \"tz_offset_min\": 0, \"tz_summer_only\": false, \"tz_name\": \"UTC\"}"+      (Timestamp 1000 $ Just $ TimeZone 0 False "UTC")+    ++specTS :: Timestamp -> Spec+specTS t = specify (show t) $ do+  (eitherDecode $ encode t) `shouldBe` Right t++specToJSON :: Timestamp -> BSL.ByteString -> Spec+specToJSON input_ts expected = do+  specify (show input_ts) $ do+    (Right $ toJSON input_ts) `shouldBe` (eitherDecode expected)++specFromJSON :: BSL.ByteString -> Timestamp -> Spec+specFromJSON input expected = do+  specify (show input) $ do+    eitherDecode input `shouldBe` Right expected