{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Binary.Instances.Time where

import Control.Monad       (liftM2, liftM3)
import Data.Binary         (Binary, Get, Put, get, put)
import Data.Binary.Orphans ()
import Data.Word           (Word8)

import qualified Data.Fixed                        as Fixed
import qualified Data.Time.Calendar.Compat         as Time
import qualified Data.Time.Calendar.Month.Compat   as Time
import qualified Data.Time.Calendar.Quarter.Compat as Time
import qualified Data.Time.Clock.Compat            as Time
import qualified Data.Time.Clock.System.Compat     as Time
import qualified Data.Time.Clock.TAI.Compat        as Time
import qualified Data.Time.LocalTime.Compat        as Time

instance Binary Time.Day where
  get :: Get Day
get = (Integer -> Day) -> Get Integer -> Get Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Day
Time.ModifiedJulianDay Get Integer
forall t. Binary t => Get t
get
  put :: Day -> Put
put = Integer -> Put
forall t. Binary t => t -> Put
put (Integer -> Put) -> (Day -> Integer) -> Day -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer
Time.toModifiedJulianDay

instance Binary Time.UniversalTime where
  get :: Get UniversalTime
get = (Rational -> UniversalTime) -> Get Rational -> Get UniversalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> UniversalTime
Time.ModJulianDate Get Rational
forall t. Binary t => Get t
get
  put :: UniversalTime -> Put
put = Rational -> Put
forall t. Binary t => t -> Put
put (Rational -> Put)
-> (UniversalTime -> Rational) -> UniversalTime -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniversalTime -> Rational
Time.getModJulianDate

instance Binary Time.DiffTime where
  get :: Get DiffTime
get = (Integer -> DiffTime) -> Get Integer -> Get DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> DiffTime
Time.picosecondsToDiffTime Get Integer
forall t. Binary t => Get t
get
  put :: DiffTime -> Put
put = (Pico -> Put
forall t. Binary t => t -> Put
put :: Fixed.Pico -> Put)  (Pico -> Put) -> (DiffTime -> Pico) -> DiffTime -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance Binary Time.UTCTime where
  get :: Get UTCTime
get = (Day -> DiffTime -> UTCTime)
-> Get Day -> Get DiffTime -> Get UTCTime
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Day -> DiffTime -> UTCTime
Time.UTCTime Get Day
forall t. Binary t => Get t
get Get DiffTime
forall t. Binary t => Get t
get
  put :: UTCTime -> Put
put (Time.UTCTime Day
d DiffTime
dt) = Day -> Put
forall t. Binary t => t -> Put
put Day
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiffTime -> Put
forall t. Binary t => t -> Put
put DiffTime
dt

instance Binary Time.NominalDiffTime where
  get :: Get NominalDiffTime
get = (Pico -> NominalDiffTime) -> Get Pico -> Get NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pico -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Get Pico
forall t. Binary t => Get t
get :: Get Fixed.Pico)
  put :: NominalDiffTime -> Put
put = (Pico -> Put
forall t. Binary t => t -> Put
put :: Fixed.Pico -> Put)  (Pico -> Put)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance Binary Time.TimeZone where
  get :: Get TimeZone
get = (Int -> Bool -> String -> TimeZone)
-> Get Int -> Get Bool -> Get String -> Get TimeZone
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 Int -> Bool -> String -> TimeZone
Time.TimeZone Get Int
forall t. Binary t => Get t
get Get Bool
forall t. Binary t => Get t
get Get String
forall t. Binary t => Get t
get
  put :: TimeZone -> Put
put (Time.TimeZone Int
m Bool
s String
n) = Int -> Put
forall t. Binary t => t -> Put
put Int
m Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
s Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
n

instance Binary Time.TimeOfDay where
  get :: Get TimeOfDay
get = (Int -> Int -> Pico -> TimeOfDay)
-> Get Int -> Get Int -> Get Pico -> Get TimeOfDay
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 Int -> Int -> Pico -> TimeOfDay
Time.TimeOfDay Get Int
forall t. Binary t => Get t
get Get Int
forall t. Binary t => Get t
get Get Pico
forall t. Binary t => Get t
get
  put :: TimeOfDay -> Put
