{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Hashable.Time
-- Description : Hashable instances for Data.Time types
-- License     : BSD3
-- Maintainer  : Alexey Karakulov <ankarakulov@gmail.com>
module Data.Hashable.Time (Hashable(..)) where

import Data.Hashable (Hashable(..))
import Data.Time.Compat (UniversalTime (..), DiffTime, UTCTime (..),
                         NominalDiffTime, Day (..), DayOfWeek (..), TimeZone (..),
                         TimeOfDay (..), LocalTime (..), ZonedTime (..))
import Data.Time.Calendar.Month.Compat (Month (..))
import Data.Time.Calendar.Quarter.Compat (Quarter (..), QuarterOfYear (..))

-- time-compat doesn't redefine TimeLocale
#ifdef MIN_VERSION_old_locale
import System.Locale (TimeLocale (..))
#else
import Data.Time.Format.Compat (TimeLocale (..))
#endif

-- Data.Time.Clock

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

-- Data.Time.Calendar

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 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 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

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

-- Data.Time.LocalTime

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 ZonedTime where
  hashWithSalt :: Int -> ZonedTime -> Int
hashWithSalt Int
salt (ZonedTime LocalTime
lt TimeZone
tz) =
    Int
salt Int -> LocalTime -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` LocalTime
lt Int -> TimeZone -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` TimeZone
tz

-- Data.Time.Locale / System.Locale

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