{-|
Module      : Data.Interval.Time
Description : Closed intervals on the UTC time axis
Copyright   : (c) Lackmann Phymetric
License     : GPL-3
Maintainer  : olaf.klinke@phymetric.de
Stability   : experimental

This module defines datatypes for closed intervals 
with end points on the 'UTCTime' axis. 
-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, KindSignatures, GADTs, DataKinds #-}
module Data.Interval.Time (
    -- * Time intervals of statically known length
    MinuteInterval,
    fromEndTime,
    ubZoned,
    -- ** Time intervals of length 10 minutes
    Min10,
    until10,
    -- ** Time intervals of length 15 minutes
    Min15,
    until15
    ) where
import Data.Interval (Interval(..),addTime)
import Data.Function (on)
import Data.Time (ZonedTime,zonedTimeToUTC,UTCTime,NominalDiffTime)
import GHC.TypeLits (Nat,KnownNat,natVal)
import Data.Proxy (Proxy(..))

-- * Time intervals of statically known length.

-- | Closed time intervals of statically known length in minutes. 
-- Although such intervals are completely determined by the end time of type 'ZonedTime' 
-- that was used for construction,  
-- we cache 'lb' and 'ub' als lazy fields of type 'UTCTime' to speed up 'Interval' queries. 
-- 
-- @since 0.2.1
data MinuteInterval (n :: Nat) where
   Until :: KnownNat n => ZonedTime -> UTCTime -> UTCTime -> MinuteInterval n

-- | Retrieve the upper bound that was used in construction, see 'fromEndTime'. 
ubZoned :: MinuteInterval n -> ZonedTime
ubZoned :: forall (n :: Nat). MinuteInterval n -> ZonedTime
ubZoned (Until ZonedTime
z UTCTime
_ UTCTime
_) = ZonedTime
z

-- | Time intervals of equal length are considered equal 
-- if they describe the same interval on the 'UTCTime' axis,
-- regardless of time zone.
instance Eq (MinuteInterval n) where
   == :: MinuteInterval n -> MinuteInterval n -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall e i. Interval e i => i -> e
ub
-- | Intervals of fixed length are ordered by their end time. 
-- Hence you can put them into a @Set@ or use as keys in a @Map@.  
instance Ord (MinuteInterval n) where
   compare :: MinuteInterval n -> MinuteInterval n -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall e i. Interval e i => i -> e
ub
instance Interval UTCTime (MinuteInterval n) where
    ub :: MinuteInterval n -> UTCTime
ub (Until ZonedTime
_ UTCTime
_ UTCTime
u) = UTCTime
u
    lb :: MinuteInterval n -> UTCTime
lb (Until ZonedTime
_ UTCTime
l UTCTime
_) = UTCTime
l

beginMinutes :: KnownNat n => Proxy n -> NominalDiffTime
beginMinutes :: forall (n :: Nat). KnownNat n => Proxy n -> NominalDiffTime
beginMinutes = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
60forall a. Num a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal

-- | Smart constructor.
-- 
-- @
-- 'ub'      ('fromEndTime' p z) == 'zonedTimeToUTC' z
-- 'ubZoned' ('fromEndTime' p z) == z
-- @
fromEndTime :: KnownNat n => Proxy n -> ZonedTime -> MinuteInterval n
fromEndTime :: forall (n :: Nat).
KnownNat n =>
Proxy n -> ZonedTime -> MinuteInterval n
fromEndTime Proxy n
p ZonedTime
z = let u :: UTCTime
u = ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
z in forall (n :: Nat).
KnownNat n =>
ZonedTime -> UTCTime -> UTCTime -> MinuteInterval n
Until ZonedTime
z (forall t. TimeDifference t => NominalDiffTime -> t -> t
addTime (forall (n :: Nat). KnownNat n => Proxy n -> NominalDiffTime
beginMinutes Proxy n
p) UTCTime
u) UTCTime
u

-- * Intervals of length 10 Minutes

-- | Time intervals of length 10 minutes. 
-- In logging applications, aggregate values (e.g. averages, sums, ...) 
-- are often taken over a period of 10 minutes 
-- and associated with the time 
-- when the aggregation was computed. 
-- 
-- To create your custom aggregate data type, pair this time interval 
-- with the aggregate value, like follows. 
-- 
-- @
-- data SumOver10Minutes s = Aggregate {
--  aggregateValue :: s,
--  aggregatedOver :: Min10
--  }
-- 
-- instance Interval UTCTime (SumOver10Minutes s) where 
--  lb = lb.aggregatedOver
--  ub = ub.aggregatedOver
--
-- compositeAggregate :: (Interval UTCTime i, Monoid s, Foldable f, IntersectionQuery f UTCTime t) =>
--  i -> t (SumOver10Minutes s) -> s
-- compositeAggregate i = foldMap aggregateValue . getProperIntersects i
-- @
-- 
-- @since 0.2.1
type Min10 = MinuteInterval 10
instance Show (MinuteInterval 10) where
    show :: MinuteInterval 10 -> String
show MinuteInterval 10
i  = String
"until10 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (n :: Nat). MinuteInterval n -> ZonedTime
ubZoned MinuteInterval 10
i)

-- | smart constructor
until10 :: ZonedTime -> Min10
until10 :: ZonedTime -> MinuteInterval 10
until10 = forall (n :: Nat).
KnownNat n =>
Proxy n -> ZonedTime -> MinuteInterval n
fromEndTime (forall {k} (t :: k). Proxy t
Proxy :: Proxy 10)

-- * Intervals of length 15 minutes

-- | Time intervals comprising quarter of an hour. 
-- 
-- @since 0.2.1
type Min15 = MinuteInterval 15
instance Show (MinuteInterval 15) where
    show :: MinuteInterval 15 -> String
show MinuteInterval 15
i  = String
"until15 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (n :: Nat). MinuteInterval n -> ZonedTime
ubZoned MinuteInterval 15
i)

-- | smart constructor
until15 :: ZonedTime -> Min15
until15 :: ZonedTime -> MinuteInterval 15
until15 = forall (n :: Nat).
KnownNat n =>
Proxy n -> ZonedTime -> MinuteInterval n
fromEndTime (forall {k} (t :: k). Proxy t
Proxy :: Proxy 15)