{-# LANGUAGE CPP #-} -- | -- 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(..), (<=..<=), (<..<=), (<=..<), (<..<), -- * Types IntervalEnd, ErrorMsg, -- * Basic operations interval, lowerBound', upperBound', -- * Parsers parseTimeIntervalEnd, parseIntervalEnd, -- * Utility secUpTo, secSince, secUntil ) where import Data.ExtendedReal (Extended(..)) import Data.Int (Int64) import Data.Interval (Interval, (<=..<=), (<..<=), (<=..<), (<..<)) import qualified Data.Interval as Interval import NetSpider.Timestamp (Timestamp, addSec, parseTimestamp, fromEpochMillisecond) -- | 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) -- | Make an 'Interval' from lower and upper bounds. interval :: Ord r => IntervalEnd r -- ^ lower bound -> IntervalEnd r -- ^ upper bound -> Interval r -- | Get the lower bound. lowerBound' :: Interval r -> IntervalEnd r -- | Get the upper bound. upperBound' :: Interval r -> IntervalEnd r #if MIN_VERSION_data_interval(2,0,0) fromBoundary :: Interval.Boundary -> Bool fromBoundary Interval.Open = False fromBoundary Interval.Closed = True toBoundary :: Bool -> Interval.Boundary toBoundary False = Interval.Open toBoundary True = Interval.Closed interval l u = Interval.interval (fmap toBoundary l) (fmap toBoundary u) lowerBound' = fmap fromBoundary . Interval.lowerBound' upperBound' = fmap fromBoundary . Interval.upperBound' #else interval = Interval.interval lowerBound' = Interval.lowerBound' upperBound' = Interval.upperBound' #endif -- | 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 -- | @d `secSince` ts@ returns the time interval of length @d@ seconds -- from the timestamp @ts@. If @ts@ is inclusive (exclusive), the end -- of the interval is exclusive (inclusive), respectively. -- -- >>> 60 `secSince` (Finite $ fromEpochMillisecond 1000, True) -- Finite (Timestamp {epochTime = 1000, timeZone = Nothing}) <=..< Finite (Timestamp {epochTime = 61000, timeZone = Nothing}) -- >>> 60 `secSince` (Finite $ fromEpochMillisecond 1000, False) -- Finite (Timestamp {epochTime = 1000, timeZone = Nothing}) <..<= Finite (Timestamp {epochTime = 61000, timeZone = Nothing}) -- >>> 60 `secSince` (PosInf, False) -- empty -- >>> 60 `secSince` (NegInf, False) -- empty -- -- @since 0.3.3.0 secSince :: Int64 -- ^ duration in seconds -> IntervalEnd Timestamp -- ^ the start of the interval -> Interval Timestamp secSince len start@(Finite start_ts, inc) = interval start (Finite $ addSec len start_ts, not inc) secSince _ _ = Interval.empty -- | @d `secUntil` ts@ returns the time interval of length @d@ seconds -- up to the timestamp @ts@. If @ts@ is inclusive (exclusive), the -- start of the interval is exclusive (inclusive), respectively. -- -- >>> 60 `secUntil` (Finite $ fromEpochMillisecond 150000, True) -- Finite (Timestamp {epochTime = 90000, timeZone = Nothing}) <..<= Finite (Timestamp {epochTime = 150000, timeZone = Nothing}) -- >>> 60 `secUntil` (Finite $ fromEpochMillisecond 150000, False) -- Finite (Timestamp {epochTime = 90000, timeZone = Nothing}) <=..< Finite (Timestamp {epochTime = 150000, timeZone = Nothing}) -- >>> 60 `secUntil` (PosInf, False) -- empty -- >>> 60 `secUntil` (NegInf, False) -- empty -- -- @since 0.3.3.0 secUntil :: Int64 -- ^ duration in seconds -> IntervalEnd Timestamp -- ^ the end of the interval -> Interval Timestamp secUntil len end@(Finite end_ts, inc) = interval (Finite $ addSec (-len) end_ts, not inc) end secUntil _ _ = Interval.empty