-- Note: this file derives from old-locale:System.Locale.hs, which is copyright (c) The University of Glasgow 2001

module Data.Time.Format.Locale (

    TimeLocale(..)

    , defaultTimeLocale

    , iso8601DateFormat
    , rfc822DateFormat
    )
where

import Data.Time.LocalTime.Internal.TimeZone


data TimeLocale = TimeLocale {
        -- |full and abbreviated week days, starting with Sunday
        TimeLocale -> [(String, String)]
wDays  :: [(String, String)],
        -- |full and abbreviated months
        TimeLocale -> [(String, String)]
months :: [(String, String)],
        -- |AM\/PM symbols
        TimeLocale -> (String, String)
amPm   :: (String, String),
        -- |formatting strings
        TimeLocale -> String
dateTimeFmt, TimeLocale -> String
dateFmt,
        TimeLocale -> String
timeFmt, TimeLocale -> String
time12Fmt :: String,
        -- |time zones known by name
        TimeLocale -> [TimeZone]
knownTimeZones :: [TimeZone]
        } deriving (TimeLocale -> TimeLocale -> Bool
(TimeLocale -> TimeLocale -> Bool)
-> (TimeLocale -> TimeLocale -> Bool) -> Eq TimeLocale
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeLocale -> TimeLocale -> Bool
$c/= :: TimeLocale -> TimeLocale -> Bool
== :: TimeLocale -> TimeLocale -> Bool
$c== :: TimeLocale -> TimeLocale -> Bool
Eq, Eq TimeLocale
Eq TimeLocale
-> (TimeLocale -> TimeLocale -> Ordering)
-> (TimeLocale -> TimeLocale -> Bool)
-> (TimeLocale -> TimeLocale -> Bool)
-> (TimeLocale -> TimeLocale -> Bool)
-> (TimeLocale -> TimeLocale -> Bool)
-> (TimeLocale -> TimeLocale -> TimeLocale)
-> (TimeLocale -> TimeLocale -> TimeLocale)
-> Ord TimeLocale
TimeLocale -> TimeLocale -> Bool
TimeLocale -> TimeLocale -> Ordering
TimeLocale -> TimeLocale -> TimeLocale
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
min :: TimeLocale -> TimeLocale -> TimeLocale
$cmin :: TimeLocale -> TimeLocale -> TimeLocale
max :: TimeLocale -> TimeLocale -> TimeLocale
$cmax :: TimeLocale -> TimeLocale -> TimeLocale
>= :: TimeLocale -> TimeLocale -> Bool
$c>= :: TimeLocale -> TimeLocale -> Bool
> :: TimeLocale -> TimeLocale -> Bool
$c> :: TimeLocale -> TimeLocale -> Bool
<= :: TimeLocale -> TimeLocale -> Bool
$c<= :: TimeLocale -> TimeLocale -> Bool
< :: TimeLocale -> TimeLocale -> Bool
$c< :: TimeLocale -> TimeLocale -> Bool
compare :: TimeLocale -> TimeLocale -> Ordering
$ccompare :: TimeLocale -> TimeLocale -> Ordering
Ord, Int -> TimeLocale -> ShowS
[TimeLocale] -> ShowS
TimeLocale -> String
(Int -> TimeLocale -> ShowS)
-> (TimeLocale -> String)
-> ([TimeLocale] -> ShowS)
-> Show TimeLocale
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeLocale] -> ShowS
$cshowList :: [TimeLocale] -> ShowS
show :: TimeLocale -> String
$cshow :: TimeLocale -> String
showsPrec :: Int -> TimeLocale -> ShowS
$cshowsPrec :: Int -> TimeLocale -> ShowS
Show)

