{-# LANGUAGE CPP #-}
-- |
-- Module: NetSpider.Interval
-- Description: Interval type and Interval of Timestamps
-- Maintainer: Toshio Ito <toshio9.ito@toshiba.co.jp>
--
-- 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 :: Boundary -> Bool
fromBoundary Boundary
Interval.Open = Bool
False
fromBoundary Boundary
Interval.Closed = Bool
True

toBoundary :: Bool -> Interval.Boundary
toBoundary :: Bool -> Boundary
toBoundary Bool
False = Boundary
Interval.Open
toBoundary Bool
True = Boundary
Interval.Closed

interval :: IntervalEnd r -> IntervalEnd r -> Interval r
interval IntervalEnd r
l IntervalEnd r
u = (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval ((Bool -> Boundary) -> IntervalEnd r -> (Extended r, Boundary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Boundary
toBoundary IntervalEnd r
l) ((Bool -> Boundary) -> IntervalEnd r -> (Extended r, Boundary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Boundary
toBoundary IntervalEnd r
u)
lowerBound' :: Interval r -> IntervalEnd r
lowerBound' = (Boundary -> Bool) -> (Extended r, Boundary) -> IntervalEnd r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Boundary -> Bool
fromBoundary ((Extended r, Boundary) -> IntervalEnd r)
-> (Interval r -> (Extended r, Boundary))
-> Interval r
-> IntervalEnd r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound'
upperBound' :: Interval r -> IntervalEnd r
upperBound' = (Boundary -> Bool) -> (Extended r, Boundary) -> IntervalEnd r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Boundary -> Bool
fromBoundary ((Extended r, Boundary) -> IntervalEnd r)
-> (Interval r -> (Extended r, Boundary))
-> Interval r
-> IntervalEnd r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
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 :: (String -> Either String a)
-> String -> Either String (IntervalEnd a)
parseIntervalEnd String -> Either String a
parseFinite String
input = do
  (Bool
is_inclusive, String
value_part) <- String -> Either String (Bool, String)
forall a. String -> Either a (Bool, String)
parseInclusive String
input
  Extended a
value <- String -> Either String (Extended a)
parseValue String
value_part
  IntervalEnd a -> Either String (IntervalEnd a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Extended a
value, Bool
is_inclusive)
  where
    parseInclusive :: String -> Either a (Bool, String)
parseInclusive String
"" = (Bool, String) -> Either a (Bool, String)
forall a b. b -> Either a b
Right (Bool
True, String
"")
    parseInclusive (Char
'i' : String
rest) = (Bool, String) -> Either a (Bool, String)
forall a b. b -> Either a b
Right (Bool
True, String
rest)
    parseInclusive (Char
'x' : String
rest) = (Bool, String) -> Either a (Bool, String)
forall a b. b -> Either a b
Right (Bool
False, String
rest)
    parseInclusive String
s = (Bool, String) -> Either a (Bool, String)
forall a b. b -> Either a b
Right (Bool
True, String
s)
    parseValue :: String -> Either String (Extended a)
parseValue String
"+inf" = Extended a -> Either String (Extended a)
forall a b. b -> Either a b
Right Extended a
forall r. Extended r
PosInf
    parseValue String
"-inf" = Extended a -> Either String (Extended a)
forall a b. b -> Either a b
Right Extended a
forall r. Extended r
NegInf
    parseValue String
s = (String -> Either String (Extended a))
-> (a -> Either String (Extended a))
-> Either String a
-> Either String (Extended a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String (Extended a)
forall a b. a -> Either a b
Left (String -> Either String (Extended a))
-> (String -> String) -> String -> Either String (Extended a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
makeErr) (Extended a -> Either String (Extended a)
forall a b. b -> Either a b
Right (Extended a -> Either String (Extended a))
-> (a -> Extended a) -> a -> Either String (Extended a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Extended a
forall r. r -> Extended r
Finite) (Either String a -> Either String (Extended a))
-> Either String a -> Either String (Extended a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
parseFinite String
s
      where
        makeErr :: String -> String
makeErr String
e = String
"Parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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 :: String -> Either String (IntervalEnd Timestamp)
parseTimeIntervalEnd = (String -> Either String Timestamp)
-> String -> Either String (IntervalEnd Timestamp)
forall a.
(String -> Either String a)
-> String -> Either String (IntervalEnd a)
parseIntervalEnd String -> Either String Timestamp
parseTimestampE
  where
    parseTimestampE :: String -> Either String Timestamp
parseTimestampE String
t = Either String Timestamp
-> (Timestamp -> Either String Timestamp)
-> Maybe Timestamp
-> Either String Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Timestamp
forall a b. a -> Either a b
Left String
err_msg) Timestamp -> Either String Timestamp
forall a b. b -> Either a b
Right (Maybe Timestamp -> Either String Timestamp)
-> Maybe Timestamp -> Either String Timestamp
forall a b. (a -> b) -> a -> b
$ String -> Maybe Timestamp
parseTimestamp String
t
      where
        err_msg :: String
err_msg = String
"Cannot parse as a Timestamp: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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 :: Int64 -> Timestamp -> Interval Timestamp
secUpTo Int64
len Timestamp
end = Timestamp -> Extended Timestamp
forall r. r -> Extended r
Finite Timestamp
start Extended Timestamp -> Extended Timestamp -> Interval Timestamp
forall r. Ord r => Extended r -> Extended r -> Interval r
<=..<= Timestamp -> Extended Timestamp
forall r. r -> Extended r
Finite Timestamp
end
  where
    start :: Timestamp
start = Int64 -> Timestamp -> Timestamp
addSec (-Int64
len) Timestamp
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 :: Int64 -> IntervalEnd Timestamp -> Interval Timestamp
secSince Int64
len start :: IntervalEnd Timestamp
start@(Finite Timestamp
start_ts, Bool
inc) = IntervalEnd Timestamp
-> IntervalEnd Timestamp -> Interval Timestamp
forall r. Ord r => IntervalEnd r -> IntervalEnd r -> Interval r
interval IntervalEnd Timestamp
start (Timestamp -> Extended Timestamp
forall r. r -> Extended r
Finite (Timestamp -> Extended Timestamp)
-> Timestamp -> Extended Timestamp
forall a b. (a -> b) -> a -> b
$ Int64 -> Timestamp -> Timestamp
addSec Int64
len Timestamp
start_ts, Bool -> Bool
not Bool
inc)
secSince Int64
_ IntervalEnd Timestamp
_ = Interval Timestamp
forall r. Ord r => Interval r
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 :: Int64 -> IntervalEnd Timestamp -> Interval Timestamp
secUntil Int64
len end :: IntervalEnd Timestamp
end@(Finite Timestamp
end_ts, Bool
inc) = IntervalEnd Timestamp
-> IntervalEnd Timestamp -> Interval Timestamp
forall r. Ord r => IntervalEnd r -> IntervalEnd r -> Interval r
interval (Timestamp -> Extended Timestamp
forall r. r -> Extended r
Finite (Timestamp -> Extended Timestamp)
-> Timestamp -> Extended Timestamp
forall a b. (a -> b) -> a -> b
$ Int64 -> Timestamp -> Timestamp
addSec (-Int64
len) Timestamp
end_ts, Bool -> Bool
not Bool
inc) IntervalEnd Timestamp
end
secUntil Int64
_ IntervalEnd Timestamp
_ = Interval Timestamp
forall r. Ord r => Interval r
Interval.empty