-- Copyright 2015 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 2015 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(..),
      deltaSinceOrigin,

      -- * Unit-aware arithmetic
      -- $intro_units
      SkipUnit(..),
      TimeUnit(..),
      SkipDate(..),
      DateUnit(..),

      -- * Retrieving the current time
      GetTime(..),
      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.
    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 :: DateUnit -> t -> t
    dateSkipOne = dateSkip 1


-- | Class of time types that measure time in common units.
--
-- All time skipping functions (@next*@) are exclusive with respect to
-- the given point in time.  Example (numbers represent seconds):
--
-- > iterate (next Second) 12.3 = [ 12.3, 13, 14, 15, ... ]

class (Time t) => SkipUnit t where
    -- | Skip to the beginning of the next given unit of time.
    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 is 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


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

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


-- | 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


-- | 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 ->
               let dtSecs = thisDeltaSecs dt :: Double
               in liftIO (delay dtSecs)
           | otherwise -> do
               liftIO (delay maxDtSecs)
               go


{- $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.  Their deltas can be translated
into seconds using 'deltaSecs'.  Physical means "measured by a clock",
but no assumptions are made about the nature of that clock.  Interesting
examples include clocks that measure CPU time since program start.  The
length of a second is variable in that case.

-}


{- $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>

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>

-}