-- | Locale representing American usage.
--
-- 'knownTimeZones' contains only the ten time-zones mentioned in RFC 822 sec. 5:
-- \"UT\", \"GMT\", \"EST\", \"EDT\", \"CST\", \"CDT\", \"MST\", \"MDT\", \"PST\", \"PDT\".
-- Note that the parsing functions will regardless parse \"UTC\", single-letter military time-zones, and +HHMM format.
defaultTimeLocale :: TimeLocale
defaultTimeLocale :: TimeLocale
defaultTimeLocale =  TimeLocale :: [(String, String)]
-> [(String, String)]
-> (String, String)
-> String
-> String
-> String
-> String
-> [TimeZone]
-> TimeLocale
TimeLocale {
        wDays :: [(String, String)]
wDays  = [(String
"Sunday",   String
"Sun"),  (String
"Monday",    String
"Mon"),
                  (String
"Tuesday",  String
"Tue"),  (String
"Wednesday", String
"Wed"),
                  (String
"Thursday", String
"Thu"),  (String
"Friday",    String
"Fri"),
                  (String
"Saturday", String
"Sat")],

        months :: [(String, String)]
months = [(String
"January",   String
"Jan"), (String
"February",  String
"Feb"),
                  (String
"March",     String
"Mar"), (String
"April",     String
"Apr"),
                  (String
"May",       String
"May"), (String
"June",      String
"Jun"),
                  (String
"July",      String
"Jul"), (String
"August",    String
"Aug"),
                  (String
"September", String
"Sep"), (String
"October",   String
"Oct"),
                  (String
"November",  String
"Nov"), (String
"December",  String
"Dec")],

        amPm :: (String, String)
amPm = (String
"AM", String
"PM"),
        dateTimeFmt :: String
dateTimeFmt = String
"%a %b %e %H:%M:%S %Z %Y",
        dateFmt :: String
dateFmt = String
"%m/%d/%y",
        timeFmt :: String
timeFmt = String
"%H:%M:%S",
        time12Fmt :: String
time12Fmt = String
"%I:%M:%S %p",
        knownTimeZones :: [TimeZone]
knownTimeZones =
            [
            Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
False String
"UT",
            Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
False String
"GMT",
            Int -> Bool -> String -> TimeZone
TimeZone (-Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Bool
False String
"EST",
            Int -> Bool -> String -> TimeZone
TimeZone (-Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Bool
True String
"EDT",
            Int -> Bool -> String -> TimeZone
TimeZone (-Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Bool
False String
"CST",
            Int -> Bool -> String -> TimeZone
TimeZone (-Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Bool
True String
"CDT",
            Int -> Bool -> String -> TimeZone
TimeZone (-Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Bool
False String
"MST",
            Int -> Bool -> String -> TimeZone
TimeZone (-Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Bool
True String
"MDT",
            Int -> Bool -> String -> TimeZone
TimeZone (-Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Bool
False String
"PST",
            Int -> Bool -> String -> TimeZone
TimeZone (-Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Bool
True String
"PDT"
            ]
        }

{- | Construct format string according to <http://en.wikipedia.org/wiki/ISO_8601 ISO-8601>.

The @Maybe String@ argument allows to supply an optional time specification. E.g.:

@
'iso8601DateFormat' Nothing            == "%Y-%m-%d"           -- i.e. @/YYYY-MM-DD/@
'iso8601DateFormat' (Just "%H:%M:%S")  == "%Y-%m-%dT%H:%M:%S"  -- i.e. @/YYYY-MM-DD/T/HH:MM:SS/@
@
-}

iso8601DateFormat :: Maybe String -> String
iso8601DateFormat :: Maybe String -> String
iso8601DateFormat Maybe String
mTimeFmt =
    String
"%Y-%m-%d" String -> ShowS
forall a. [a] -> [a] -> [a]
++ case Maybe String
mTimeFmt of
             Maybe String
Nothing  -> String
""
             Just String
fmt -> Char
'T' Char -> ShowS
forall a. a -> [a] -> [a]
: String
fmt

-- | Format string according to <http://tools.ietf.org/html/rfc822#section-5 RFC822>.
rfc822DateFormat :: String
rfc822DateFormat :: String
rfc822DateFormat = String
"%a, %_d %b %Y %H:%M:%S %Z"