diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,35 @@ # Revision history for net-spider +## 0.3.0.0 -- 2019-05-03 + +* Export `Snapshot.Internal` module. This module is only for internal + use. + +* **[BREAKING CHANGE]** Use StrictData extension by default. This changes the strictness of the following data types. + + * `Query` (from Query module) + * `Config` (from Spider.Config module) + * `UnifyStdConfig` (from Unify module) + +### Found module + +* Add `Functor` and `Bifunctor` instances to `FoundNode` and + `FoundLink.` + +### Graph module + +* Add `NodeAttributes` instance to `PropertyMapList`. +* Add `LinkAttributes` instance to `PropertyMapSingle`. + +### Query module + +* **[BREAKING CHANGE]** `Query` data type is now strict. + +### Snapshot module + +* Add `Functor` and `Bifunctor` instances to `SnapshotNode` and + `SnapshotLink.` + ## 0.2.0.0 -- 2018-12-10 * Add `Log` module. diff --git a/net-spider.cabal b/net-spider.cabal --- a/net-spider.cabal +++ b/net-spider.cabal @@ -1,5 +1,5 @@ name: net-spider -version: 0.2.0.0 +version: 0.3.0.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -17,10 +17,11 @@ default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall -fno-warn-unused-imports - -- default-extensions: + default-extensions: StrictData other-extensions: OverloadedStrings, GeneralizedNewtypeDeriving, - TypeFamilies + TypeFamilies, + FlexibleInstances exposed-modules: NetSpider, NetSpider.Input, NetSpider.Output, @@ -33,9 +34,9 @@ NetSpider.Graph, NetSpider.Pair, NetSpider.Query, - NetSpider.Log - other-modules: NetSpider.Snapshot.Internal, - NetSpider.Graph.Internal, + NetSpider.Log, + NetSpider.Snapshot.Internal + other-modules: NetSpider.Graph.Internal, NetSpider.Spider.Internal.Graph, NetSpider.Spider.Internal.Log, NetSpider.Spider.Internal.Spider, @@ -45,7 +46,7 @@ time >=1.8.0.2 && <1.10, vector >=0.12.0.1 && <0.13, greskell-websocket >=0.1.1 && <0.2, - greskell >=0.2.2 && <0.3, + greskell >=0.2.3 && <0.3, aeson >=1.2.4 && <1.5, safe-exceptions >=0.1.6 && <0.2, text >=1.2.2.2 && <1.3, diff --git a/src/NetSpider/Found.hs b/src/NetSpider/Found.hs --- a/src/NetSpider/Found.hs +++ b/src/NetSpider/Found.hs @@ -13,6 +13,7 @@ linkStateFromText ) where +import Data.Bifunctor (Bifunctor(..)) import Data.Greskell (FromGraphSON(..)) import Data.Text (Text, unpack) @@ -60,12 +61,22 @@ -- - type @la@: link attributes. data FoundLink n la = FoundLink - { targetNode :: !n, - linkState :: !LinkState, - linkAttributes :: !la + { targetNode :: n, + linkState :: LinkState, + linkAttributes :: la } deriving (Show,Eq,Ord) +-- | @since 0.3.0.0 +instance Functor (FoundLink n) where + fmap f l = l { linkAttributes = f $ linkAttributes l } + +-- | @since 0.3.0.0 +instance Bifunctor FoundLink where + bimap fn fla l = l { targetNode = fn $ targetNode l, + linkAttributes = fla $ linkAttributes l + } + -- | 'FoundNode' is a node (the subject node) observed at a specific -- time. It has a set of neighbor links found at the moment. -- @@ -74,9 +85,19 @@ -- - type @la@: link attributes. data FoundNode n na la = FoundNode - { subjectNode :: !n, - foundAt :: !Timestamp, - neighborLinks :: ![FoundLink n la], - nodeAttributes :: !na + { subjectNode :: n, + foundAt :: Timestamp, + neighborLinks :: [FoundLink n la], + nodeAttributes :: na } deriving (Show,Eq) + +-- | @since 0.3.0.0 +instance Functor (FoundNode n na) where + fmap f n = n { neighborLinks = (fmap . fmap) f $ neighborLinks n } + +-- | @since 0.3.0.0 +instance Bifunctor (FoundNode n) where + bimap fna fla n = n { neighborLinks = (fmap . fmap) fla $ neighborLinks n, + nodeAttributes = fna $ nodeAttributes n + } diff --git a/src/NetSpider/Graph/Internal.hs b/src/NetSpider/Graph/Internal.hs --- a/src/NetSpider/Graph/Internal.hs +++ b/src/NetSpider/Graph/Internal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, OverloadedStrings, FlexibleInstances #-} -- | -- Module: NetSpider.Graph.Internal -- Description: @@ -25,8 +25,11 @@ AVertexProperty(..), AVertex(..), AProperty, AEdge(..), Walk, SideEffect, Binder, Parser, PropertyMapList, PropertyMapSingle, GValue, - gIdentity + gIdentity, gProperty, + newBind, allProperties, propertyKey, propertyValue ) +import qualified Data.Greskell as Greskell +import Data.Greskell.Extra (writeAllProperties) import Data.Text (Text, unpack) import Data.Time.LocalTime (TimeZone(..)) @@ -57,9 +60,9 @@ -- | The \"found_node\" vertex. data VFoundNode na = VFoundNode - { vfnId :: !EID, - vfnTimestamp :: !Timestamp, - vfnAttributes :: !na + { vfnId :: EID, + vfnTimestamp :: Timestamp, + vfnAttributes :: na } deriving (Show) @@ -105,10 +108,10 @@ -- | \"finds\" edge. data EFinds la = EFinds - { efId :: !EID, - efTargetId :: !EID, - efLinkState :: !LinkState, - efLinkAttributes :: !la + { efId :: EID, + efTargetId :: EID, + efLinkState :: LinkState, + efLinkAttributes :: la } deriving (Show) @@ -143,6 +146,14 @@ writeNodeAttributes _ = return gIdentity parseNodeAttributes _ = return () +-- | Straightforward implementation. Note that 'writeNodeAttributes' +-- does not write meta-properties of the 'AVertexProperty'. +-- +-- @since 0.3.0.0 +instance (FromGraphSON v, ToJSON v) => NodeAttributes (PropertyMapList AVertexProperty v) where + writeNodeAttributes = writeAllProperties + parseNodeAttributes = traverse parseGraphSON + -- | Class of user-defined types for link attributes. Its content is -- stored in the NetSpider database. class LinkAttributes ps where @@ -155,4 +166,11 @@ instance LinkAttributes () where writeLinkAttributes _ = return gIdentity parseLinkAttributes _ = return () + +-- | Straightforward implementation +-- +-- @since 0.3.0.0 +instance (FromGraphSON v, ToJSON v) => LinkAttributes (PropertyMapSingle AProperty v) where + writeLinkAttributes = writeAllProperties + parseLinkAttributes = traverse parseGraphSON diff --git a/src/NetSpider/Snapshot/Internal.hs b/src/NetSpider/Snapshot/Internal.hs --- a/src/NetSpider/Snapshot/Internal.hs +++ b/src/NetSpider/Snapshot/Internal.hs @@ -1,9 +1,14 @@ -- | -- Module: NetSpider.Snapshot.Internal --- Description: +-- Description: Implementation of Snapshot graph types -- Maintainer: Toshio Ito -- -- __this module is internal. End-users should not use this.__ +-- +-- Implementation of Snapshot graph types. This module is for internal +-- and testing purposes only. +-- +-- @since 0.3.0.0 module NetSpider.Snapshot.Internal ( SnapshotLink(..), linkNodeTuple, @@ -11,6 +16,7 @@ SnapshotNode(..) ) where +import Data.Bifunctor (Bifunctor(..)) import NetSpider.Pair (Pair(..)) import NetSpider.Timestamp (Timestamp) @@ -24,11 +30,11 @@ -- - type @la@: link attributes. data SnapshotLink n la = SnapshotLink - { _sourceNode :: !n, - _destinationNode :: !n, - _isDirected :: !Bool, - _linkTimestamp :: !Timestamp, - _linkAttributes :: !la + { _sourceNode :: n, + _destinationNode :: n, + _isDirected :: Bool, + _linkTimestamp :: Timestamp, + _linkAttributes :: la -- Maybe it's a good idea to include 'observationLogs', which can -- contain warnings or other logs about making this SnapshotLink. @@ -39,6 +45,17 @@ instance (Ord n, Eq la) => Ord (SnapshotLink n la) where compare l r = compare (linkNodeTuple l) (linkNodeTuple r) +-- | @since 0.3.0.0 +instance Functor (SnapshotLink n) where + fmap f l = l { _linkAttributes = f $ _linkAttributes l } + +-- | @since 0.3.0.0 +instance Bifunctor SnapshotLink where + bimap fn fla l = l { _linkAttributes = fla $ _linkAttributes l, + _sourceNode = fn $ _sourceNode l, + _destinationNode = fn $ _destinationNode l + } + -- | Node-tuple (source node, destination node) of the link. linkNodeTuple :: SnapshotLink n la -> (n, n) linkNodeTuple link = (_sourceNode link, _destinationNode link) @@ -50,13 +67,23 @@ -- | A node in the snapshot graph. data SnapshotNode n na = SnapshotNode - { _nodeId :: !n, - _isOnBoundary :: !Bool, - _nodeTimestamp :: !(Maybe Timestamp), - _nodeAttributes :: !(Maybe na) + { _nodeId :: n, + _isOnBoundary :: Bool, + _nodeTimestamp :: Maybe Timestamp, + _nodeAttributes :: Maybe na } deriving (Show,Eq) -- | Comparison by node ID. instance (Ord n, Eq na) => Ord (SnapshotNode n na) where compare l r = compare (_nodeId l) (_nodeId r) + +-- | @since 0.3.0.0 +instance Functor (SnapshotNode n) where + fmap f n = n { _nodeAttributes = fmap f $ _nodeAttributes n } + +-- | @since 0.3.0.0 +instance Bifunctor SnapshotNode where + bimap fn fna n = n { _nodeAttributes = fmap fna $ _nodeAttributes n, + _nodeId = fn $ _nodeId n + } diff --git a/src/NetSpider/Spider.hs b/src/NetSpider/Spider.hs --- a/src/NetSpider/Spider.hs +++ b/src/NetSpider/Spider.hs @@ -281,11 +281,11 @@ -- | The state kept while making the snapshot graph. data SnapshotState n na fla = SnapshotState - { ssUnvisitedNodes :: !(Queue n), - ssVisitedNodes :: !(HashMap n (Maybe (VFoundNode na))), + { ssUnvisitedNodes :: Queue n, + ssVisitedNodes :: HashMap n (Maybe (VFoundNode na)), -- ^ If the visited node has no observation yet, its node -- attributes 'Nothing'. - ssVisitedLinks :: !(HashMap (LinkSampleID n) [LinkSample n fla]) + ssVisitedLinks :: HashMap (LinkSampleID n) [LinkSample n fla] } deriving (Show) diff --git a/src/NetSpider/Timestamp.hs b/src/NetSpider/Timestamp.hs --- a/src/NetSpider/Timestamp.hs +++ b/src/NetSpider/Timestamp.hs @@ -41,10 +41,10 @@ -- | Timestamp when graph elements are observed. data Timestamp = Timestamp - { epochTime :: !Int64, + { epochTime :: Int64, -- ^ Milliseconds since the epoch. The epoch is usually the -- beginning of year 1970. - timeZone :: !(Maybe TimeZone) + timeZone :: Maybe TimeZone } deriving (Show,Eq) diff --git a/src/NetSpider/Unify.hs b/src/NetSpider/Unify.hs --- a/src/NetSpider/Unify.hs +++ b/src/NetSpider/Unify.hs @@ -44,11 +44,11 @@ -- 'NetSpider.Snapshot.SnapshotLink's. data LinkSample n la = LinkSample - { lsSubjectNode :: !n, - lsTargetNode :: !n, - lsLinkState :: !LinkState, - lsTimestamp :: !Timestamp, - lsLinkAttributes :: !la + { lsSubjectNode :: n, + lsTargetNode :: n, + lsLinkState :: LinkState, + lsTimestamp :: Timestamp, + lsLinkAttributes :: la } deriving (Show,Eq,Ord)