module Data.HodaTime.LocalTime.Internal
(
   LocalTime(..)
  ,HasLocalTime(..)
  ,Hour
  ,Minute
  ,Second
  ,Nanosecond
  ,localTime
  ,midnight
  ,InvalidHourException(..)
  ,InvalidMinuteException(..)
  ,InvalidSecondException(..)
  ,InvalidNanoSecondException(..)
)
where

import Data.HodaTime.CalendarDateTime.Internal (LocalTime(..), CalendarDateTime(..), CalendarDate, day, IsCalendar(..))
import Data.HodaTime.Internal (hoursFromSecs, minutesFromSecs, secondsFromSecs, secondsFromHours, secondsFromMinutes)
import Data.HodaTime.Constants (secondsPerDay)
import Data.Functor.Identity (Identity(..))
import Data.Word (Word32)
import Control.Monad (unless)
import Control.Monad.Catch (MonadThrow, throwM)
import Control.Exception (Exception)
import Data.Typeable (Typeable)

-- Exceptions

-- | Given hour was not valid
data InvalidHourException = InvalidHourException
  deriving (Typeable, Int -> InvalidHourException -> ShowS
[InvalidHourException] -> ShowS
InvalidHourException -> String
(Int -> InvalidHourException -> ShowS)
-> (InvalidHourException -> String)
-> ([InvalidHourException] -> ShowS)
-> Show InvalidHourException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidHourException -> ShowS
showsPrec :: Int -> InvalidHourException -> ShowS
$cshow :: InvalidHourException -> String
show :: InvalidHourException -> String
$cshowList :: [InvalidHourException] -> ShowS
showList :: [InvalidHourException] -> ShowS
Show)

instance Exception InvalidHourException

-- | Given minute was not valid
data InvalidMinuteException = InvalidMinuteException
  deriving (Typeable, Int -> InvalidMinuteException -> ShowS
[InvalidMinuteException] -> ShowS
InvalidMinuteException -> String
(Int -> InvalidMinuteException -> ShowS)
-> (InvalidMinuteException -> String)
-> ([InvalidMinuteException] -> ShowS)
-> Show InvalidMinuteException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidMinuteException -> ShowS
showsPrec :: Int -> InvalidMinuteException -> ShowS
$cshow :: InvalidMinuteException -> String
show :: InvalidMinuteException -> String
$cshowList :: [InvalidMinuteException] -> ShowS
showList :: [InvalidMinuteException] -> ShowS
Show)

instance Exception InvalidMinuteException

-- | Given second was not valid
data InvalidSecondException = InvalidSecondException
  deriving (Typeable, Int -> InvalidSecondException -> ShowS
[InvalidSecondException] -> ShowS
InvalidSecondException -> String
(Int -> InvalidSecondException -> ShowS)
-> (InvalidSecondException -> String)
-> ([InvalidSecondException] -> ShowS)
-> Show InvalidSecondException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidSecondException -> ShowS
showsPrec :: Int -> InvalidSecondException -> ShowS
$cshow :: InvalidSecondException -> String
show :: InvalidSecondException -> String
$cshowList :: [InvalidSecondException] -> ShowS
showList :: [InvalidSecondException] -> ShowS
Show)

instance Exception InvalidSecondException

-- | Given nanosecond was not valid
data InvalidNanoSecondException = InvalidNanoSecondException
  deriving (Typeable, Int -> InvalidNanoSecondException -> ShowS
[InvalidNanoSecondException] -> ShowS
InvalidNanoSecondException -> String
(Int -> InvalidNanoSecondException -> ShowS)
-> (InvalidNanoSecondException -> String)
-> ([InvalidNanoSecondException] -> ShowS)
-> Show InvalidNanoSecondException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidNanoSecondException -> ShowS
showsPrec :: Int -> InvalidNanoSecondException -> ShowS
$cshow :: InvalidNanoSecondException -> String
show :: InvalidNanoSecondException -> String
$cshowList :: [InvalidNanoSecondException] -> ShowS
showList :: [InvalidNanoSecondException] -> ShowS
Show)

instance Exception InvalidNanoSecondException

-- Types

type Hour = Int
type Minute = Int
type Second = Int
type Nanosecond = Int

class HasLocalTime lt where
  -- | Lens for the hour component of the 'LocalTime'
  hour :: Functor f => (Hour -> f Hour) -> lt -> f lt
  -- | Lens for the minute component of the 'LocalTime'
  minute :: Functor f => (Minute -> f Minute) -> lt -> f lt
  -- | Lens for the second component of the 'LocalTime'
  second :: Functor f => (Second -> f Second) -> lt -> f lt
  -- | Lens for the nanoseconds component of the 'LocalTime'.  NOTE: no effort is made to detect nano overflow.  They will simply roll over on overflow without affecting the rest of the time.
  nanosecond :: Functor f => (Nanosecond -> f Nanosecond) -> lt -> f lt

