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, setDay, IsCalendar(..))
import Data.HodaTime.Internal (secondsFromHours, secondsFromMinutes)
import Data.HodaTime.Constants (secondsPerDay)
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, Second -> InvalidHourException -> ShowS
[InvalidHourException] -> ShowS
InvalidHourException -> String
(Second -> InvalidHourException -> ShowS)
-> (InvalidHourException -> String)
-> ([InvalidHourException] -> ShowS)
-> Show InvalidHourException
forall a.
(Second -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Second -> InvalidHourException -> ShowS
showsPrec :: Second -> 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, Second -> InvalidMinuteException -> ShowS
[InvalidMinuteException] -> ShowS
InvalidMinuteException -> String
(Second -> InvalidMinuteException -> ShowS)
-> (InvalidMinuteException -> String)
-> ([InvalidMinuteException] -> ShowS)
-> Show InvalidMinuteException
forall a.
(Second -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Second -> InvalidMinuteException -> ShowS
showsPrec :: Second -> 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, Second -> InvalidSecondException -> ShowS
[InvalidSecondException] -> ShowS
InvalidSecondException -> String
(Second -> InvalidSecondException -> ShowS)
-> (InvalidSecondException -> String)
-> ([InvalidSecondException] -> ShowS)
-> Show InvalidSecondException
forall a.
(Second -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Second -> InvalidSecondException -> ShowS
showsPrec :: Second -> 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, Second -> InvalidNanoSecondException -> ShowS
[InvalidNanoSecondException] -> ShowS
InvalidNanoSecondException -> String
(Second -> InvalidNanoSecondException -> ShowS)
-> (InvalidNanoSecondException -> String)
-> ([InvalidNanoSecondException] -> ShowS)
-> Show InvalidNanoSecondException
forall a.
(Second -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Second -> InvalidNanoSecondException -> ShowS
showsPrec :: Second -> 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
  hour :: lt -> Hour
  setHour :: Hour -> lt -> lt
  minute :: lt -> Minute
  setMinute :: Minute -> lt -> lt
  second :: lt -> Second
  setSecond :: Second -> lt -> lt
  nanosecond :: lt -> Nanosecond
  setNanosecond :: Nanosecond -> lt -> lt

instance HasLocalTime LocalTime where
  hour :: LocalTime -> Second
hour (LocalTime Word32
secs Word32
_) = Word32 -> Second
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
secs Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
3600)
  {-# INLINE hour #-}
  setHour :: Second -> LocalTime -> LocalTime
setHour Second
value (LocalTime Word32
secs Word32
nsecs) = Word32 -> Word32 -> LocalTime
fromSecondsClamped Word32
nsecs (Second -> Word32 -> Word32
replaceHour Second
value Word32
secs)

  minute :: LocalTime -> Second
minute (LocalTime Word32
secs Word32
_) = Word32 -> Second
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
secs Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
3600 Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
60)
  {-# INLINE minute #-}
  setMinute :: Second -> LocalTime -> LocalTime
setMinute Second
value (LocalTime Word32
secs Word32
nsecs) = Word32 -> Word32 -> LocalTime
fromSecondsClamped Word32
nsecs (Second -> Word32 -> Word32
replaceMinute Second
value Word32
secs)

  second :: LocalTime -> Second
second (LocalTime Word32
secs Word32
_) = Word32 -> Second
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
secs Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
60)
  {-# INLINE second #-}
  setSecond :: Second -> LocalTime -> LocalTime
setSecond Second
value (LocalTime Word32
secs Word32
nsecs) = Word32 -> Word32 -> LocalTime
fromSecondsClamped Word32
nsecs (Second -> Word32 -> Word32
replaceSecond Second
value Word32
secs)

  nanosecond :: LocalTime -> Second
nanosecond (LocalTime Word32
_ Word32
nsecs) = Word32 -> Second
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nsecs
  {-# INLINE nanosecond #-}
  setNanosecond :: Second -> LocalTime -> LocalTime
setNanosecond Second
value (LocalTime Word32
secs Word32
_) = Word32 -> Word32 -> LocalTime
LocalTime Word32
secs (Second -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Second
value)

instance IsCalendar cal => HasLocalTime (CalendarDateTime cal) where
  hour :: CalendarDateTime cal -> Second
hour (CalendarDateTime Date cal
_ LocalTime
lt) = LocalTime -> Second
forall lt. HasLocalTime lt => lt -> Second
hour LocalTime
lt
  {-# INLINE hour #-}
  setHour :: Second -> CalendarDateTime cal -> CalendarDateTime cal
setHour Second
value (CalendarDateTime Date cal
cd (LocalTime Word32
secs Word32
nsecs)) = Date cal -> Word32 -> Word32 -> CalendarDateTime cal
forall cal.
IsCalendar cal =>
CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
fromSecondsRolled Date cal
cd Word32
nsecs (Second -> Word32 -> Word32
replaceHour Second
value Word32
secs)

  minute :: CalendarDateTime cal -> Second
minute (CalendarDateTime Date cal
_ LocalTime
lt) = LocalTime -> Second
forall lt. HasLocalTime lt => lt -> Second
minute LocalTime
lt
  {-# INLINE minute #-}
  setMinute :: Second -> CalendarDateTime cal -> CalendarDateTime cal
setMinute Second
value (CalendarDateTime Date cal
cd (LocalTime Word32
secs Word32
nsecs)) = Date cal -> Word32 -> Word32 -> CalendarDateTime cal
forall cal.
IsCalendar cal =>
CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
fromSecondsRolled Date cal
cd Word32
nsecs (Second -> Word32 -> Word32
replaceMinute Second
value Word32
secs)

  second :: CalendarDateTime cal -> Second
second (CalendarDateTime Date cal
_ LocalTime
lt) = LocalTime -> Second
forall lt. HasLocalTime lt => lt -> Second
second LocalTime
lt
  {-# INLINE second #-}
  setSecond :: Second -> CalendarDateTime cal -> CalendarDateTime cal
setSecond Second
value (CalendarDateTime Date cal
cd (LocalTime Word32
secs Word32
nsecs)) = Date cal -> Word32 -> Word32 -> CalendarDateTime cal
forall cal.
IsCalendar cal =>
CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
fromSecondsRolled Date cal
cd Word32
nsecs (Second -> Word32 -> Word32
replaceSecond Second
value Word32
secs)

  nanosecond :: CalendarDateTime cal -> Second
nanosecond (CalendarDateTime Date cal
_ LocalTime
lt) = LocalTime -> Second
forall lt. HasLocalTime lt => lt -> Second
nanosecond LocalTime
lt
  {-# INLINE nanosecond #-}
  setNanosecond :: Second -> CalendarDateTime cal -> CalendarDateTime cal
setNanosecond Second
value (CalendarDateTime Date cal
cd LocalTime
lt) = Date cal -> LocalTime -> CalendarDateTime cal
forall calendar.
Date calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime Date cal
cd (Second -> LocalTime -> LocalTime
forall lt. HasLocalTime lt => Second -> lt -> lt
setNanosecond Second
value LocalTime
lt)

-- NOTE: AM/PM is handled in the pattern layer (see Data.HodaTime.Pattern.LocalTime): the
--       designator and the 12-hour hour each rewrite only their half of the 'hour' via div/mod 12, which keeps
--       them order independent when composed.

-- | 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.
Date 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 Second -> CalendarDate cal -> CalendarDate cal
forall d. HasDate d => Second -> d -> d
setDay (CalendarDate cal -> Second
forall d. HasDate d => d -> Second
day CalendarDate cal
date Second -> Second -> Second
forall a. Num a => a -> a -> a
+ Word32 -> Second
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
d) CalendarDate cal
date

replaceHour :: Hour -> Word32 -> Word32
replaceHour :: Second -> Word32 -> Word32
replaceHour Second
value Word32
secs = Word32
secs Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- (Word32
secs Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
3600 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
3600) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Second -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Second
value Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
3600

replaceMinute :: Minute -> Word32 -> Word32
replaceMinute :: Second -> Word32 -> Word32
replaceMinute Second
value Word32
secs = Word32
secs Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- (Word32
secs Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
3600 Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
60 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
60) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Second -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Second
value Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
60

replaceSecond :: Second -> Word32 -> Word32
replaceSecond :: Second -> Word32 -> Word32
replaceSecond Second
value Word32
secs = Word32
secs Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
secs Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
60 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Second -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Second
value

-- 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 =>
Second -> Second -> Second -> Second -> m LocalTime
localTime Second
h Second
m Second
s Second
ns = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Second
h Second -> Second -> Bool
forall a. Ord a => a -> a -> Bool
< Second
24 Bool -> Bool -> Bool
&& Second
h Second -> Second -> Bool
forall a. Ord a => a -> a -> Bool
>= Second
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 (Second
m Second -> Second -> Bool
forall a. Ord a => a -> a -> Bool
< Second
60 Bool -> Bool -> Bool
&& Second
m Second -> Second -> Bool
forall a. Ord a => a -> a -> Bool
>= Second
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 (Second
s Second -> Second -> Bool
forall a. Ord a => a -> a -> Bool
< Second
60 Bool -> Bool -> Bool
&& Second
m Second -> Second -> Bool
forall a. Ord a => a -> a -> Bool
>= Second
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 (Second
ns Second -> Second -> Bool
forall a. Ord a => a -> a -> Bool
>= Second
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
+ Second -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Second
s) (Second -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Second
ns)
  where
    h' :: Word32
h' = Second -> Word32
forall a b. (Integral a, Num b) => a -> b
secondsFromHours Second
h
    m' :: Word32
m' = Second -> Word32
forall a b. (Integral a, Num b) => a -> b
secondsFromMinutes Second
m