module Data.HodaTime.Duration.Internal
(
   Duration(..)
  ,normalize
  ,fromSeconds
  ,fromNanoseconds
)
where

import Data.HodaTime.Instant.Internal (Instant(..), Duration(..))
import Control.Arrow ((>>>), (***), first)
import Data.HodaTime.Constants (secondsPerDay, nsecsPerSecond)

normalize :: Int -> Int -> (Int, Int)
normalize :: Int -> Int -> (Int, Int)
normalize Int
x Int
size
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size = Int -> (Int, Int)
pos Int
x
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> (Int, Int)
neg Int
x
    | Bool
otherwise = (Int
0, Int
x)
    where
        split :: Int -> (Int, Int)
split = (Int -> Int -> (Int, Int)) -> Int -> Int -> (Int, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
size
        pos :: Int -> (Int, Int)
pos = Int -> (Int, Int)
split (Int -> (Int, Int))
-> ((Int, Int) -> (Int, Int)) -> Int -> (Int, Int)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Int) -> (Int, Int) -> (Int, Int)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
        neg :: Int -> (Int, Int)
neg = Int -> (Int, Int)
negArrow (Int -> (Int, Int)) -> (Int -> Int) -> Int -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
abs
        negAdjust :: (Int, Int) -> (Int, Int)
negAdjust = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Int -> Int) -> (Int, Int) -> (Int, Int)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate
        negArrow :: Int -> (Int, Int)
negArrow Int
x' = let (Int
b,Int
s) = Int -> (Int, Int)
split Int
x' in
          if Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then (Int -> Int
forall a. Num a => a -> a
negate Int
b,Int
s)     -- In the case that x' splits exactly we don't need to adjust further
          else (Int, Int) -> (Int, Int)
negAdjust (Int
b,Int
s)

-- | Duration of seconds
fromSeconds :: Int -> Duration
fromSeconds :: Int -> Duration
fromSeconds Int
s = 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) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s') Word32
0
    where
        (Int
d, Int
s') = Int -> Int -> (Int, Int)
normalize Int
s Int
forall a. Num a => a
secondsPerDay

-- | Duration of nanoseconds
fromNanoseconds :: Int -> Duration
fromNanoseconds :: Int -> Duration
fromNanoseconds Int
ns = 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) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s') (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ns')
    where
        (Int
s, Int
ns') = Int -> Int -> (Int, Int)
normalize Int
ns Int
forall a. Num a => a
nsecsPerSecond
        (Int
d, Int
s') = Int -> Int -> (Int, Int)
normalize Int
s Int
forall a. Num a => a
secondsPerDay