{-# LANGUAGE OverloadedStrings #-}

{- | This module provides some english locale helpers.
    It is very incomplete. Please send a pull request
    to https://github.com/byteverse/chronos if you need
    additions to this API.
-}
module Chronos.Locale.English
  ( lower
  , upper
  , lowerDots
  , upperDots
  , abbreviated
  , unabbreviated
  ) where

import Chronos (buildMonthMatch)
import Chronos.Types
import Data.Text (Text)

{- $setup

>>> :set -XOverloadedStrings
>>> import Chronos (january, august, december, october, caseMonth)
-}

-- | Lowercase "am"/"pm".
lower :: MeridiemLocale Text
lower :: MeridiemLocale Text
lower = Text -> Text -> MeridiemLocale Text
forall a. a -> a -> MeridiemLocale a
MeridiemLocale Text
"am" Text
"pm"

-- | Uppercase "AM"/"PM".
upper :: MeridiemLocale Text
upper :: MeridiemLocale Text
upper = Text -> Text -> MeridiemLocale Text
forall a. a -> a -> MeridiemLocale a
MeridiemLocale Text
"AM" Text
"PM"

-- | Lowercase "a.m."/"p.m."
lowerDots :: MeridiemLocale Text
lowerDots :: MeridiemLocale Text
lowerDots = Text -> Text -> MeridiemLocale Text
forall a. a -> a -> MeridiemLocale a
MeridiemLocale Text
"a.m." Text
"p.m."

-- | Uppercase "A.M."/"P.M."
upperDots :: MeridiemLocale Text
upperDots :: MeridiemLocale Text
upperDots = Text -> Text -> MeridiemLocale Text
forall a. a -> a -> MeridiemLocale a
MeridiemLocale Text
"A.M." Text
"P.M."

{- | Unabbreviated 'Month's of the year.

  >>> caseMonth unabbreviated january
  "January"

  >>> caseMonth unabbreviated december
  "December"
-}
unabbreviated :: MonthMatch Text
unabbreviated :: MonthMatch Text
unabbreviated =
  Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> MonthMatch Text
forall a.
a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> MonthMatch a
buildMonthMatch
    Text
"January"
    Text
"February"
    Text
"March"
    Text
"April"
    Text
"May"
    Text
"June"
    Text
"July"
    Text
"August"
    Text
"September"
    Text
"October"
    Text
"November"
    Text
"December"

{- | Abbreviated 'Month's of the year.

  >>> caseMonth abbreviated october
  "Oct"

  >>> caseMonth abbreviated august
  "Aug"
-}
abbreviated :: MonthMatch Text
abbreviated :: MonthMatch Text
abbreviated =
  Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> MonthMatch Text
forall a.
a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> a
-> MonthMatch a
buildMonthMatch
    Text
"Jan"
    Text
"Feb"
    Text
"Mar"
    Text
"Apr"
    Text
"May"
    Text
"Jun"
    Text
"Jul"
    Text
"Aug"
    Text
"Sep"
    Text
"Oct"
    Text
"Nov"
    Text
"Dec"