-- Copyright 2016 Ertugrul Söylemez
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module:     Data.Time.Class
-- Copyright:  Copyright 2016 Ertugrul Söylemez
-- License:    Apache License 2.0
-- Maintainer: Ertugrul Söylemez <esz@posteo.de>
--
-- Time can be captured in terms of affine spaces.  These are basically
-- sets (points in time) enriched by a notion of relative movement (time
-- deltas).  Think of the real line representing points in time.  Now
-- think of left- and right-pointing arrows that represent relative
-- motion by a certain time duration.  You may attach such an arrow to
-- any point in time, and its head will point to the destination point
-- in time if you were to perform the motion represented by the arrow.
--
-- Given a 'Time' type @t@ its deltas are of type @'Delta' t@.  Deltas
-- should form a group under addition.  This is actually all the
-- structure required for them, but for compatibility reasons we require
-- them to be a 'Num' type.

module Data.Time.Class
    ( -- * Basic time arithmetic
      -- $intro_basic
      Time(..),
      TimeOrigin(..),
      TimeSeconds(..),
      deltaSecsFor,
      deltaSinceOrigin,
      oneSecondFor,

      -- * Unit-aware arithmetic
      -- $intro_units
      SkipUnit(..),
      TimeUnit(..),
      SkipDate(..),
      DateUnit(..),
      -- ** Week days
      sunday,
      monday,
      tuesday,
      wednesday,
      thursday,
      friday,
      saturday,

      -- * Retrieving the current time
      GetTime(..),
      getTimeAs,
      getDeltaSince,

      -- * Delays
      delayUntil,
      busyDelayUntil
    )
    where

import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Data.Proxy


-- | Most time types represent time as read by an actual clock.
-- Instances of this class support querying that clock.

class (Functor m, Time t) => GetTime m t where
    -- | Get the current time.
    getTime :: m t


-- | Class of time types that represent universal time and understand
-- weeks, months and years.

class (SkipUnit t) => SkipDate t where
    -- | Skip to the beginning of the next given unit of time according
    -- to the represented calendar, unless already at the beginning of a
    -- unit.
    dateBegin :: DateUnit -> t -> t

    -- | Skip to the beginning of the next given unit of time according
    -- to the represented calendar, , even when already at the beginning
    -- of a unit.
    dateNext :: DateUnit -> t -> t

    -- | Skip the given number of the given units of time according to
    -- the represented calendar, keeping the time within that unit if
    -- possible.
    dateSkip :: Integer -> DateUnit -> t -> t

    -- | Skip one given unit of time according to the represented
    -- calendar, keeping the time within that unit if possible.
    --
    -- > dateSkipOne = dateSkip 1
    dateSkipOne :: DateUnit -> t -> t
    dateSkipOne = dateSkip 1


-- | Class of time types that measure time in common units.
--
-- The 'next' function is exclusive with respect to the given point in
-- time, while the 'begin' function is inclusive.  The @skip*@ family of
-- functions just skips the given number of the given unit.  Examples
-- (numbers represent seconds):
--
-- > iterate (begin Second)   12.3 = [ 12.3, 13.0, 13.0, 13.0, ... ]
-- > iterate (next Second)    12.3 = [ 12.3, 13.0, 14.0, 15.0, ... ]
-- > iterate (skipOne Second) 12.3 = [ 12.3, 13.3, 14.3, 15.3, ... ]
--
-- These functions ignore leap seconds, unless @t@ specifically has a
-- representation for them (such as TAI).  For example skipping one
-- second with /time/'s @UTCTime@ may skip up to two seconds of physical
-- time.

class (Time t) => SkipUnit t where
    -- | Skip to the beginning of the next given unit of time, unless
    -- already at the beginning of a unit.
    begin :: TimeUnit -> t -> t

    -- | Skip to the beginning of the next given unit of time, even when
    -- already at the beginning of a unit.
    next :: TimeUnit -> t -> t

    -- | Skip the given number of the given units of time, keeping the
    -- time within that unit if possible.
    skip :: Integer -> TimeUnit -> t -> t

    -- | Skip one given unit of time, keeping the time within that unit
    -- if possible.
    --
    -- > skipOne = skip 1
    skipOne :: TimeUnit -> t -> t
    skipOne = skip 1


-- | Class of time-like types, i.e. types that support time arithmetic
-- with the help of a time-delta type.  Instances should satisfy the
-- following laws:
--
-- > addTime 0 t = t
-- > addTime dt1 (addTime dt2 t) = addTime (dt1 + dt2) t
-- > addTime (diffTime t1 t2) t2 = t1
--
-- For the common case of one-dimensional, totally ordered time the
-- 'diffTime' function is expected to act like subtraction.  This means
-- that if @t1@ is later than @t0@, then @'diffTime' t1 t0@ will be a
-- positive value.

