diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,17 @@ # Revision history for net-spider +## 0.3.2.0 -- 2019-08-04 + +* Add `Interval` module. + +### Query module + +* Add `Eq` instance to `FoundNodePolicy`. + +### Spider module + +* Add `withSpider` function. + ## 0.3.1.1 -- 2019-07-19 * Add documentation about `GraphML.Writer` 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.3.1.1 +version: 0.3.2.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -38,7 +38,8 @@ NetSpider.Query, NetSpider.Log, NetSpider.Snapshot.Internal, - NetSpider.GraphML.Writer + NetSpider.GraphML.Writer, + NetSpider.Interval other-modules: NetSpider.Graph.Internal, NetSpider.Spider.Internal.Graph, NetSpider.Spider.Internal.Log, diff --git a/src/NetSpider.hs b/src/NetSpider.hs --- a/src/NetSpider.hs +++ b/src/NetSpider.hs @@ -29,6 +29,7 @@ -- * "NetSpider.Timestamp" -- * "NetSpider.Graph" -- * "NetSpider.Snapshot" +-- * "NetSpider.Interval" -- -- == Formatter -- diff --git a/src/NetSpider/Interval.hs b/src/NetSpider/Interval.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/Interval.hs @@ -0,0 +1,108 @@ +-- | +-- Module: NetSpider.Interval +-- Description: Interval type and Interval of Timestamps +-- Maintainer: Toshio Ito +-- +-- Re-exports of 'Interval' type and additional utility. +-- +-- @since 0.3.2.0 +module NetSpider.Interval + ( -- * Re-exports + Interval, + Extended(..), + interval, (<=..<=), (<..<=), (<=..<), (<..<), + -- * Types + IntervalEnd, + ErrorMsg, + -- * Parsers + parseTimeIntervalEnd, + parseIntervalEnd, + -- * Utility + secUpTo + ) where + +import Data.ExtendedReal (Extended(..)) +import Data.Int (Int64) +import Data.Interval (Interval, interval, (<=..<=), (<..<=), (<=..<), (<..<)) + +import NetSpider.Timestamp (Timestamp, addSec, parseTimestamp) + +-- | Upper or lower end of 'Interval'. The 'Bool' field is 'True' if +-- the end is inclusive. +-- +-- @since 0.3.2.0 +type IntervalEnd a = (Extended a, Bool) + +-- | Error message type. +type ErrorMsg = String + +-- | Parse the 'String' into 'IntervalEnd' @a@, with the +-- user-supplied parser for @a@. See 'parseTimeIntervalEnd' for +-- example. +-- +-- @since 0.3.2.0 +parseIntervalEnd :: (String -> Either ErrorMsg a) -- ^ parser for the type variable @a@ + -> String -- ^ input to be parsed + -> Either ErrorMsg (IntervalEnd a) +parseIntervalEnd parseFinite input = do + (is_inclusive, value_part) <- parseInclusive input + value <- parseValue value_part + return (value, is_inclusive) + where + parseInclusive "" = Right (True, "") + parseInclusive ('i' : rest) = Right (True, rest) + parseInclusive ('x' : rest) = Right (False, rest) + parseInclusive s = Right (True, s) + parseValue "+inf" = Right PosInf + parseValue "-inf" = Right NegInf + parseValue s = either (Left . makeErr) (Right . Finite) $ parseFinite s + where + makeErr e = "Parse error: " ++ s ++ ": " ++ e + +-- | Parse the 'String' into an end of time interval. It uses +-- 'parseIntervalEnd'. +-- +-- If the 'String' is prefixed with \'i\', the end is inclusive. If +-- the prefix is \'x\', the end is exclusive. Without such prefix, +-- the end is inclusive by default. +-- +-- Timestamp is parsed by 'parseTimestamp'. Positive infinity is +-- expressed as \'+inf\' (note that \'+\' is mandatory), and +-- negative infinity as \'-inf\'. +-- +-- >>> parseTimeIntervalEnd "2019-10-09T12:03:22" +-- Right (Finite (Timestamp {epochTime = 1570622602000, timeZone = Nothing}),True) +-- >>> parseTimeIntervalEnd "i2019-10-09T12:03:22" +-- Right (Finite (Timestamp {epochTime = 1570622602000, timeZone = Nothing}),True) +-- >>> parseTimeIntervalEnd "x2019-10-09T12:03:22" +-- Right (Finite (Timestamp {epochTime = 1570622602000, timeZone = Nothing}),False) +-- >>> parseTimeIntervalEnd "+inf" +-- Right (PosInf,True) +-- >>> parseTimeIntervalEnd "i+inf" +-- Right (PosInf,True) +-- >>> parseTimeIntervalEnd "x+inf" +-- Right (PosInf,False) +-- >>> parseTimeIntervalEnd "-inf" +-- Right (NegInf,True) +-- >>> parseTimeIntervalEnd "i-inf" +-- Right (NegInf,True) +-- >>> parseTimeIntervalEnd "x-inf" +-- Right (NegInf,False) +-- +-- @since 0.3.2.0 +parseTimeIntervalEnd :: String -> Either ErrorMsg (IntervalEnd Timestamp) +parseTimeIntervalEnd = parseIntervalEnd parseTimestampE + where + parseTimestampE t = maybe (Left err_msg) Right $ parseTimestamp t + where + err_msg = "Cannot parse as a Timestamp: " ++ t + +-- | @s `secUpTo` ts@ returns the time interval of length @s@ (in +-- seconds) and up to @ts@. The interval is inclusive for both ends. +-- +-- @since 0.2.0.0 +secUpTo :: Int64 -> Timestamp -> Interval Timestamp +secUpTo len end = Finite start <=..<= Finite end + where + start = addSec (-len) end + diff --git a/src/NetSpider/Query.hs b/src/NetSpider/Query.hs --- a/src/NetSpider/Query.hs +++ b/src/NetSpider/Query.hs @@ -24,11 +24,13 @@ Extended(..) ) where -import Data.ExtendedReal (Extended(..)) -import Data.Int (Int64) -import Data.Interval (Interval, (<=..<=), (<..<=), (<=..<), (<..<)) import qualified Data.Interval as Interval +import NetSpider.Interval + ( secUpTo, + Interval, (<=..<=), (<..<=), (<=..<), (<..<), + Extended(..) + ) import NetSpider.Timestamp (Timestamp, addSec) import NetSpider.Unify (LinkSampleUnifier, unifyToOne) import NetSpider.Query.Internal (FoundNodePolicy(..)) @@ -76,15 +78,6 @@ timeInterval = Interval.whole, foundNodePolicy = policyOverwrite } - --- | @s `secUpTo` ts@ returns the time interval of length @s@ (in --- seconds) and up to @ts@. The interval is inclusive for both ends. --- --- @since 0.2.0.0 -secUpTo :: Int64 -> Timestamp -> Interval Timestamp -secUpTo len end = Finite start <=..<= Finite end - where - start = addSec (-len) end -- | A 'FoundNode' always overwrites old 'FoundNode's, so only the -- latest one is valid. diff --git a/src/NetSpider/Query/Internal.hs b/src/NetSpider/Query/Internal.hs --- a/src/NetSpider/Query/Internal.hs +++ b/src/NetSpider/Query/Internal.hs @@ -11,9 +11,11 @@ -- | Policy to treat 'FoundNode's (local findings) when the spider -- creates the snapshot graph. -- +-- 'Eq' instance was added in version 0.3.2.0 +-- -- @since 0.2.0.0 data FoundNodePolicy n na= PolicyOverwrite | PolicyAppend - deriving (Show) + deriving (Show,Eq) diff --git a/src/NetSpider/Spider.hs b/src/NetSpider/Spider.hs --- a/src/NetSpider/Spider.hs +++ b/src/NetSpider/Spider.hs @@ -13,6 +13,8 @@ connectWith, -- * Close Spider close, + -- * Bracket form + withSpider, -- * Graph operations addFoundNode, getSnapshotSimple, @@ -20,7 +22,7 @@ clearAll ) where -import Control.Exception.Safe (throwString) +import Control.Exception.Safe (throwString, bracket) import Control.Monad (void, mapM_, mapM) import Data.Aeson (ToJSON) import Data.Foldable (foldr', toList) @@ -90,6 +92,13 @@ -- | Close and release the 'Spider' object. close :: Spider n na fla -> IO () close sp = Gr.close $ spiderClient sp + +-- | Connect the spider, run the given action and close the +-- connection. +-- +-- @since 0.3.2.0 +withSpider :: Config n na fla -> (Spider n na fla -> IO a) -> IO a +withSpider conf = bracket (connectWith conf) close submitB :: (ToGreskell g, r ~ GreskellReturn g, AsIterator r, v ~ IteratorItem r, FromGraphSON v) => Spider n na fla -> Binder g -> IO (Gr.ResultHandle v)