put (Time.TimeOfDay Int
h Int
m Pico
s) = Int -> Put
forall t. Binary t => t -> Put
put Int
h Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
m Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pico -> Put
forall t. Binary t => t -> Put
put Pico
s

instance Binary Time.LocalTime where
  get :: Get LocalTime
get = (Day -> TimeOfDay -> LocalTime)
-> Get Day -> Get TimeOfDay -> Get LocalTime
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Day -> TimeOfDay -> LocalTime
Time.LocalTime Get Day
forall t. Binary t => Get t
get Get TimeOfDay
forall t. Binary t => Get t
get
  put :: LocalTime -> Put
put (Time.LocalTime Day
d TimeOfDay
tod) = Day -> Put
forall t. Binary t => t -> Put
put Day
d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeOfDay -> Put
forall t. Binary t => t -> Put
put TimeOfDay
tod

instance Binary Time.ZonedTime where
  get :: Get ZonedTime
get = (LocalTime -> TimeZone -> ZonedTime)
-> Get LocalTime -> Get TimeZone -> Get ZonedTime
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 LocalTime -> TimeZone -> ZonedTime
Time.ZonedTime Get LocalTime
forall t. Binary t => Get t
get Get TimeZone
forall t. Binary t => Get t
get
  put :: ZonedTime -> Put
put (Time.ZonedTime LocalTime
t TimeZone
z) = LocalTime -> Put
forall t. Binary t => t -> Put
put LocalTime
t Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeZone -> Put
forall t. Binary t => t -> Put
put TimeZone
z

instance Binary Time.AbsoluteTime where
  get :: Get AbsoluteTime
get = (DiffTime -> AbsoluteTime) -> Get DiffTime -> Get AbsoluteTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DiffTime -> AbsoluteTime -> AbsoluteTime)
-> AbsoluteTime -> DiffTime -> AbsoluteTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip DiffTime -> AbsoluteTime -> AbsoluteTime
Time.addAbsoluteTime AbsoluteTime
Time.taiEpoch) Get DiffTime
forall t. Binary t => Get t
get
  put :: AbsoluteTime -> Put
put = DiffTime -> Put
forall t. Binary t => t -> Put
put (DiffTime -> Put)
-> (AbsoluteTime -> DiffTime) -> AbsoluteTime -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsoluteTime -> AbsoluteTime -> DiffTime)
-> AbsoluteTime -> AbsoluteTime -> DiffTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip AbsoluteTime -> AbsoluteTime -> DiffTime
Time.diffAbsoluteTime AbsoluteTime
Time.taiEpoch

instance Binary Time.SystemTime where
    get :: Get SystemTime
get = (Int64 -> Word32 -> SystemTime)
-> Get Int64 -> Get Word32 -> Get SystemTime
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Int64 -> Word32 -> SystemTime
Time.MkSystemTime Get Int64
forall t. Binary t => Get t
get Get Word32
forall t. Binary t => Get t
get
    put :: SystemTime -> Put
put (Time.MkSystemTime Int64
s Word32
ns) = Int64 -> Put
forall t. Binary t => t -> Put
put Int64
s Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall t. Binary t => t -> Put
put Word32
ns

instance Binary Time.CalendarDiffDays where
    get :: Get CalendarDiffDays
get = (Integer -> Integer -> CalendarDiffDays)
-> Get Integer -> Get Integer -> Get CalendarDiffDays
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Integer -> Integer -> CalendarDiffDays
Time.CalendarDiffDays Get Integer
forall t. Binary t => Get t
get Get Integer
forall t. Binary t => Get t
get
    put :: CalendarDiffDays -> Put
put (Time.CalendarDiffDays Integer
m Integer
d) = Integer -> Put
forall t. Binary t => t -> Put
put Integer
m Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Put
forall t. Binary t => t -> Put
put Integer
d

instance Binary Time.CalendarDiffTime where
    get :: Get CalendarDiffTime
