{- This file is part of time-interval.
 -
 - Written in 2015, 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

-- To derive Enum instance for TimeInterval
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Suppose you have 'Settings' type, and one of its fields specifies an
-- amount of time. Suppose you want to use "Data.Time.Units" for that, because
-- it abstracts away the direct use or 'Int' or 'Integer'. Using 'TimeUnit'
-- directly would require to add the concrete time unit type as a type
-- parameter of 'Settings' (or use GHC type related extensions):
--
-- > data Settings t = Settings
-- >     { x :: Int
-- >     , y :: Text
-- >     , z :: t
-- >     }
--
-- And any use of @z@ would require to specify the @TimeUnit t =>@ constraint.
-- If you want to add more settings fields later which are time durations,
-- you'll need to add more type variables which may break code which uses the
-- 'Settings' type.
--
-- > data Settings t1 t2 t3 = Settings
-- >     { x :: Int
-- >     , y :: Text
-- >     , z :: t1
-- >     , u :: t2
-- >     , v :: t3
-- >     }
--
-- This package provides something between 'Int' and 'TimeUnit'. A concrete
-- type for specifying time durations, which both hide the integers and avoid
-- the type variables:
--
-- > data Settings = Settings
-- >     { x :: Int
-- >     , y :: Text
-- >     , z :: TimeInterval
-- >     , u :: TimeInterval
-- >     , v :: TimeInterval
-- >     }
--
-- There is nothing magical here, this is simply a convenience package for
-- people who encounter this issue in their code.
--
-- Note that currently 'TimeInterval' stores time as microseconds internally.
-- This may be a problem if you plan to work with smaller intervals
-- (nanoseconds, picoseconds, etc.). If you have such needs, please contact the
-- maintainer to discuss a solution.
module Data.Time.Interval
    ( TimeInterval ()
    , fromTimeUnit
    , toTimeUnit
    , toMicroUnit
    , time
    , microseconds
    )
where

import Data.Time.Units

-- | A time duration.
newtype TimeInterval = TimeInterval Integer
    deriving (Enum, Eq, Integral, Ord, Num, Real, Show)

-- | Convert a time value expressed in a some time unit into a 'TimeInterval'.
fromTimeUnit :: TimeUnit t => t -> TimeInterval
fromTimeUnit = TimeInterval . toMicroseconds

-- | Convert a 'TimeInterval' to a 'TimeUnit' instance.
toTimeUnit :: TimeUnit t => TimeInterval -> t
toTimeUnit = fromMicroseconds . microseconds

-- | Specialized 'toTimeUnit' for converting to 'Microsecond' units.
toMicroUnit :: TimeInterval -> Microsecond
toMicroUnit = toTimeUnit

-- | Deprecated alias of 'fromTimeUnit'.
time :: TimeUnit t => t -> TimeInterval
time = fromTimeUnit
{-# DEPRECATED time "Use 'fromTimeUnit' instead" #-}

-- | Express a 'TimeInterval' in microseconds.
microseconds :: TimeInterval -> Integer
microseconds (TimeInterval i) = i