{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
module Data.Time.Orphans () where

import Data.Orphans ()

import Control.DeepSeq (NFData (..))
import Data.Ix (Ix)
import Data.Typeable (Typeable)
import Data.Data (Data)
import Data.Time
import Data.Time.Clock
import Data.Time.Clock.TAI
import Data.Time.Format
import Data.Hashable (Hashable (..))

import Data.Time.Format (TimeLocale (..))
import Data.Time.Clock.System

#if !MIN_VERSION_time(1,11,0)
import Data.Fixed (Pico)
import Text.Read (Read (..))
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec
#endif

#if MIN_VERSION_time(1,11,0)
import Data.Ix (Ix (..))
import Data.Time.Calendar.Month
import Data.Time.Calendar.Quarter
import Data.Time.Calendar.WeekDate
#endif

#if !MIN_VERSION_time(1,14,0)
import GHC.Generics (Generic)
import qualified Language.Haskell.TH.Syntax as TH
import Data.Fixed (Fixed (..), Pico)
#endif

#if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,11,0)
deriving instance Ord DayOfWeek
#endif

#if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,10,0)
deriving instance Data DayOfWeek
#endif

#if MIN_VERSION_time(1,8,0) && !MIN_VERSION_time(1,10,0)
deriving instance Data SystemTime
#endif

#if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,11,1)
instance NFData DayOfWeek where
    rnf !_ = ()

instance NFData CalendarDiffTime where
    rnf (CalendarDiffTime x y) = rnf x `seq` rnf y

instance NFData CalendarDiffDays where
    rnf (CalendarDiffDays x y) = rnf x `seq` rnf y

deriving instance Ix DayOfWeek
#endif

#if !MIN_VERSION_time(1,11,0)

instance Read DiffTime where
    readPrec = do
        t <- readPrec :: ReadPrec Pico
        _ <- lift $ char 's'
        return $ realToFrac t

instance Read NominalDiffTime where
    readPrec = do
        t <- readPrec :: ReadPrec Pico
        _ <- lift $ char 's'
        return $ realToFrac t

#endif

#if MIN_VERSION_time(1,11,0) && !MIN_VERSION_time(1,11,1)
instance NFData Month where
    rnf (MkMonth m) = rnf m

instance Enum Month where
    succ (MkMonth a) = MkMonth (succ a)
    pred (MkMonth a) = MkMonth (pred a)
    toEnum = MkMonth . toEnum
    fromEnum (MkMonth a) = fromEnum a
    enumFrom (MkMonth a) = fmap MkMonth (enumFrom a)
    enumFromThen (MkMonth a) (MkMonth b) = fmap MkMonth (enumFromThen a b)
    enumFromTo (MkMonth a) (MkMonth b) = fmap MkMonth (enumFromTo a b)
    enumFromThenTo (MkMonth a) (MkMonth b) (MkMonth c) =
        fmap MkMonth (enumFromThenTo a b c)

instance Ix Month where
    range (MkMonth a, MkMonth b) = fmap MkMonth (range (a, b))
    index (MkMonth a, MkMonth b) (MkMonth c) = index (a, b) c
    inRange (MkMonth a, MkMonth b) (MkMonth c) = inRange (a, b) c
    rangeSize (MkMonth a, MkMonth b) = rangeSize (a, b)

instance NFData QuarterOfYear where
    rnf Q1 = ()
    rnf Q2 = ()
    rnf Q3 = ()
    rnf Q4 = ()

instance NFData Quarter where
    rnf (MkQuarter m) = rnf m

instance Enum Quarter where
    succ (MkQuarter a) = MkQuarter (succ a)
    pred (MkQuarter a) = MkQuarter (pred a)
    toEnum = MkQuarter . toEnum
    fromEnum (MkQuarter a) = fromEnum a
    enumFrom (MkQuarter a) = fmap MkQuarter (enumFrom a)
    enumFromThen (MkQuarter a) (MkQuarter b) = fmap MkQuarter (enumFromThen a b)
    enumFromTo (MkQuarter a) (MkQuarter b) = fmap MkQuarter (enumFromTo a b)
    enumFromThenTo (MkQuarter a) (MkQuarter b) (MkQuarter c) =
        fmap MkQuarter (enumFromThenTo a b c)

instance Ix Quarter where
    range (MkQuarter a, MkQuarter b) = fmap MkQuarter (range (a, b))
    index (MkQuarter a, MkQuarter b) (MkQuarter c) = index (a, b) c
    inRange (MkQuarter a, MkQuarter b) (MkQuarter c) = inRange (a, b) c
    rangeSize (MkQuarter a, MkQuarter b) = rangeSize (a, b)

deriving instance Ix QuarterOfYear
#endif

-------------------------------------------------------------------------------
-- Lift & Generic
-------------------------------------------------------------------------------

#if !MIN_VERSION_time(1,14,0)
deriving instance TH.Lift Day
deriving instance TH.Lift UTCTime
deriving instance TH.Lift UniversalTime

deriving instance Generic Day
deriving instance Generic LocalTime
deriving instance Generic TimeOfDay
deriving instance Generic TimeZone
deriving instance Generic UTCTime
deriving instance Generic UniversalTime
deriving instance Generic ZonedTime

#if MIN_VERSION_time(1,9,0)
deriving instance TH.Lift DayOfWeek
deriving instance TH.Lift CalendarDiffDays

deriving instance Generic CalendarDiffDays
deriving instance Generic CalendarDiffTime
#endif

#if MIN_VERSION_time(1,11,0)
deriving instance Generic Quarter

deriving instance TH.Lift Month
deriving instance TH.Lift QuarterOfYear
deriving instance TH.Lift FirstWeekType
#endif

instance TH.Lift DiffTime where
    lift :: forall (m :: * -> *). Quote m => DiffTime -> m Exp
lift DiffTime
x = [| picosecondsToDiffTime x' |]
      where
        x' :: Integer
x' = DiffTime -> Integer
diffTimeToPicoseconds DiffTime
x

#if MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: forall (m :: * -> *). Quote m => DiffTime -> Code m DiffTime
liftTyped DiffTime
x = [|| Integer -> DiffTime
picosecondsToDiffTime Integer
x' ||]
      where
        x' :: Integer
x' = DiffTime -> Integer
diffTimeToPicoseconds DiffTime
x
#endif

#if MIN_VERSION_time(1,9,1)
instance TH.Lift NominalDiffTime where
    lift :: forall (m :: * -> *). Quote m => NominalDiffTime -> m Exp
lift NominalDiffTime
x = [| secondsToNominalDiffTime (MkFixed x' :: Pico) |]
      where
        x' :: Integer
x' = case NominalDiffTime -> Pico
nominalDiffTimeToSeconds NominalDiffTime
x of MkFixed Integer
y -> Integer
y

#if MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: forall (m :: * -> *).
Quote m =>
NominalDiffTime -> Code m NominalDiffTime
liftTyped NominalDiffTime
x = [|| Pico -> NominalDiffTime
secondsToNominalDiffTime (Integer -> Fixed a
forall k (a :: k). Integer -> Fixed a
MkFixed Integer
x' :: Pico) ||]
      where
        x' :: Integer
x' = case NominalDiffTime -> Pico
nominalDiffTimeToSeconds NominalDiffTime
x of MkFixed Integer
y -> Integer
y
#endif
#else
instance TH.Lift NominalDiffTime where
    lift x = [| realToFrac (MkFixed x' :: Pico) |]
      where
        x' = case realToFrac x :: Pico of MkFixed y -> y

#if MIN_VERSION_template_haskell(2,16,0)
    liftTyped x = [|| realToFrac (MkFixed x' :: Pico) ||]
      where
        x' = case realToFrac x :: Pico of MkFixed y -> y
#endif
#endif

#endif

-------------------------------------------------------------------------------
-- Hashable
-------------------------------------------------------------------------------

instance Hashable UniversalTime where
    hashWithSalt :: Int -> UniversalTime -> Int
hashWithSalt Int
salt = Int -> Rational -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Rational -> Int)
-> (UniversalTime -> Rational) -> UniversalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniversalTime -> Rational
getModJulianDate

instance Hashable DiffTime where
    hashWithSalt :: Int -> DiffTime -> Int
hashWithSalt Int
salt = Int -> Rational -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Rational -> Int) -> (DiffTime -> Rational) -> DiffTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational

instance Hashable UTCTime where
    hashWithSalt :: Int -> UTCTime -> Int
hashWithSalt Int
salt (UTCTime Day
d DiffTime
dt) =
        Int
salt Int -> Day -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Day
d Int -> DiffTime -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` DiffTime
dt

instance Hashable NominalDiffTime where
    hashWithSalt :: Int -> NominalDiffTime -> Int
hashWithSalt Int
salt = Int -> Rational -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Rational -> Int)
-> (NominalDiffTime -> Rational) -> NominalDiffTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational

instance Hashable Day where
    hashWithSalt :: Int -> Day -> Int
hashWithSalt Int
salt (ModifiedJulianDay Integer
d) = Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Integer
d

instance Hashable TimeZone where
    hashWithSalt :: Int -> TimeZone -> Int
hashWithSalt Int
salt (TimeZone Int
m Bool
s String
n) =
        Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
m Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
s Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
n

instance Hashable TimeOfDay where
    hashWithSalt :: Int -> TimeOfDay -> Int
hashWithSalt Int
salt (TimeOfDay Int
h Int
m Pico
s) =
        Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
h Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
m Int -> Pico -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Pico
s

instance Hashable LocalTime where
    hashWithSalt :: Int -> LocalTime -> Int
hashWithSalt Int
salt (LocalTime Day
d TimeOfDay
tod) =
        Int
salt Int -> Day -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Day
d Int -> TimeOfDay -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` TimeOfDay
tod

instance Hashable TimeLocale where
    hashWithSalt :: Int -> TimeLocale -> Int
hashWithSalt Int
salt (TimeLocale [(String, String)]
a [(String, String)]
b (String, String)
c String
d String
e String
f String
g [TimeZone]
h) =
      Int
salt Int -> [(String, String)] -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` [(String, String)]
a
           Int -> [(String, String)] -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` [(String, String)]
b
           Int -> (String, String) -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (String, String)
c
           Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
d
           Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
e
           Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
f
           Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
g
           Int -> [TimeZone] -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` [TimeZone]
h

#if MIN_VERSION_time(1,9,0)
instance Hashable DayOfWeek where
    hashWithSalt :: Int -> DayOfWeek -> Int
hashWithSalt Int
salt = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Int -> Int) -> (DayOfWeek -> Int) -> DayOfWeek -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum
#endif

#if MIN_VERSION_time(1,11,0)
instance Hashable Month where
    hashWithSalt :: Int -> Month -> Int
hashWithSalt Int
salt (MkMonth Integer
x) = Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Integer
x

instance Hashable Quarter where
    hashWithSalt :: Int -> Quarter -> Int
hashWithSalt Int
salt (MkQuarter Integer
x) = Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Integer
x

instance Hashable QuarterOfYear where
    hashWithSalt :: Int -> QuarterOfYear -> Int
hashWithSalt Int
salt = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Int -> Int) -> (QuarterOfYear -> Int) -> QuarterOfYear -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuarterOfYear -> Int
forall a. Enum a => a -> Int
fromEnum
#endif