get = (Integer -> NominalDiffTime -> CalendarDiffTime)
-> Get Integer -> Get NominalDiffTime -> Get CalendarDiffTime
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Integer -> NominalDiffTime -> CalendarDiffTime
Time.CalendarDiffTime Get Integer
forall t. Binary t => Get t
get Get NominalDiffTime
forall t. Binary t => Get t
get
    put :: CalendarDiffTime -> Put
put (Time.CalendarDiffTime Integer
m NominalDiffTime
nt) = Integer -> Put
forall t. Binary t => t -> Put
put Integer
m Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NominalDiffTime -> Put
forall t. Binary t => t -> Put
put NominalDiffTime
nt

instance Binary Time.DayOfWeek where
    put :: DayOfWeek -> Put
put DayOfWeek
Time.Sunday    = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
0 :: Word8)
    put DayOfWeek
Time.Monday    = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
1 :: Word8)
    put DayOfWeek
Time.Tuesday   = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
2 :: Word8)
    put DayOfWeek
Time.Wednesday = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
3 :: Word8)
    put DayOfWeek
Time.Thursday  = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
4 :: Word8)
    put DayOfWeek
Time.Friday    = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
5 :: Word8)
    put DayOfWeek
Time.Saturday  = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
6 :: Word8)

    get :: Get DayOfWeek
get = do
        Word8
i <- Get Word8
forall t. Binary t => Get t
get
        DayOfWeek -> Get DayOfWeek
forall (m :: * -> *) a. Monad m => a -> m a
return (DayOfWeek -> Get DayOfWeek) -> DayOfWeek -> Get DayOfWeek
forall a b. (a -> b) -> a -> b
$ case Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
mod (Word8
i :: Word8) Word8
7 of
            Word8
0 -> DayOfWeek
Time.Sunday
            Word8
1 -> DayOfWeek
Time.Monday
            Word8
2 -> DayOfWeek
Time.Tuesday
            Word8
3 -> DayOfWeek
Time.Wednesday
            Word8
4 -> DayOfWeek
Time.Thursday
            Word8
5 -> DayOfWeek
Time.Friday
            Word8
6 -> DayOfWeek
Time.Saturday
            Word8
_ -> String -> DayOfWeek
forall a. HasCallStack => String -> a
error String
"panic: get @DayOfWeek"

instance Binary Time.Month where
    put :: Month -> Put
put (Time.MkMonth Integer
m) = Integer -> Put
forall t. Binary t => t -> Put
put Integer
m
    get :: Get Month
get = (Integer -> Month) -> Get Integer -> Get Month
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Month
Time.MkMonth Get Integer
forall t. Binary t => Get t
get

instance Binary Time.Quarter where
    put :: Quarter -> Put
put (Time.MkQuarter Integer
m) = Integer -> Put
forall t. Binary t => t -> Put
put Integer
m
    get :: Get Quarter
get = (Integer -> Quarter) -> Get Integer -> Get Quarter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Quarter
Time.MkQuarter Get Integer
forall t. Binary t => Get t
get

instance Binary Time.QuarterOfYear where
    put :: QuarterOfYear -> Put
put QuarterOfYear
Time.Q1 = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
1 :: Word8)
    put QuarterOfYear
Time.Q2 = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
2 :: Word8)
    put QuarterOfYear
Time.Q3 = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
3 :: Word8)
    put QuarterOfYear
Time.Q4 = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
4 :: Word8)

    get :: Get QuarterOfYear
get = do
        Word8
i <- Get Word8
forall t. Binary t => Get t
get
        QuarterOfYear -> Get QuarterOfYear
forall (m :: * -> *) a. Monad m => a -> m a
return (QuarterOfYear -> Get QuarterOfYear)
-> QuarterOfYear -> Get QuarterOfYear
forall a b. (a -> b) -> a -> b
$ case Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
mod (Word8
i :: Word8) Word8
7 of
            Word8
1 -> QuarterOfYear
Time.Q1
            Word8
2 -> QuarterOfYear
Time.Q2
            Word8
3 -> QuarterOfYear
Time.Q3
            Word8
4 -> QuarterOfYear
Time.Q4
            Word8
_ -> String -> QuarterOfYear
forall a. HasCallStack => String -> a
error String
"panic: get @DayOfWeek"