-- 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 CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module:     Data.Time.Class.Clock
-- Copyright:  Copyright 2016 Ertugrul Söylemez
-- License:    Apache License 2.0
-- Maintainer: Ertugrul Söylemez <esz@posteo.de>
--
-- This module exports the 'ClockTime' type, which is related to (but
-- not a wrapper for) the 'TimeSpec' type provided by the
-- <http://hackage.haskell.org/package/clock clock library>.  It aims to
-- implement a complete timelike interface to the clock library, so when
-- using this module, you should not need to import "System.Clock".
--
-- A value of type @'ClockTime' clock@ denotes a certain point in time
-- as measured by the clock reflected by the @clock@ argument.  For
-- example @ClockTime Realtime@ is a point in time as measured by the
-- real-time clock.  See the documentation of 'Clock' for a list of
-- available clocks.  The type argument is currently only relevant when
-- querying the clock using 'getTime', and unless the clock type can be
-- inferred from context, you will need to write a suitable type
-- signature.  Example:
--
-- > t <- getTime :: IO (ClockTime Realtime)
--
-- The following example measures the duration of the action
-- @someOperation@:
--
-- > do t1 <- getTime :: IO (ClockTime Monotonic)
-- >    someOperation
-- >    t2 <- getTime
-- >    let elapsed = diffTime t2 t1
--
-- The following example delays the current thread until the start of
-- the next second of real time:
--
-- > do -- Prints the start time and then delays:
-- >    t' <- getTime :: IO (ClockTime Realtime)
-- >    print t'
-- >    delayUntil 1 (begin Second t')
-- >
-- >    -- Should print roughly t' rounded up to the next second:
-- >    t <- getTime
-- >    print t
-- >
-- >    -- Prints the amount of time passed:
-- >    print (diffTime t t')
--
-- As noted above 'ClockTime' is not a wrapper for 'TimeSpec', but
-- rather wraps 'Nano'.  Arithmetic may be slightly slower, because
-- 'Integer' division is needed, but on 64-bit platforms the difference
-- should be negligible, because the size of a 64-bit word is seldomly
-- exceeded.

module Data.Time.Class.Clock
    ( -- * Time
      ClockTime(..),
      Clock(..),
      fromTimeSpec,
      toTimeSpec
    )
    where

import           Control.Monad.IO.Class
import           Data.Fixed
import           Data.Time.Class
import           GHC.Generics
import           System.Clock (Clock(..), TimeSpec(..))
import qualified System.Clock as Clock


-- | A value of type @ClockTime clock@ is a point in time as measured by
-- the clock represented by @clock :: Clock@.  See the documentation of
-- 'Clock' for the meanings of the individual clocks.
--
-- The 'timeOrigin' of all clocks is zero, which has different meanings
-- depending on the chosen clock.  For example the origin of the
-- 'Realtime' clock is the epoch.

newtype ClockTime (clock :: Clock) =
    ClockTime {
      fromClockTime :: Nano
    }
    deriving (Eq, Generic, Ord, Read, Show)

instance (MonadIO m) => GetTime m (ClockTime Monotonic) where
    getTime = fromTimeSpec <$> liftIO (Clock.getTime Monotonic)

instance (MonadIO m) => GetTime m (ClockTime Realtime) where
    getTime = fromTimeSpec <$> liftIO (Clock.getTime Realtime)

instance (MonadIO m) => GetTime m (ClockTime ProcessCPUTime) where
    getTime = fromTimeSpec <$> liftIO (Clock.getTime ProcessCPUTime)

instance (MonadIO m) => GetTime m (ClockTime ThreadCPUTime) where
    getTime = fromTimeSpec <$> liftIO (Clock.getTime ThreadCPUTime)

#ifdef linux_HOST_OS
-- | Linux only, since Linux 2.6.28.
instance (MonadIO m) => GetTime m (ClockTime MonotonicRaw) where
    getTime = fromTimeSpec <$> liftIO (Clock.getTime MonotonicRaw)

-- | Linux only, since Linux 2.6.39.
instance (MonadIO m) => GetTime m (ClockTime Boottime) where
    getTime = fromTimeSpec <$> liftIO (Clock.getTime Boottime)

-- | Linux only, since Linux 2.6.32.
instance (MonadIO m) => GetTime m (ClockTime MonotonicCoarse) where
    getTime = fromTimeSpec <$> liftIO (Clock.getTime MonotonicCoarse)

-- | Linux only, since Linux 2.6.32.
instance (MonadIO m) => GetTime m (ClockTime RealtimeCoarse) where
    getTime = fromTimeSpec <$> liftIO (Clock.getTime RealtimeCoarse)
#endif

instance SkipUnit (ClockTime clock) where
    begin unit (ClockTime t)
        | r == 0    = ClockTime t
        | otherwise = ClockTime (d * fromInteger (u + 1))
        where
        (u, r) = divMod' t d
        d = unitSecs unit

    next unit (ClockTime t) =
        let d = unitSecs unit
        in ClockTime (d * fromInteger (div' t d + 1))

    skip n unit (ClockTime t) = ClockTime (t + fromInteger n * unitSecs unit)

    skipOne unit (ClockTime t) = ClockTime (t + unitSecs unit)

instance Time (ClockTime clock) where
    type Delta (ClockTime clock) = Nano

    addTime dt (ClockTime t) = ClockTime (t + dt)
    diffTime (ClockTime t1) (ClockTime t2) = t1 - t2

instance TimeOrigin (ClockTime clock) where
    timeOrigin = ClockTime 0

instance TimeSeconds (ClockTime clock) where
    deltaSecs _ = realToFrac
    oneSecond _ = 1


-- | Convert the given 'TimeSpec' to a 'ClockTime' value.
--
-- Note that the two types are not isomorphic.  While 'TimeSpec' is
-- limited to roughly 94 bits, 'ClockTime' does not have such a limit.
-- This function is injective, and the following equation holds:
--
-- > toTimeSpec . fromTimeSpec = id

fromTimeSpec :: TimeSpec -> ClockTime clock
fromTimeSpec = ClockTime . MkFixed . Clock.timeSpecAsNanoSecs


-- | Convert the given 'ClockTime' value to a 'TimeSpec'.
--
-- Note that the two types are not isomorphic.  While 'TimeSpec' is
-- limited to roughly 94 bits, 'ClockTime' does not have such a limit.
-- This function is surjective, and the following equation holds:
--
-- > toTimeSpec . fromTimeSpec = id

toTimeSpec :: ClockTime clock -> TimeSpec
toTimeSpec (ClockTime (MkFixed ns')) =
    let (s, ns) = divMod ns' 1000000000
    in TimeSpec (fromInteger s) (fromInteger ns)


-- | The given unit in seconds.

unitSecs :: (Num a) => TimeUnit -> a
unitSecs Second = 1
unitSecs Minute = 60
unitSecs Hour   = 3600
unitSecs Day    = 86400