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 +24/−0
- net-spider.cabal +10/−4
- src/NetSpider/Found.hs +58/−8
- src/NetSpider/GraphML/Attribute.hs +103/−0
- src/NetSpider/GraphML/Writer.hs +10/−68
- src/NetSpider/Snapshot/Internal.hs +45/−2
- src/NetSpider/Timestamp.hs +53/−2
- test/JSONUtil.hs +24/−0
- test/NetSpider/FoundSpec.hs +49/−0
- test/NetSpider/SnapshotSpec.hs +43/−0
- test/NetSpider/TimestampSpec.hs +52/−0
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