instance HasLocalTime LocalTime where
  hour :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> LocalTime -> f LocalTime
hour Int -> f Int
f (LocalTime Word32
secs Word32
nsecs) = (Word32 -> LocalTime) -> (Int -> f Int) -> Word32 -> f LocalTime
forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> (Int -> f Int) -> b -> f a
hoursFromSecs Word32 -> LocalTime
to Int -> f Int
f Word32
secs
    where
      to :: Word32 -> LocalTime
to = Word32 -> Word32 -> LocalTime
fromSecondsClamped Word32
nsecs
  {-# INLINE hour #-}

  minute :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> LocalTime -> f LocalTime
minute Int -> f Int
f (LocalTime Word32
secs Word32
nsecs) = (Word32 -> LocalTime) -> (Int -> f Int) -> Word32 -> f LocalTime
forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> (Int -> f Int) -> b -> f a
minutesFromSecs Word32 -> LocalTime
to Int -> f Int
f Word32
secs
    where
      to :: Word32 -> LocalTime
to = Word32 -> Word32 -> LocalTime
fromSecondsClamped Word32
nsecs
  {-# INLINE minute #-}

  second :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> LocalTime -> f LocalTime
second Int -> f Int
f (LocalTime Word32
secs Word32
nsecs) = (Word32 -> LocalTime) -> (Int -> f Int) -> Word32 -> f LocalTime
forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> (Int -> f Int) -> b -> f a
secondsFromSecs Word32 -> LocalTime
to Int -> f Int
f Word32
secs
    where
      to :: Word32 -> LocalTime
to = Word32 -> Word32 -> LocalTime
fromSecondsClamped Word32
nsecs
  {-# INLINE second #-}

  nanosecond :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> LocalTime -> f LocalTime
nanosecond Int -> f Int
f (LocalTime Word32
secs Word32
nsecs) = Word32 -> Word32 -> LocalTime
LocalTime Word32
secs (Word32 -> LocalTime) -> (Int -> Word32) -> Int -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> LocalTime) -> f Int -> f LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> f Int
f (Int -> f Int) -> (Word32 -> Int) -> Word32 -> f Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Word32
nsecs
  {-# INLINE nanosecond #-}

instance IsCalendar cal => HasLocalTime (CalendarDateTime cal) where
  hour :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
hour Int -> f Int
f (CalendarDateTime CalendarDate cal
cd (LocalTime Word32
secs Word32
nsecs)) = (Word32 -> CalendarDateTime cal)
-> (Int -> f Int) -> Word32 -> f (CalendarDateTime cal)
forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> (Int -> f Int) -> b -> f a
hoursFromSecs Word32 -> CalendarDateTime cal
to Int -> f Int
f Word32
secs
    where
      to :: Word32 -> CalendarDateTime cal
to = CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
forall cal.
IsCalendar cal =>
CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
fromSecondsRolled CalendarDate cal
cd Word32
nsecs
  {-# INLINE hour #-}

  minute :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
minute Int -> f Int
f (CalendarDateTime CalendarDate cal
cd (LocalTime Word32
secs Word32
nsecs)) = (Word32 -> CalendarDateTime cal)
-> (Int -> f Int) -> Word32 -> f (CalendarDateTime cal)
forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> (Int -> f Int) -> b -> f a
minutesFromSecs Word32 -> CalendarDateTime cal
to Int -> f Int
f Word32
secs
    where
      to :: Word32 -> CalendarDateTime cal
to = CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
forall cal.
IsCalendar cal =>
CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
fromSecondsRolled CalendarDate cal
cd Word32
nsecs
  {-# INLINE minute #-}

  second :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
second Int -> f Int
f (CalendarDateTime CalendarDate cal
cd (LocalTime Word32
secs Word32
nsecs)) = (Word32 -> CalendarDateTime cal)
-> (Int -> f Int) -> Word32 -> f (CalendarDateTime cal)
forall (f :: * -> *) b a.
(Functor f, Num b, Integral b) =>
(b -> a) -> (Int -> f Int) -> b -> f a
secondsFromSecs Word32 -> CalendarDateTime cal
to Int -> f Int
f Word32
secs
    where
      to :: Word32 -> CalendarDateTime cal
to = CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
forall cal.
IsCalendar cal =>
CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
fromSecondsRolled CalendarDate cal
cd Word32
nsecs
  {-# INLINE second #-}

  nanosecond :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
nanosecond Int -> f Int
f (CalendarDateTime CalendarDate cal
cd LocalTime
lt) = CalendarDate cal -> LocalTime -> CalendarDateTime cal
forall calendar.
CalendarDate calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime CalendarDate cal
cd (LocalTime -> CalendarDateTime cal)
-> f LocalTime -> f (CalendarDateTime cal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> f Int) -> LocalTime -> f LocalTime
forall lt (f :: * -> *).
(HasLocalTime lt, Functor f) =>
(Int -> f Int) -> lt -> f lt
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> LocalTime -> f LocalTime
nanosecond Int -> f Int
f LocalTime
lt
  {-# INLINE nanosecond #-}

-- TODO:  Add an AM/PM lens which shows the current AM/PM based on if the time is after 12, and will add 12 to any number less than 12

-- | Private function for constructing a localtime at midnight
midnight :: LocalTime
midnight :: LocalTime
midnight = Word32 -> Word32 -> LocalTime
LocalTime Word32
0 Word32
0

-- helper functions

fromSecondsClamped :: Word32 -> Word32 -> LocalTime
fromSecondsClamped :: Word32 -> Word32 -> LocalTime
fromSecondsClamped Word32
nsecs = (Word32 -> Word32 -> LocalTime) -> Word32 -> Word32 -> LocalTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word32 -> Word32 -> LocalTime
LocalTime Word32
nsecs (Word32 -> LocalTime) -> (Word32 -> Word32) -> Word32 -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
forall {a}. (Ord a, Num a) => a -> a
normalize
  where
    normalize :: a -> a
normalize a
x = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
forall a. Num a => a
secondsPerDay then a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
forall a. Num a => a
secondsPerDay else a
x

fromSecondsRolled :: IsCalendar cal => CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
fromSecondsRolled :: forall cal.
IsCalendar cal =>
CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
fromSecondsRolled CalendarDate cal
date Word32
nsecs Word32
secs = CalendarDate cal -> LocalTime -> CalendarDateTime cal
forall calendar.
CalendarDate calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime CalendarDate cal
date' (LocalTime -> CalendarDateTime cal)
-> LocalTime -> CalendarDateTime cal
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> LocalTime
LocalTime Word32
secs' Word32
nsecs
    where
      (Word32
d, Word32
secs') = Word32
secs Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word32
forall a. Num a => a
secondsPerDay
      date' :: CalendarDate cal
date' = if Word32
d Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 then CalendarDate cal
date else Identity (CalendarDate cal) -> CalendarDate cal
forall a. Identity a -> a
runIdentity (Identity (CalendarDate cal) -> CalendarDate cal)
-> (CalendarDate cal -> Identity (CalendarDate cal))
-> CalendarDate cal
-> CalendarDate cal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int)
-> CalendarDate cal -> Identity (CalendarDate cal)
forall d (f :: * -> *).
(HasDate d, Functor f) =>
(Int -> f Int) -> d -> f d
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> CalendarDate cal -> f (CalendarDate cal)
day (Int -> Identity Int
forall a. a -> Identity a
Identity (Int -> Identity Int) -> (Int -> Int) -> Int -> Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
d)) (CalendarDate cal -> CalendarDate cal)
-> CalendarDate cal -> CalendarDate cal
forall a b. (a -> b) -> a -> b
$ CalendarDate cal
date  -- NOTE: inlining the modify lens here

-- constructors

-- | Create a new 'LocalTime' from an hour, minute, second and nanosecond if values are valid
localTime :: MonadThrow m => Hour -> Minute -> Second -> Nanosecond -> m LocalTime
localTime :: forall (m :: * -> *).
MonadThrow m =>
Int -> Int -> Int -> Int -> m LocalTime
localTime Int
h Int
m Int
s Int
ns = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24 Bool -> Bool -> Bool
&& Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ InvalidHourException -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM InvalidHourException
InvalidHourException
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
60 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ InvalidMinuteException -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM InvalidMinuteException
InvalidMinuteException
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
60 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ InvalidSecondException -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM InvalidSecondException
InvalidSecondException
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
ns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ InvalidNanoSecondException -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM InvalidNanoSecondException
InvalidNanoSecondException
  LocalTime -> m LocalTime
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> m LocalTime) -> LocalTime -> m LocalTime
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> LocalTime
LocalTime (Word32
h' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
m' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 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
    h' :: Word32
h' = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
secondsFromHours Int
h
    m' :: Word32
m' = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
secondsFromMinutes Int
m