{-# LANGUAGE Safe #-}
-- |
-- Module: Pact.Time.Format.Locale
-- Description : Short description
-- Copyright   : (c) Kadena LLC, 2021
--                   Ashley Yakeley and contributors, 2004-2021
--                   The University of Glasgow 2001
-- License     : MIT
-- Maintainer  : Lars Kuhtz <lars@kadena.io>
-- Stability   : experimental
--
-- The code in this module is derived from time:Data.Time.Format.Locale. The
-- code is included here in order to guarnatee binary stability of formated time
-- values in Pact, even when the upstream code changes.
--
-- The original code has the following Copyright and License:
--
-- @
-- TimeLib is Copyright (c) Ashley Yakeley and contributors, 2004-2021. All rights reserved.
-- Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
-- - Redistributions of source code must retain the above copyright notice, this
--   list of conditions and the following disclaimer.
--
-- - Neither name of the copyright holders nor the names of its contributors may
--   be used to endorse or promote products derived from this software without
--   specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-- POSSIBILITY OF SUCH DAMAGE.
-- @
--
module Pact.Time.Format.Locale
( TimeLocale(..)
, defaultTimeLocale
) where

data TimeLocale = TimeLocale
    { TimeLocale -> [(String, String)]
wDays :: ![(String, String)]
        -- ^ full and abbreviated week days, starting with Sunday
    , TimeLocale -> [(String, String)]
months :: ![(String, String)]
        -- ^ full and abbreviated months
    , TimeLocale -> (String, String)
amPm :: !(String, String)
        -- ^ AM\/PM symbols
    , TimeLocale -> String
dateTimeFmt :: !String
    , TimeLocale -> String
dateFmt :: !String
    , TimeLocale -> String
timeFmt :: !String
    , TimeLocale -> String
time12Fmt :: !String
    }
    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
$cp1Ord :: Eq TimeLocale
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.
--
defaultTimeLocale :: TimeLocale
defaultTimeLocale :: TimeLocale
defaultTimeLocale = TimeLocale :: [(String, String)]
-> [(String, String)]
-> (String, String)
-> String
-> String
-> String
-> String
-> 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"
    }