-----------------------------------------------------------------------------
-- |
-- Module      :  Data.HodaTime.Duration
-- Copyright   :  (C) 2016 Jason Johnson
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>
-- Stability   :  experimental
-- Portability :  TBD
--
-- A 'Duration' is fixed period of time between global times.
----------------------------------------------------------------------------
module Data.HodaTime.Duration
(
  -- * Types
   Duration
  -- * Constructors
  ,fromStandardWeeks
  ,fromStandardDays
  ,fromHours
  ,fromMinutes
  ,fromSeconds
  ,fromMilliseconds
  ,fromMicroseconds
  ,fromNanoseconds
  -- * Math
  ,add
  ,minus
)
where

import Data.HodaTime.Duration.Internal
import Data.HodaTime.Instant.Internal (Instant(..))
import Data.HodaTime.Instant (difference)
import qualified Data.HodaTime.Instant as I (add)
import Data.HodaTime.Constants (secondsPerHour)

-- | Duration of standard weeks (a standard week is assumed to be exactly 7 24 hour days)
fromStandardWeeks :: Int -> Duration
fromStandardWeeks :: Int -> Duration
fromStandardWeeks Int
w = Int -> Duration
fromStandardDays (Int -> Duration) -> Int -> Duration
forall a b. (a -> b) -> a -> b
$ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7

-- | Duration of standard days (a standard day is assumed to be exactly 24 hours)
fromStandardDays :: Int -> Duration
fromStandardDays :: Int -> Duration
fromStandardDays Int
d = Instant -> Duration
Duration (Instant -> Duration) -> Instant -> Duration
forall a b. (a -> b) -> a -> b
$ Int32 -> Word32 -> Word32 -> Instant
Instant (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d) Word32
0 Word32
0

-- | Duration of hours
fromHours :: Int -> Duration
fromHours :: Int -> Duration
fromHours = Int -> Duration
fromSeconds (Int -> Duration) -> (Int -> Int) -> Int -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
secondsPerHour)

-- | Duration of minutes
fromMinutes :: Int -> Duration
fromMinutes :: Int -> Duration
fromMinutes = Int -> Duration
fromSeconds (Int -> Duration) -> (Int -> Int) -> Int -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60)

-- | Duration of milliseconds
fromMilliseconds :: Int -> Duration
fromMilliseconds :: Int -> Duration
fromMilliseconds = Int -> Duration
fromNanoseconds (Int -> Duration) -> (Int -> Int) -> Int -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000)

-- | Duration of microseconds
fromMicroseconds :: Int -> Duration
fromMicroseconds :: Int -> Duration
fromMicroseconds = Int -> Duration
fromNanoseconds (Int -> Duration) -> (Int -> Int) -> Int -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)

-- | Add two durations together
add :: Duration -> Duration -> Duration
add :: Duration -> Duration -> Duration
add (Duration Instant
instant) = Instant -> Duration
Duration (Instant -> Duration)
-> (Duration -> Instant) -> Duration -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instant -> Duration -> Instant
I.add Instant
instant

-- | Subtract one duration from the other
minus :: Duration -> Duration -> Duration
minus :: Duration -> Duration -> Duration
minus (Duration Instant
linstant) (Duration Instant
rinstant) = Instant -> Instant -> Duration
difference Instant
linstant Instant
rinstant