{-# LANGUAGE Safe #-}

module Data.Time.Format.Parse.Class (
    -- * Parsing
    ParseNumericPadding (..),
    ParseTime (..),
    parseSpecifiers,
    timeSubstituteTimeSpecifier,
    timeParseTimeSpecifier,
    durationParseTimeSpecifier,
) where

import Control.Monad
import Data.Char
import Data.Foldable
import Data.Maybe
import Data.Proxy
import Data.Time.Format.Locale
import Text.ParserCombinators.ReadP

data ParseNumericPadding
    = NoPadding
    | SpacePadding
    | ZeroPadding

-- | The class of types which can be parsed given a UNIX-style time format
-- string.
class ParseTime t where
    -- | @since 1.9.1
    substituteTimeSpecifier :: Proxy t -> TimeLocale -> Char -> Maybe String
    substituteTimeSpecifier Proxy t
_ TimeLocale
_ Char
_ = Maybe String
forall a. Maybe a
Nothing

    -- | Get the string corresponding to the given format specifier.
    --
    -- @since 1.9.1
    parseTimeSpecifier :: Proxy t -> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String

    -- | Builds a time value from a parsed input string.
    -- If the input does not include all the information needed to
    -- construct a complete value, any missing parts should be taken
    -- from 1970-01-01 00:00:00 +0000 (which was a Thursday).
    -- In the absence of @%C@ or @%Y@, century is 1969 - 2068.
    --
    -- @since 1.9.1
    buildTime ::
        -- | The time locale.
        TimeLocale ->
        -- | Pairs of format characters and the
        -- corresponding part of the input.
        [(Char, String)] ->
        Maybe t

-- | Case-insensitive version of 'Text.ParserCombinators.ReadP.char'.
charCI :: Char -> ReadP Char
charCI :: Char -> ReadP Char
charCI Char
c = (Char -> Bool) -> ReadP Char
satisfy (\Char
x -> Char -> Char
toUpper Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
x)

-- | Case-insensitive version of 'Text.ParserCombinators.ReadP.string'.
stringCI :: String -> ReadP String
stringCI :: String -> ReadP String
stringCI String
this = do
    let
        scan :: String -> String -> ReadP String
scan [] String
_ = String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return String
this
        scan (Char
x : String
xs) (Char
y : String
ys)
            | Char -> Char
toUpper Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
y = do
                Char
_ <- ReadP Char
get
                String -> String -> ReadP String
scan String
xs String
ys
        scan String
_ String
_ = ReadP String
forall a. ReadP a
pfail
    String
s <- ReadP String
look
    String -> String -> ReadP String
scan String
this String
s

parseSpecifiers :: ParseTime t => Proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
parseSpecifiers :: forall t.
ParseTime t =>
Proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
parseSpecifiers Proxy t
pt TimeLocale
locale =
    let
        parse :: String -> ReadP [(Char, String)]
        parse :: String -> ReadP [(Char, String)]
parse [] = [(Char, String)] -> ReadP [(Char, String)]
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        parse (Char
'%' : String
cs) = String -> ReadP [(Char, String)]
parse1 String
cs
        parse (Char
c : String
cs) | Char -> Bool
isSpace Char
c = do
            Char
_ <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isSpace
            case String
cs of
                (Char
c' : String
_) | Char -> Bool
isSpace Char
c' -> () -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                String
_ -> ReadP ()
skipSpaces
            String -> ReadP [(Char, String)]
parse String
cs
        parse (Char
c : String
cs) = do
            Char
_ <- Char -> ReadP Char
charCI Char
c
            String -> ReadP [(Char, String)]
parse String
cs
        parse1 :: String -> ReadP [(Char, String)]
        parse1 :: String -> ReadP [(Char, String)]
parse1 (Char
'-' : String
cs) = Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 (ParseNumericPadding -> Maybe ParseNumericPadding
forall a. a -> Maybe a
Just ParseNumericPadding
NoPadding) String
cs
        parse1 (Char
'_' : String
cs) = Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 (ParseNumericPadding -> Maybe ParseNumericPadding
forall a. a -> Maybe a
Just ParseNumericPadding
SpacePadding) String
cs
        parse1 (Char
'0' : String
cs) = Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 (ParseNumericPadding -> Maybe ParseNumericPadding
forall a. a -> Maybe a
Just ParseNumericPadding
ZeroPadding) String
cs
        parse1 String
cs = Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 Maybe ParseNumericPadding
forall a. Maybe a
Nothing String
cs
        parse2 :: Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
        parse2 :: Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 Maybe ParseNumericPadding
mpad (Char
'E' : String
cs) = Maybe ParseNumericPadding
-> Bool -> String -> ReadP [(Char, String)]
parse3 Maybe ParseNumericPadding
mpad Bool
True String
cs
        parse2 Maybe ParseNumericPadding
mpad String
cs = Maybe ParseNumericPadding
-> Bool -> String -> ReadP [(Char, String)]
parse3 Maybe ParseNumericPadding
mpad Bool
False String
cs
        parse3 :: Maybe ParseNumericPadding -> Bool -> String -> ReadP [(Char, String)]
        parse3 :: Maybe ParseNumericPadding
-> Bool -> String -> ReadP [(Char, String)]
parse3 Maybe ParseNumericPadding
_ Bool
_ (Char
'%' : String
cs) = do
            Char
_ <- Char -> ReadP Char
char Char
'%'
            String -> ReadP [(Char, String)]
parse String
cs
        parse3 Maybe ParseNumericPadding
_ Bool
_ (Char
c : String
cs) | Just String
s <- Proxy t -> TimeLocale -> Char -> Maybe String
forall t.
ParseTime t =>
Proxy t -> TimeLocale -> Char -> Maybe String
substituteTimeSpecifier Proxy t
pt TimeLocale
locale Char
c = String -> ReadP [(Char, String)]
parse (String -> ReadP [(Char, String)])
-> String -> ReadP [(Char, String)]
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs
        parse3 Maybe ParseNumericPadding
mpad Bool
_alt (Char
c : String
cs) = do
            String
str <- Proxy t
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
forall t.
ParseTime t =>
Proxy t
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
parseTimeSpecifier Proxy t
pt TimeLocale
locale Maybe ParseNumericPadding
mpad Char
c
            [(Char, String)]
specs <- String -> ReadP [(Char, String)]
parse String
cs
            [(Char, String)] -> ReadP [(Char, String)]
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Char, String)] -> ReadP [(Char, String)])
-> [(Char, String)] -> ReadP [(Char, String)]
forall a b. (a -> b) -> a -> b
$ (Char
c, String
str) (Char, String) -> [(Char, String)] -> [(Char, String)]
forall a. a -> [a] -> [a]
: [(Char, String)]
specs
        parse3 Maybe ParseNumericPadding