class (Num (Delta t)) => Time t where
    -- | Type of time deltas.
    type Delta t

    -- | Add the given time delta to the given point in time.
    addTime :: Delta t -> t -> t

    -- | The delta between the given points in time.
    diffTime :: t -> t -> Delta t


-- | Some time types measure time relative to a (usually arbitrary but
-- well-defined) origin.

class (Time t) => TimeOrigin t where
    -- | The origin of time.
    timeOrigin :: t


-- | For most time types the deltas correspond to physical time.
--
-- Note: In this library /physical/ time essentially means "measured in
-- seconds", not necessarily real time.  For example the CPU time passed
-- since program start counts as physical time.

class (Time t) => TimeSeconds t where
    -- | The number of seconds the given delta represents.
    --
    -- Default is @const 'realToFrac'@ if @'Delta' t@ is an instance of
    -- 'Real'.
    deltaSecs :: (Fractional a) => proxy t -> Delta t -> a

    default deltaSecs :: (Fractional a, Real (Delta t)) => proxy t -> Delta t -> a
    deltaSecs _ = realToFrac

    -- | The duration of one second.
    oneSecond :: proxy t -> Delta t


-- | Common units of calendar time.  The durations are not necessarily
-- constant.

data DateUnit
    = Week Int  -- ^ Weeks starting at the given day (0 means Sunday).
    | Month     -- ^ Months.
    | Year      -- ^ Years.
    deriving (Eq, Ord, Show)


-- | Common units of time with constant durations.
--
-- The durations of minutes, hours and days are semi-constant.  Days are
-- defined to be constant in universal time, but due to our technical
-- inability to build a universal time clock we use approximations (like
-- UTC), which admit leap seconds for synchronisation.  This means that
-- the last minute of a day may take 59 or 61 seconds.

data TimeUnit
    = Second  -- ^ Seconds.
    | Minute  -- ^ Minutes.
    | Hour    -- ^ Hours.
    | Day     -- ^ Days.
    deriving (Bounded, Enum, Eq, Ord, Show)


-- | Sleep until the given point in time.  This function first uses
-- 'delayUntil' to sleep until just before the goal time.  Then it
-- switches to a busy loop until the goal time is reached.
--
-- This function is provided for applications that need sub-millisecond
-- precision sleeping.  However, please note that most applications do
-- not, thus it would just waste power.  Also note that there are no
-- real-time guarantees whatsoever.
--
-- The idle sleep threshold (first argument) specifies how long before
-- the goal time this function switches to busy sleeping.  The best
-- choice is highly system- and application-dependent, but an estimate
-- of slightly above the system's context switching interval should be a
-- good initial guess.
--
-- Note: the maximum delta generally should not be set too high, because
-- changes in system time are only noticed between individual delays.

busyDelayUntil
    :: (MonadIO m, GetTime m t, Ord (Delta t), TimeSeconds t)
    => Delta t  -- ^ Idle sleep threshold.
    -> Delta t  -- ^ Maximum time an individual delay lasts for.
    -> t        -- ^ Goal time.
    -> m ()
busyDelayUntil thr maxDt t1 = do
    delayUntil maxDt (addTime (-thr) t1)
    go

    where
    go = do
        t <- getTime
        when (diffTime t1 t > 0) go


-- | Sleep until the given point in time.  This function repeatedly
-- uses 'threadDelay' with a maximum of the given delta, until the goal
-- time is reached.
--
-- Note: Generally the maximum delta should not be set too high, because
-- changes in system time are only noticed between individual delays.
-- This is also the main motivation behind this function.

delayUntil
    :: forall m t. (MonadIO m, GetTime m t, Ord (Delta t), TimeSeconds t)
    => Delta t  -- ^ Maximum time an individual delay lasts for.
    -> t        -- ^ Goal time.
    -> m ()
delayUntil maxDt t1 = go
    where
    maxDtSecs = thisDeltaSecs maxDt :: Double

    delay dt      = threadDelay (ceiling (1000000*dt))
    thisDeltaSecs = deltaSecs (Proxy :: Proxy t)

    go = do
        t <- getTime
        let dt = diffTime t1 t
        if | dt <= 0     -> pure ()
           | dt <= maxDt -> liftIO (delay (thisDeltaSecs dt :: Double))
           | otherwise   -> liftIO (delay maxDtSecs) >> go


-- | The number of seconds the given delta represents.
--
-- This is a convenience wrapper around 'deltaSecs' that allows you to
-- pass an existing time value instead of a proxy to communicate the
-- type.

