module Data.HodaTime.Internal
(
   secondsFromSeconds
  ,secondsFromMinutes
  ,secondsFromHours
  ,hoursFromSecs
  ,minutesFromSecs
  ,secondsFromSecs
  ,clamp
)
where

import Data.HodaTime.Constants (secondsPerHour, secondsPerMinute)

-- conversion

secondsFromSeconds :: (Integral a, Num b) => a -> b
secondsFromSeconds :: forall a b. (Integral a, Num b) => a -> b
secondsFromSeconds = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE secondsFromSeconds #-}

secondsFromMinutes :: (Integral a, Num b) => a -> b
secondsFromMinutes :: forall a b. (Integral a, Num b) => a -> b
secondsFromMinutes = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Num a => a
secondsPerMinute)
{-# INLINE secondsFromMinutes #-}

secondsFromHours :: (Integral a, Num b) => a -> b
secondsFromHours :: forall a b. (Integral a, Num b) => a -> b
secondsFromHours = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Num a => a
secondsPerHour)
{-# INLINE secondsFromHours #-}

-- lenses

hoursFromSecs :: (Functor f, Num b, Integral b) => (b -> a) -> (Int -> f Int) -> b -> f a
hoursFromSecs :: forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> (Int -> f Int) -> b -> f a
hoursFromSecs b -> a
to Int -> f Int
f b
secs = (b -> a) -> b -> b -> (b -> b) -> (Int -> f Int) -> f a
forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> b -> b -> (b -> b) -> (Int -> f Int) -> f a
unitFromSeconds b -> a
to b
h b
r (b -> b -> b
forall a. Num a => a -> a -> a
*b
forall a. Num a => a
secondsPerHour) Int -> f Int
f
  where
    h :: b
h = b
secs b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
forall a. Num a => a
secondsPerHour
    r :: b
r = b
secs b -> b -> b
forall a. Num a => a -> a -> a
- (b
hb -> b -> b
forall a. Num a => a -> a -> a
*b
forall a. Num a => a
secondsPerHour)
{-# INLINE hoursFromSecs #-}

minutesFromSecs :: (Functor f, Num b, Integral b) => (b -> a) -> (Int -> f Int) -> b -> f a
minutesFromSecs :: forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> (Int -> f Int) -> b -> f a
minutesFromSecs b -> a
to Int -> f Int
f b
secs = (b -> a) -> b -> b -> (b -> b) -> (Int -> f Int) -> f a
forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> b -> b -> (b -> b) -> (Int -> f Int) -> f a
unitFromSeconds b -> a
to b
m b
r (b -> b -> b
forall a. Num a => a -> a -> a
*b
60) Int -> f Int
f
  where
    m :: b
m = b
secs b -> b -> b
forall a. Integral a => a -> a -> a
`mod` b
forall a. Num a => a
secondsPerHour b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
60
    r :: b
r = b
secs b -> b -> b
forall a. Num a => a -> a -> a
- (b
mb -> b -> b
forall a. Num a => a -> a -> a
*b
60)
{-# INLINE minutesFromSecs #-}

secondsFromSecs :: (Functor f, Num b, Integral b) => (b -> a) -> (Int -> f Int) -> b -> f a
secondsFromSecs :: forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> (Int -> f Int) -> b -> f a
secondsFromSecs b -> a
to Int -> f Int
f b
secs = (b -> a) -> b -> b -> (b -> b) -> (Int -> f Int) -> f a
forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> b -> b -> (b -> b) -> (Int -> f Int) -> f a
unitFromSeconds b -> a
to b
s b
r b -> b
forall a. a -> a
id Int -> f Int
f
  where
    s :: b
s = b
secs b -> b -> b
forall a. Integral a => a -> a -> a
`mod` b
60
    r :: b
r = b
secs b -> b -> b
forall a. Num a => a -> a -> a
- b
s
{-# INLINE secondsFromSecs #-}

-- utility

clamp :: Ord a => a -> a -> a -> a
clamp :: forall a. Ord a => a -> a -> a -> a
clamp a
small a
big = a -> a -> a
forall a. Ord a => a -> a -> a
min a
big (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
max a
small
{-# INLINE clamp #-}

-- helper functions

unitFromSeconds :: (Functor f, Num b, Integral b) => (b -> a) -> b -> b -> (b -> b) -> (Int -> f Int) -> f a
unitFromSeconds :: forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> b -> b -> (b -> b) -> (Int -> f Int) -> f a
unitFromSeconds b -> a
to b
unit b
rest b -> b
fromSecs Int -> f Int
f = b -> a
to (b -> a) -> (Int -> b) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b
restb -> b -> b
forall a. Num a => a -> a -> a
+) (b -> b) -> (Int -> b) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
fromSecs (b -> b) -> (Int -> b) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> f Int -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f (b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
unit)
{-# INLINE unitFromSeconds #-}