_ Bool
_ [] = [(Char, String)] -> ReadP [(Char, String)]
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    in
        String -> ReadP [(Char, String)]
parse

data PaddingSide
    = PrePadding
    | PostPadding

data EmptyOption = AllowEmptyOption | ForbidEmptyOption

checkEmptyOption :: EmptyOption -> String -> ReadP ()
checkEmptyOption :: EmptyOption -> String -> ReadP ()
checkEmptyOption EmptyOption
ForbidEmptyOption String
"" = ReadP ()
forall a. ReadP a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
checkEmptyOption EmptyOption
_ String
_ = () -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

data MunchType = AmbiguousMunchType | MaximalMunchType

data Munch = InexactMunch MunchType | ExactMunch Int

munchDigits :: MunchType -> ReadP String
munchDigits :: MunchType -> ReadP String
munchDigits MunchType
AmbiguousMunchType = ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many (ReadP Char -> ReadP String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isDigit
munchDigits MunchType
MaximalMunchType = (Char -> Bool) -> ReadP String
munch Char -> Bool
isDigit

checkAll :: (a -> Bool) -> [a] -> ReadP ()
checkAll :: forall a. (a -> Bool) -> [a] -> ReadP ()
checkAll a -> Bool
f [a]
l = [a] -> (a -> ReadP ()) -> ReadP ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [a]
l ((a -> ReadP ()) -> ReadP ()) -> (a -> ReadP ()) -> ReadP ()
forall a b. (a -> b) -> a -> b
$ \a
c -> if a -> Bool
f a
c then () -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return () else ReadP ()
forall a. ReadP a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

parseAnyPaddedDigits :: Maybe PaddingSide -> Munch -> ReadP String
parseAnyPaddedDigits :: Maybe PaddingSide -> Munch -> ReadP String
parseAnyPaddedDigits Maybe PaddingSide
mpad (ExactMunch Int
n) = do
    String
chars <- Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
count Int
n ReadP Char
get
    case Maybe PaddingSide
mpad of
        Maybe PaddingSide
Nothing -> do
            (Char -> Bool) -> String -> ReadP ()
forall a. (a -> Bool) -> [a] -> ReadP ()
checkAll Char -> Bool
isDigit String
chars
            String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return String
chars
        Just PaddingSide
PrePadding -> do
            let
                digits :: String
digits = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
chars
            (Char -> Bool) -> String -> ReadP ()
forall a. (a -> Bool) -> [a] -> ReadP ()
checkAll Char -> Bool
isDigit String
digits
            String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return String
digits
        Just PaddingSide
PostPadding -> do
            let
                (String
digits, String
spaces) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
chars
            (Char -> Bool) -> String -> ReadP ()
forall a. (a -> Bool) -> [a] -> ReadP ()
checkAll Char -> Bool
isSpace String
spaces
            String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return String
digits
parseAnyPaddedDigits Maybe PaddingSide
Nothing (InexactMunch MunchType
munchtype) = MunchType -> ReadP String
munchDigits MunchType
munchtype
parseAnyPaddedDigits (Just PaddingSide
PrePadding) (InexactMunch MunchType
munchtype) = do
    ReadP ()
skipSpaces
    MunchType -> ReadP String
munchDigits MunchType
munchtype
parseAnyPaddedDigits (Just PaddingSide
PostPadding) (InexactMunch MunchType
munchtype) = do
    String
r <- MunchType -> ReadP String
munchDigits MunchType
munchtype
    ReadP ()
skipSpaces
    String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return String
r

parsePaddedDigits :: Maybe PaddingSide -> Munch -> EmptyOption -> ReadP String
parsePaddedDigits :: Maybe PaddingSide -> Munch -> EmptyOption -> ReadP String
parsePaddedDigits Maybe PaddingSide
mps Munch
mn EmptyOption
eo = do
    String
digits <- Maybe PaddingSide -> Munch -> ReadP String
parseAnyPaddedDigits Maybe PaddingSide
mps Munch
mn
    EmptyOption -> String -> ReadP ()
checkEmptyOption EmptyOption
eo String
digits
    String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return String
digits

parsePaddingDigits :: PaddingSide -> ParseNumericPadding -> EmptyOption -> MunchType -> Int -> ReadP String
parsePaddingDigits :: PaddingSide
-> ParseNumericPadding
-> EmptyOption
-> MunchType
-> Int
-> ReadP String
parsePaddingDigits PaddingSide
_ps ParseNumericPadding
NoPadding EmptyOption
eo MunchType
mt Int
_n = Maybe PaddingSide -> Munch -> EmptyOption -> ReadP String
parsePaddedDigits Maybe PaddingSide
forall a. Maybe a
Nothing (MunchType -> Munch
InexactMunch MunchType
mt) EmptyOption
eo
parsePaddingDigits PaddingSide
_ps ParseNumericPadding
ZeroPadding EmptyOption
eo MunchType
_mt Int
n = Maybe PaddingSide -> Munch -> EmptyOption -> ReadP String
parsePaddedDigits Maybe PaddingSide
forall a. Maybe a
Nothing (Int -> Munch
ExactMunch Int
n) EmptyOption
eo
parsePaddingDigits PaddingSide
ps ParseNumericPadding
SpacePadding EmptyOption
eo MunchType
mt Int
_n = Maybe PaddingSide -> Munch -> EmptyOption -> ReadP String
parsePaddedDigits (PaddingSide -> Maybe PaddingSide
forall a. a -> Maybe a
Just PaddingSide
ps) (MunchType -> Munch
InexactMunch MunchType
mt) EmptyOption
eo

allowNegative :: ReadP String -> ReadP String
allowNegative :: ReadP String -> ReadP String
allowNegative ReadP String
p = do
    String
sign <- String -> ReadP String -> ReadP String
forall a. a -> ReadP a -> ReadP a
option String
"" (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> ReadP a -> ReadP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadP Char -> ReadP String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
'-'
    String
val <- ReadP String
p
    String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ String
sign String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
val

timeParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
timeParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
timeParseTimeSpecifier TimeLocale
l Maybe ParseNumericPadding
mpad Char
c =
    let
        parseDigits :: PaddingSide -> ParseNumericPadding -> EmptyOption -> MunchType -> Int -> ReadP String
        parseDigits :: PaddingSide
-> ParseNumericPadding
-> EmptyOption
-> MunchType
-> Int
-> ReadP String
parseDigits PaddingSide
ps ParseNumericPadding
pad = PaddingSide
-> ParseNumericPadding
-> EmptyOption
-> MunchType
-> Int
-> ReadP String
parsePaddingDigits PaddingSide
ps (ParseNumericPadding
 -> EmptyOption -> MunchType -> Int -> ReadP String)
-> ParseNumericPadding
-> EmptyOption
-> MunchType
-> Int
-> ReadP String
forall a b. (a -> b) -> a -> b
$ ParseNumericPadding
-> Maybe ParseNumericPadding -> ParseNumericPadding
forall a. a -> Maybe a -> a
fromMaybe ParseNumericPadding
pad Maybe ParseNumericPadding
mpad

        parseDigitsUsual :: ParseNumericPadding -> Int -> ReadP String
        parseDigitsUsual :: ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
pad = PaddingSide
-> ParseNumericPadding
-> EmptyOption
-> MunchType
-> Int
-> ReadP String
parseDigits PaddingSide
PrePadding ParseNumericPadding
pad EmptyOption
ForbidEmptyOption MunchType
AmbiguousMunchType

        oneOf :: [String] -> ReadP String
oneOf = [ReadP String] -> ReadP String
forall a. [ReadP a] -> ReadP a
choice ([ReadP String] -> ReadP String)
-> ([String] -> [ReadP String]) -> [String] -> ReadP String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ReadP String) -> [String] -> [ReadP String]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadP String
stringCI
        numericTZ :: ReadP String
numericTZ = do
            Char
s <- [ReadP Char] -> ReadP Char
forall a. [ReadP a] -> ReadP a
choice [Char -> ReadP Char
char Char
'+', Char -> ReadP Char
char Char
'-']
            String
h <- ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            ReadP Char -> ReadP ()
forall a. ReadP a -> ReadP ()
optional (Char -> ReadP Char
char Char
':')
            String
m <- ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m)
    in
        case Char
