{-# LANGUAGE CPP #-}
module NetSpider.Interval
(
Interval,
Extended(..),
(<=..<=), (<..<=), (<=..<), (<..<),
IntervalEnd,
ErrorMsg,
interval,
lowerBound',
upperBound',
parseTimeIntervalEnd,
parseIntervalEnd,
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)
type IntervalEnd a = (Extended a, Bool)
interval :: Ord r
=> IntervalEnd r
-> IntervalEnd r
-> Interval r
lowerBound' :: Interval r -> IntervalEnd r
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
type ErrorMsg = String
parseIntervalEnd :: (String -> Either ErrorMsg a)
-> String
-> 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
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
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
secSince :: Int64
-> IntervalEnd Timestamp
-> 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
secUntil :: Int64
-> IntervalEnd Timestamp
-> 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