-- |
-- Module      : Data.Hourglass.Time
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- generic time representation interface to allow
-- arbitrary conversion between different time representation
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Hourglass.Time
    (
    -- * Generic time classes
      Time(..)
    , Timeable(..)

    -- * Elapsed time
    , Elapsed(..)
    , ElapsedP(..)

    -- * Generic conversion
    , timeConvert

    -- * Date and Time
    , timeGetDate
    , timeGetDateTimeOfDay
    , timeGetTimeOfDay

    -- * Arithmetic
    , Duration(..)
    , Period(..)
    , TimeInterval(..)
    , timeAdd
    , timeDiff
    , timeDiffP
    , dateAddPeriod
    ) where

import Data.Data ()
import Data.Hourglass.Types
import Data.Hourglass.Calendar
import Data.Hourglass.Diff
import Foreign.C.Types (CTime(..))

-- | Timeable represent every type that can be made to look like time types.
--
-- * can be converted to ElapsedP and Elapsed
--
-- * optionally have a timezone associated
--
-- * have nanoseconds accessor (which can return 0 when the type is not more precise than seconds)
--
class Timeable t where
    -- | convert a time representation to the number of elapsed seconds and nanoseconds to a specific epoch
    timeGetElapsedP :: t -> ElapsedP

    -- | convert a time representation to the number of elapsed seconds to a specific epoch.
    -- 
    -- defaults to timeGetElapsedP unless defined explicitely by an instance
    timeGetElapsed :: t -> Elapsed
    timeGetElapsed t
t = Elapsed
e where ElapsedP Elapsed
e NanoSeconds
_ = t -> ElapsedP
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP t
t

    -- | return the number of optional nanoseconds.
    --
    -- If the underlaying type is not precise enough to record nanoseconds
    -- (or any variant between seconds and nanoseconds), 0 should be returned
    --
    -- defaults to 'timeGetElapsedP' unless defined explicitely by an instance,
    -- for efficiency reason, it's a good idea to override this methods if
    -- you know the type is not more precise than Seconds.
    timeGetNanoSeconds :: t -> NanoSeconds
    timeGetNanoSeconds t
t = NanoSeconds
ns where ElapsedP Elapsed
_ NanoSeconds
ns = t -> ElapsedP
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP t
t

-- | Represent time types that can be created from other time types.
--
-- Every conversion happens throught ElapsedP or Elapsed types.
class Timeable t => Time t where
    -- | convert from a number of elapsed seconds and nanoseconds to another time representation
    timeFromElapsedP :: ElapsedP -> t

    -- | convert from a number of elapsed seconds and nanoseconds to another time representation
    --
    -- defaults to timeFromElapsedP unless defined explicitely by an instance.
    timeFromElapsed :: Elapsed -> t
    timeFromElapsed Elapsed
e = ElapsedP -> t
forall t. Time t => ElapsedP -> t
timeFromElapsedP (Elapsed -> NanoSeconds -> ElapsedP
ElapsedP Elapsed
e NanoSeconds
0)

#if (MIN_VERSION_base(4,5,0))
instance Timeable CTime where
    timeGetElapsedP :: CTime -> ElapsedP
timeGetElapsedP CTime
c         = Elapsed -> NanoSeconds -> ElapsedP
ElapsedP (CTime -> Elapsed
forall t. Timeable t => t -> Elapsed
timeGetElapsed CTime
c) NanoSeconds
0
    timeGetElapsed :: CTime -> Elapsed
timeGetElapsed  (CTime Int64
c) = Seconds -> Elapsed
Elapsed (Int64 -> Seconds
Seconds (Int64 -> Seconds) -> Int64 -> Seconds
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
c)
    timeGetNanoSeconds :: CTime -> NanoSeconds
timeGetNanoSeconds CTime
_ = NanoSeconds
0
instance Time CTime where
    timeFromElapsedP :: ElapsedP -> CTime
timeFromElapsedP (ElapsedP Elapsed
e NanoSeconds
_)       = Elapsed -> CTime
forall t. Time t => Elapsed -> t
timeFromElapsed Elapsed
e
    timeFromElapsed :: Elapsed -> CTime
timeFromElapsed (Elapsed (Seconds Int64
c)) = Int64 -> CTime
CTime (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
c)
#endif

