{-# 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 (..))

#if MIN_VERSION_time(1,5,0)
import Data.Time.Format (TimeLocale (..))
#else
import System.Locale (TimeLocale (..))
#endif

#if MIN_VERSION_time(1,8,0)
import Data.Time.Clock.System
#endif

#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,6,0)
instance ParseTime UniversalTime where
    -- substituteTimeSpecifier _ = timeSubstituteTimeSpecifier
    -- parseTimeSpecifier _ = timeParseTimeSpecifier
    buildTime l xs = localTimeToUT1 0 (buildTime l xs)

instance FormatTime UniversalTime where
    formatCharacter c = fmap (\f tl fo t -> f tl fo (ut1ToLocalTime 0 t)) (formatCharacter c)

instance Show UniversalTime where
    show t = show (ut1ToLocalTime 0 t)

instance Read UniversalTime where
    readsPrec n s = [ (localTimeToUT1 0 t, r) | (t,r) <- readsPrec n s ]
#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)
#if __GLASGOW_HASKELL__ <710
deriving instance Typeable DayOfWeek
#endif
deriving instance Data DayOfWeek
#endif

#if MIN_VERSION_time(1,8,0) && !MIN_VERSION_time(1,10,0)
#if __GLASGOW_HASKELL__ <710
deriving instance Typeable SystemTime
#endif

deriving instance Data SystemTime
#endif

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

instance NFData CalendarDiffTime where
    rnf :: CalendarDiffTime -> ()
rnf (CalendarDiffTime Integer
x NominalDiffTime
y) = Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
x () -> () -> ()
`seq` NominalDiffTime -> ()
forall a. NFData a => a -> ()
rnf NominalDiffTime
y

instance NFData CalendarDiffDays where
    rnf :: CalendarDiffDays -> ()
rnf (CalendarDiffDays Integer
x Integer
y) = Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
x () -> () -> ()
`seq` Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
y
#endif

#if !MIN_VERSION_time(1,11,0)

instance Read DiffTime where
    readPrec :: ReadPrec DiffTime
readPrec = do
        Pico
t <- ReadPrec Pico
forall a. Read a => ReadPrec a
readPrec :: ReadPrec Pico
        Char
_ <- ReadP Char -> ReadPrec Char
forall a. ReadP a -> ReadPrec a
lift (ReadP Char -> ReadPrec Char) -> ReadP Char -> ReadPrec Char
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
's'
        DiffTime -> ReadPrec DiffTime
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffTime -> ReadPrec DiffTime) -> DiffTime -> ReadPrec DiffTime
forall a b. (a -> b) -> a -> b
$ Pico -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
t

instance Read NominalDiffTime where
    readPrec :: ReadPrec NominalDiffTime
readPrec = do
        Pico
t <- ReadPrec Pico
forall a. Read a => ReadPrec a
readPrec :: ReadPrec Pico
        Char
_ <- ReadP Char -> ReadPrec Char
forall a. ReadP a -> ReadPrec a
lift (ReadP Char -> ReadPrec Char) -> ReadP Char -> ReadPrec Char
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
's'
        NominalDiffTime -> ReadPrec NominalDiffTime
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime -> ReadPrec NominalDiffTime)
-> NominalDiffTime -> ReadPrec NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Pico -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
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 salt (MkMonth x) = hashWithSalt salt x

instance Hashable Quarter where
    hashWithSalt salt (MkQuarter x) = hashWithSalt salt x

instance Hashable QuarterOfYear where
    hashWithSalt salt = hashWithSalt salt . fromEnum
#endif