deltaSecsFor :: (Fractional a, TimeSeconds t) => t -> Delta t -> a
deltaSecsFor = deltaSecs . (pure :: a -> Proxy a)


-- | Time delta since the origin of time.
--
-- > deltaSinceOrigin t = diffTime t timeOrigin

deltaSinceOrigin :: (TimeOrigin t) => t -> Delta t
deltaSinceOrigin t = diffTime t timeOrigin


-- | Convenient alias for @'Week' 5@.

friday :: DateUnit
friday = Week 5


-- | Get the time delta from now to the given point in time.
--
-- > getDeltaSince t0 = fmap (`diffTime` t0) getTime

getDeltaSince :: (GetTime m t) => t -> m (Delta t)
getDeltaSince t0 = fmap (`diffTime` t0) getTime


-- | Get the current time.  This is a convenience wrapper around
-- 'getTime'.

getTimeAs :: (GetTime m t) => proxy t -> m t
getTimeAs _ = getTime


-- | Convenient alias for @'Week' 1@.

monday :: DateUnit
monday = Week 1


-- | The duration of one second.
--
-- This is a convenience wrapper around 'deltaSecs' that allows you to
-- pass an existing time value instead of a proxy to communicate the
-- type.

oneSecondFor :: (TimeSeconds t) => t -> Delta t
oneSecondFor = oneSecond . (pure :: a -> Proxy a)


-- | Convenient alias for @'Week' 6@.

saturday :: DateUnit
saturday = Week 6


-- | Convenient alias for @'Week' 0@.

sunday :: DateUnit
sunday = Week 0


-- | Convenient alias for @'Week' 4@.

thursday :: DateUnit
thursday = Week 4


-- | Convenient alias for @'Week' 2@.

tuesday :: DateUnit
tuesday = Week 2


-- | Convenient alias for @'Week' 3@.

wednesday :: DateUnit
wednesday = Week 3


{- $intro_basic

Since this library does not define any instances by itself, all examples
are pseudo-code and the values shown are in seconds.

The most basic arithmetic functions are 'addTime' and 'diffTime'.  Given
a time value @t@ you can add a time delta @dt@:

>>> addTime 3 5
8

Given two points in time @t0@ and @t1@ you can calculate the delta
between them:

>>> diffTime 20 17
3

Deltas should be considered vectors (with direction), not just
distances, so the order of the arguments matters:

>>> diffTime 17 20
-3

Most time types measure physical time, where /physical/ means "as
measured by a clock".  Their deltas can be translated into seconds using
'deltaSecs'.  However, no assumptions are made about the nature of that
clock.  Interesting examples include clocks that measure CPU time since
program start or even something completely application-specific like a
discrete frame count.  In the former case the physical length of what
this library considers a second actually varies (depending on how much
the CPU is actually utilised).

-}


{- $intro_units

Arithmetic classes are provided for types that represent universal time
together with all the usual caveats like leap seconds.  Like above the
following examples are pseudo-code.  Time values are written in angle
brackets.

Given a point in time @t@ you can skip the remainder of the current
second by using @'next' 'Second'@:

>>> next Second <2015-12-11 08:31:15.123>
<2015-12-11 08:31:16>

The 'next' function is exclusive with respect to its argument, so it is
never idempotent.  In other words you can apply it multiple times in a
row:

>>> (take 5 . iterate (next Second)) <2015-12-11 08:31:15.123>
[ <2015-12-11 08:31:15.123>,
  <2015-12-11 08:31:16>,
  <2015-12-11 08:31:17>,
  <2015-12-11 08:31:18>,
  <2015-12-11 08:31:19> ]

Similarly you can skip the remainder of the current minute:

>>> next Minute <2015-12-11 08:31:15.123>
<2015-12-11 08:32:00>

If you just want to make sure that you're at the beginning of a second,
skipping as far as necessary, you can use 'begin' instead:

>>> begin Second <2015-12-11 08:31:15.123>
<2015-12-11 08:31:16>

That one is idempotent, if already at the beginning of the specified
unit of time:

>>> (take 5 . iterate (begin Second)) <2015-12-11 08:31:15.123>
[ <2015-12-11 08:31:15.123>,
  <2015-12-11 08:31:16>,
  <2015-12-11 08:31:16>,
  <2015-12-11 08:31:16>,
  <2015-12-11 08:31:16> ]

For time types that correspond to a calendar you can skip the remainder
of this Monday-based week, which takes you to the following Monday:

>>> dateNext (Week 1) <2015-12-11 08:31:15.123>
<2015-12-14 00:00:00>

-}