instance Timeable Elapsed where
    timeGetElapsedP :: Elapsed -> ElapsedP
timeGetElapsedP  Elapsed
e = Elapsed -> NanoSeconds -> ElapsedP
ElapsedP Elapsed
e NanoSeconds
0
    timeGetElapsed :: Elapsed -> Elapsed
timeGetElapsed   Elapsed
e = Elapsed
e
    timeGetNanoSeconds :: Elapsed -> NanoSeconds
timeGetNanoSeconds Elapsed
_ = NanoSeconds
0
instance Time Elapsed where
    timeFromElapsedP :: ElapsedP -> Elapsed
timeFromElapsedP (ElapsedP Elapsed
e NanoSeconds
_) = Elapsed
e
    timeFromElapsed :: Elapsed -> Elapsed
timeFromElapsed  Elapsed
e = Elapsed
e

instance Timeable ElapsedP where
    timeGetElapsedP :: ElapsedP -> ElapsedP
timeGetElapsedP    ElapsedP
e               = ElapsedP
e
    timeGetNanoSeconds :: ElapsedP -> NanoSeconds
timeGetNanoSeconds (ElapsedP Elapsed
_ NanoSeconds
ns) = NanoSeconds
ns
instance Time ElapsedP where
    timeFromElapsedP :: ElapsedP -> ElapsedP
timeFromElapsedP   ElapsedP
e               = ElapsedP
e

instance Timeable Date where
    timeGetElapsedP :: Date -> ElapsedP
timeGetElapsedP Date
d  = DateTime -> ElapsedP
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP (Date -> TimeOfDay -> DateTime
DateTime Date
d (Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay Hours
0 Minutes
0 Seconds
0 NanoSeconds
0))
instance Time Date where
    timeFromElapsedP :: ElapsedP -> Date
timeFromElapsedP (ElapsedP Elapsed
elapsed NanoSeconds
_) = Date
d
      where (DateTime Date
d TimeOfDay
_) = Elapsed -> DateTime
dateTimeFromUnixEpoch Elapsed
elapsed

instance Timeable DateTime where
    timeGetElapsedP :: DateTime -> ElapsedP
timeGetElapsedP DateTime
d = Elapsed -> NanoSeconds -> ElapsedP
ElapsedP (DateTime -> Elapsed
dateTimeToUnixEpoch DateTime
d) (DateTime -> NanoSeconds
forall t. Timeable t => t -> NanoSeconds
timeGetNanoSeconds DateTime
d)
    timeGetElapsed :: DateTime -> Elapsed
timeGetElapsed DateTime
d  = DateTime -> Elapsed
dateTimeToUnixEpoch DateTime
d
    timeGetNanoSeconds :: DateTime -> NanoSeconds
timeGetNanoSeconds (DateTime Date
_ (TimeOfDay Hours
_ Minutes
_ Seconds
_ NanoSeconds
ns)) = NanoSeconds
ns
instance Time DateTime where
    timeFromElapsedP :: ElapsedP -> DateTime
timeFromElapsedP ElapsedP
elapsed = ElapsedP -> DateTime
dateTimeFromUnixEpochP ElapsedP
elapsed