c of
            -- century
            Char
'C' -> ReadP String -> ReadP String
allowNegative (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
SpacePadding Int
2
            Char
'f' -> ReadP String -> ReadP String
allowNegative (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
SpacePadding Int
2
            -- year
            Char
'Y' -> ReadP String -> ReadP String
allowNegative (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
SpacePadding Int
4
            Char
'G' -> ReadP String -> ReadP String
allowNegative (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
SpacePadding Int
4
            -- year of century
            Char
'y' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            Char
'g' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            -- month of year
            Char
'B' -> [String] -> ReadP String
oneOf (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst (TimeLocale -> [(String, String)]
months TimeLocale
l))
            Char
'b' -> [String] -> ReadP String
oneOf (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd (TimeLocale -> [(String, String)]
months TimeLocale
l))
            Char
'm' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            -- day of month
            Char
'd' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            Char
'e' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
SpacePadding Int
2
            -- week of year
            Char
'V' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            Char
'U' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            Char
'W' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            -- day of week
            Char
'u' -> [String] -> ReadP String
oneOf ([String] -> ReadP String) -> [String] -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. a -> [a] -> [a]
: []) [Char
'1' .. Char
'7']
            Char
'a' -> [String] -> ReadP String
oneOf (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd (TimeLocale -> [(String, String)]
wDays TimeLocale
l))
            Char
'A' -> [String] -> ReadP String
oneOf (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst (TimeLocale -> [(String, String)]
wDays TimeLocale
l))
            Char
'w' -> [String] -> ReadP String
oneOf ([String] -> ReadP String) -> [String] -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. a -> [a] -> [a]
: []) [Char
'0' .. Char
'6']
            -- day of year
            Char
'j' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
3
            -- dayhalf of day (i.e. AM or PM)
            Char
'P' ->
                [String] -> ReadP String
oneOf
                    ( let
                        (String
am, String
pm) = TimeLocale -> (String, String)
amPm TimeLocale
l
                      in
                        [String
am, String
pm]
                    )
            Char
'p' ->
                [String] -> ReadP String
oneOf
                    ( let
                        (String
am, String
pm) = TimeLocale -> (String, String)
amPm TimeLocale
l
                      in
                        [String
am, String
pm]
                    )
            -- hour of day (i.e. 24h)
            Char
'H' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            Char
'k' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
SpacePadding Int
2
            -- hour of dayhalf (i.e. 12h)
            Char
'I' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            Char
'l' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
SpacePadding Int
2
            -- minute of hour
            Char
'M' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            -- second of minute
            Char
'S' -> ParseNumericPadding -> Int -> ReadP String
parseDigitsUsual ParseNumericPadding
ZeroPadding Int
2
            -- picosecond of second
            Char
'q' -> PaddingSide
-> ParseNumericPadding
-> EmptyOption
-> MunchType
-> Int
-> ReadP String
parseDigits PaddingSide
PostPadding ParseNumericPadding
NoPadding EmptyOption
AllowEmptyOption MunchType
MaximalMunchType Int
12
            Char
'Q' -> (Char -> ReadP Char
char Char
'.' ReadP Char -> ReadP String -> ReadP String
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PaddingSide
-> ParseNumericPadding
-> EmptyOption
-> MunchType
-> Int
-> ReadP String
parseDigits PaddingSide
PostPadding ParseNumericPadding
NoPadding EmptyOption
AllowEmptyOption MunchType
MaximalMunchType Int
12) ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++ String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
            -- time zone
            Char
'z' -> ReadP String
numericTZ
            Char
'Z' -> (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isAlpha ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP String
numericTZ
            -- seconds since epoch
            Char
's' -> (Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP String -> ReadP String
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> ReadP a -> ReadP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
:) ((Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit)) ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++ (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
            Char
_ -> String -> ReadP String
forall a. String -> ReadP a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ String
"Unknown format character: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c

timeSubstituteTimeSpecifier :: TimeLocale -> Char -> Maybe String
timeSubstituteTimeSpecifier :: TimeLocale -> Char -> Maybe String
timeSubstituteTimeSpecifier TimeLocale
l Char
'c' = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String
dateTimeFmt TimeLocale
l
timeSubstituteTimeSpecifier TimeLocale
_ Char
'R' = String -> Maybe String
forall a. a -> Maybe a
Just String
"%H:%M"
timeSubstituteTimeSpecifier TimeLocale
_ Char
'T' = String -> Maybe String
forall a. a -> Maybe a
Just String
"%H:%M:%S"
timeSubstituteTimeSpecifier TimeLocale
l Char
'X' = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String
timeFmt TimeLocale
l
timeSubstituteTimeSpecifier TimeLocale
l Char
'r' = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String
time12Fmt TimeLocale
l
timeSubstituteTimeSpecifier TimeLocale
_ Char
'D' = String -> Maybe String
forall a. a -> Maybe a
Just String
"%m/%d/%y"
timeSubstituteTimeSpecifier TimeLocale
_ Char
'F' = String -> Maybe String
forall a. a -> Maybe a
Just String
"%Y-%m-%d"
timeSubstituteTimeSpecifier TimeLocale
l Char
'x' = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String
dateFmt TimeLocale
l
timeSubstituteTimeSpecifier TimeLocale
_ Char
'h' = String -> Maybe String
forall a. a -> Maybe a
Just String
"%b"
timeSubstituteTimeSpecifier TimeLocale
_ Char
_ = Maybe String
forall a. Maybe a
Nothing

durationParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
durationParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
durationParseTimeSpecifier TimeLocale
_ Maybe ParseNumericPadding
mpad Char
c =
    let
        parsePaddedSignedDigits :: Int -> ReadP String
        parsePaddedSignedDigits :: Int -> ReadP String
parsePaddedSignedDigits Int
n = ReadP String -> ReadP String
allowNegative (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ do
            PaddingSide
-> ParseNumericPadding
-> EmptyOption
-> MunchType
-> Int
-> ReadP String
parsePaddingDigits PaddingSide
PrePadding (ParseNumericPadding
-> Maybe ParseNumericPadding -> ParseNumericPadding
forall a. a -> Maybe a -> a
fromMaybe ParseNumericPadding
NoPadding Maybe ParseNumericPadding
mpad) EmptyOption
ForbidEmptyOption MunchType
MaximalMunchType Int
n

        parseSignedDecimal :: ReadP String
        parseSignedDecimal :: ReadP String
parseSignedDecimal = ReadP String -> ReadP String
allowNegative (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ do
            String
digits <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
            String
decimaldigits <-
                String -> ReadP String -> ReadP String
forall a. a -> ReadP a -> ReadP a
option String
"" (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ do
                    Char
_ <- Char -> ReadP Char
char Char
'.'
                    String
dd <- (Char -> Bool) -> ReadP String
munch Char -> Bool
isDigit
                    String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
dd
            String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ String
digits String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
decimaldigits
    in
        case Char
c of
            Char
'y' -> Int -> ReadP String
parsePaddedSignedDigits Int
1
            Char
'b' -> Int -> ReadP String
parsePaddedSignedDigits Int
1
            Char
'B' -> Int -> ReadP String
parsePaddedSignedDigits Int
2
            Char
'w' -> Int -> ReadP String
parsePaddedSignedDigits Int
1
            Char
'd' -> Int -> ReadP String
parsePaddedSignedDigits Int
1
            Char
'D' -> Int -> ReadP String
parsePaddedSignedDigits Int
1
            Char
'h' -> Int -> ReadP String
parsePaddedSignedDigits Int
1
            Char
'H' -> Int -> ReadP String
parsePaddedSignedDigits Int
2
            Char
'm' -> Int -> ReadP String
parsePaddedSignedDigits Int
1
            Char
'M' -> Int -> ReadP String
parsePaddedSignedDigits Int
2
            Char
's' -> ReadP String
parseSignedDecimal
            Char
'S' -> ReadP String
parseSignedDecimal
            Char
_ -> String -> ReadP String
forall a. String -> ReadP a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ String
"Unknown format character: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c