{-# LANGUAGE ExistentialQuantification #-}

{- |
Module      : Time.Timezone
License     : BSD-style
Copyright   : (c) 2014 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown

Timezone utilities.
-}

module Time.Timezone
  ( Timezone (..)
  , UTC (..)
  , TimezoneMinutes (..)
  ) where

-- | A type class promising timezone-related functionality.

class Timezone tz where
  -- | Offset in minutes from UTC. Valid values should be between @-12 * 60@ and

  -- @+14 * 60@.

  timezoneOffset :: tz -> Int

  -- | The name of the timezone.

  --

  -- Default implementation is an +-HH:MM encoding of the 'timezoneOffset'.

  timezoneName :: tz -> String
  timezoneName = Int -> String
tzMinutesPrint (Int -> String) -> (tz -> Int) -> tz -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tz -> Int
forall tz. Timezone tz => tz -> Int
timezoneOffset

-- | Simple timezone containing the number of minutes difference with UTC.

--

-- Valid values should be between @-12 * 60@ and @+14 * 60@.

newtype TimezoneMinutes = TimezoneMinutes Int
  deriving (TimezoneMinutes -> TimezoneMinutes -> Bool
(TimezoneMinutes -> TimezoneMinutes -> Bool)
-> (TimezoneMinutes -> TimezoneMinutes -> Bool)
-> Eq TimezoneMinutes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimezoneMinutes -> TimezoneMinutes -> Bool
== :: TimezoneMinutes -> TimezoneMinutes -> Bool
$c/= :: TimezoneMinutes -> TimezoneMinutes -> Bool
/= :: TimezoneMinutes -> TimezoneMinutes -> Bool
Eq, Eq TimezoneMinutes
Eq TimezoneMinutes =>
(TimezoneMinutes -> TimezoneMinutes -> Ordering)
-> (TimezoneMinutes -> TimezoneMinutes -> Bool)
-> (TimezoneMinutes -> TimezoneMinutes -> Bool)
-> (TimezoneMinutes -> TimezoneMinutes -> Bool)
-> (TimezoneMinutes -> TimezoneMinutes -> Bool)
-> (TimezoneMinutes -> TimezoneMinutes -> TimezoneMinutes)
-> (TimezoneMinutes -> TimezoneMinutes -> TimezoneMinutes)
-> Ord TimezoneMinutes
TimezoneMinutes -> TimezoneMinutes -> Bool
TimezoneMinutes -> TimezoneMinutes -> Ordering
TimezoneMinutes -> TimezoneMinutes -> TimezoneMinutes
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimezoneMinutes -> TimezoneMinutes -> Ordering
compare :: TimezoneMinutes -> TimezoneMinutes -> Ordering
$c< :: TimezoneMinutes -> TimezoneMinutes -> Bool
< :: TimezoneMinutes -> TimezoneMinutes -> Bool
$c<= :: TimezoneMinutes -> TimezoneMinutes -> Bool
<= :: TimezoneMinutes -> TimezoneMinutes -> Bool
$c> :: TimezoneMinutes -> TimezoneMinutes -> Bool
> :: TimezoneMinutes -> TimezoneMinutes -> Bool
$c>= :: TimezoneMinutes -> TimezoneMinutes -> Bool
>= :: TimezoneMinutes -> TimezoneMinutes -> Bool
$cmax :: TimezoneMinutes -> TimezoneMinutes -> TimezoneMinutes
max :: TimezoneMinutes -> TimezoneMinutes -> TimezoneMinutes
$cmin :: TimezoneMinutes -> TimezoneMinutes -> TimezoneMinutes
min :: TimezoneMinutes -> TimezoneMinutes -> TimezoneMinutes
Ord, Int -> TimezoneMinutes -> ShowS
[TimezoneMinutes] -> ShowS
TimezoneMinutes -> String
(Int -> TimezoneMinutes -> ShowS)
-> (TimezoneMinutes -> String)
-> ([TimezoneMinutes] -> ShowS)
-> Show TimezoneMinutes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimezoneMinutes -> ShowS
showsPrec :: Int -> TimezoneMinutes -> ShowS
$cshow :: TimezoneMinutes -> String
show :: TimezoneMinutes -> String
$cshowList :: [TimezoneMinutes] -> ShowS
showList :: [TimezoneMinutes] -> ShowS
Show)

-- | Type representing Universal Time Coordinated (UTC).

data UTC = UTC
  deriving (UTC -> UTC -> Bool
(UTC -> UTC -> Bool) -> (UTC -> UTC -> Bool) -> Eq UTC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UTC -> UTC -> Bool
== :: UTC -> UTC -> Bool
$c/= :: UTC -> UTC -> Bool
/= :: UTC -> UTC -> Bool
Eq, Eq UTC
Eq UTC =>
(UTC -> UTC -> Ordering)
-> (UTC -> UTC -> Bool)
-> (UTC -> UTC -> Bool)
-> (UTC -> UTC -> Bool)
-> (UTC -> UTC -> Bool)
-> (UTC -> UTC -> UTC)
-> (UTC -> UTC -> UTC)
-> Ord UTC
UTC -> UTC -> Bool
UTC -> UTC -> Ordering
UTC -> UTC -> UTC
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UTC -> UTC -> Ordering
compare :: UTC -> UTC -> Ordering
$c< :: UTC -> UTC -> Bool
< :: UTC -> UTC -> Bool
$c<= :: UTC -> UTC -> Bool
<= :: UTC -> UTC -> Bool
$c> :: UTC -> UTC -> Bool
> :: UTC -> UTC -> Bool
$c>= :: UTC -> UTC -> Bool
>= :: UTC -> UTC -> Bool
$cmax :: UTC -> UTC -> UTC
max :: UTC -> UTC -> UTC
$cmin :: UTC -> UTC -> UTC
min :: UTC -> UTC -> UTC
Ord, Int -> UTC -> ShowS
[UTC] -> ShowS
UTC -> String
(Int -> UTC -> ShowS)
-> (UTC -> String) -> ([UTC] -> ShowS) -> Show UTC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTC -> ShowS
showsPrec :: Int -> UTC -> ShowS
$cshow :: UTC -> String
show :: UTC -> String
$cshowList :: [UTC] -> ShowS
showList :: [UTC] -> ShowS
Show)

instance Timezone UTC where
  timezoneOffset :: UTC -> Int
timezoneOffset UTC
_ = Int
0
  timezoneName :: UTC -> String
timezoneName UTC
_   = String
"UTC"

instance Timezone TimezoneMinutes where
  timezoneOffset :: TimezoneMinutes -> Int
timezoneOffset (TimezoneMinutes Int
minutes) = Int
minutes

-- | Print a minute offset in format: (+-)HH:MM.

tzMinutesPrint :: Int -> String
tzMinutesPrint :: Int -> String
tzMinutesPrint Int
offset =
      (if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Char
'+' else Char
'-')
    Char -> ShowS
forall a. a -> [a] -> [a]
: (Int -> String
forall {a}. (Ord a, Num a, Show a) => a -> String
pad0 Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall {a}. (Ord a, Num a, Show a) => a -> String
pad0 Int
m)
 where
  (Int
h, Int
m) = Int -> Int
forall a. Num a => a -> a
abs Int
offset Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
  pad0 :: a -> String
pad0 a
v
    | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10    = Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:a -> String
forall a. Show a => a -> String
show a
v
    | Bool
otherwise = a -> String
forall a. Show a => a -> String
show a
v