-- | Convert one time representation into another one
-- 
-- The return type need to be infer by the context.
--
-- If the context cannot be infer through this, some specialized functions
-- are available for built-in types:
--
-- * 'timeGetDate'
--
-- * 'timeGetDateTimeOfDay'
--
-- * 'timeGetElapsed', 'timeGetElapsedP'
timeConvert :: (Timeable t1, Time t2) => t1 -> t2
timeConvert :: t1 -> t2
timeConvert t1
t1 = ElapsedP -> t2
forall t. Time t => ElapsedP -> t
timeFromElapsedP (t1 -> ElapsedP
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP t1
t1)
{-# INLINE[2] timeConvert #-}
{-# RULES "timeConvert/ID" timeConvert = id #-}
{-# RULES "timeConvert/ElapsedP" timeConvert = timeGetElapsedP #-}
{-# RULES "timeConvert/Elapsed" timeConvert = timeGetElapsed #-}

-- | Get the calendar Date (year-month-day) from a time representation
--
-- specialization of 'timeConvert'
timeGetDate :: Timeable t => t -> Date
timeGetDate :: t -> Date
timeGetDate t
t = Date
d where (DateTime Date
d TimeOfDay
_) = t -> DateTime
forall t. Timeable t => t -> DateTime
timeGetDateTimeOfDay t
t
{-# INLINE[2] timeGetDate #-}
{-# RULES "timeGetDate/ID" timeGetDate = id #-}
{-# RULES "timeGetDate/DateTime" timeGetDate = dtDate #-}

-- | Get the day time (hours:minutes:seconds) from a time representation
--
-- specialization of 'timeConvert'
timeGetTimeOfDay :: Timeable t => t -> TimeOfDay
timeGetTimeOfDay :: t -> TimeOfDay
timeGetTimeOfDay t
t = TimeOfDay
tod where (DateTime Date
_ TimeOfDay
tod) = t -> DateTime
forall t. Timeable t => t -> DateTime
timeGetDateTimeOfDay t
t
{-# INLINE[2] timeGetTimeOfDay #-}
{-# RULES "timeGetTimeOfDay/Date" timeGetTimeOfDay = const (TimeOfDay 0 0 0 0) #-}
{-# RULES "timeGetTimeOfDay/DateTime" timeGetTimeOfDay = dtTime #-}

-- | Get the date and time of day from a time representation
--
-- specialization of 'timeConvert'
timeGetDateTimeOfDay :: Timeable t => t -> DateTime
timeGetDateTimeOfDay :: t -> DateTime
timeGetDateTimeOfDay t
t = ElapsedP -> DateTime
dateTimeFromUnixEpochP (ElapsedP -> DateTime) -> ElapsedP -> DateTime
forall a b. (a -> b) -> a -> b
$ t -> ElapsedP
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP t
t
{-# INLINE[2] timeGetDateTimeOfDay #-}
{-# RULES "timeGetDateTimeOfDay/ID" timeGetDateTimeOfDay = id #-}
{-# RULES "timeGetDateTimeOfDay/Date" timeGetDateTimeOfDay = flip DateTime (TimeOfDay 0 0 0 0) #-}

-- | add some time interval to a time representation and returns this new time representation
--
-- example:
--
-- > t1 `timeAdd` mempty { durationHours = 12 }
timeAdd :: (Time t, TimeInterval ti) => t -> ti -> t
timeAdd :: t -> ti -> t
timeAdd t
t ti
ti = ElapsedP -> t
forall t. Time t => ElapsedP -> t
timeFromElapsedP (ElapsedP -> t) -> ElapsedP -> t
forall a b. (a -> b) -> a -> b
$ ElapsedP -> Seconds -> ElapsedP
elapsedTimeAddSecondsP (t -> ElapsedP
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP t
t) (ti -> Seconds
forall i. TimeInterval i => i -> Seconds
toSeconds ti
ti)

-- | Get the difference in seconds between two time representation
--
-- effectively:
--
-- > t2 `timeDiff` t1 = t2 - t1
timeDiff :: (Timeable t1, Timeable t2) => t1 -> t2 -> Seconds
timeDiff :: t1 -> t2 -> Seconds
timeDiff t1
t1 t2
t2 = Seconds
sec where (Elapsed Seconds
sec) = t1 -> Elapsed
forall t. Timeable t => t -> Elapsed
timeGetElapsed t1
t1 Elapsed -> Elapsed -> Elapsed
forall a. Num a => a -> a -> a
- t2 -> Elapsed
forall t. Timeable t => t -> Elapsed
timeGetElapsed t2
t2

-- | Get the difference in seconds and nanoseconds between two time representation
--
-- effectively:
--
-- > @t2 `timeDiffP` t1 = t2 - t1
timeDiffP :: (Timeable t1, Timeable t2) => t1 -> t2 -> (Seconds, NanoSeconds)
timeDiffP :: t1 -> t2 -> (Seconds, NanoSeconds)
timeDiffP t1
t1 t2
t2 = (Seconds
sec, NanoSeconds
ns)
  where (ElapsedP (Elapsed Seconds
sec) NanoSeconds
ns) = t1 -> ElapsedP
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP t1
t1 ElapsedP -> ElapsedP -> ElapsedP
forall a. Num a => a -> a -> a
- t2 -> ElapsedP
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP t2
t2