{-# LANGUAGE NoImplicitPrelude #-}
-- |
-- Module:      Data.Aeson.Internal.Time
-- Copyright:   (c) 2015-2016 Bryan O'Sullivan
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   experimental
-- Portability: portable

module Data.Attoparsec.Time.Internal
    (
      TimeOfDay64(..)
    , fromPico
    , toPico
    , diffTimeOfDay64
    , toTimeOfDay64
    ) where

import Prelude.Compat

import Data.Fixed (Fixed(MkFixed), Pico)
import Data.Int (Int64)
import Data.Time (TimeOfDay(..))
import Data.Time.Clock.Compat

toPico :: Integer -> Pico
toPico :: Integer -> Pico
toPico = Integer -> Pico
forall k (a :: k). Integer -> Fixed a
MkFixed

fromPico :: Pico -> Integer
fromPico :: Pico -> Integer
fromPico (MkFixed Integer
i) = Integer
i

-- | Like TimeOfDay, but using a fixed-width integer for seconds.
data TimeOfDay64 = TOD {-# UNPACK #-} !Int
                       {-# UNPACK #-} !Int
                       {-# UNPACK #-} !Int64

posixDayLength :: DiffTime
posixDayLength :: DiffTime
posixDayLength = DiffTime
86400

diffTimeOfDay64 :: DiffTime -> TimeOfDay64
diffTimeOfDay64 :: DiffTime -> TimeOfDay64
diffTimeOfDay64 DiffTime
t
  | DiffTime
t DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
posixDayLength = Int -> Int -> Int64 -> TimeOfDay64
TOD Int
23 Int
59 (Int64
60000000000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ DiffTime -> Int64
pico (DiffTime
t DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
- DiffTime
posixDayLength))
  | Bool
otherwise = Int -> Int -> Int64 -> TimeOfDay64
TOD (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
h) (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m) Int64
s
    where (Int64
h,Int64
mp) = DiffTime -> Int64
pico DiffTime
t Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
3600000000000000
          (Int64
m,Int64
s)  = Int64
mp Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
60000000000000
          pico :: DiffTime -> Int64
pico   = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> (DiffTime -> Integer) -> DiffTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToPicoseconds

toTimeOfDay64 :: TimeOfDay -> TimeOfDay64
toTimeOfDay64 :: TimeOfDay -> TimeOfDay64
toTimeOfDay64 (TimeOfDay Int
h Int
m Pico
s) = Int -> Int -> Int64 -> TimeOfDay64
TOD Int
h Int
m (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pico -> Integer
fromPico Pico
s))