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

import Data.Orphans ()

import Control.DeepSeq (NFData (..))
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
#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
#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)
#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