    {-# LANGUAGE Safe #-}

    {-# OPTIONS -fno-warn-orphans #-}

    module Data.Time.Format.Parse where

    import Control.Monad.Fail
    import Data.Char
    import Data.Proxy
    import Data.Time.Calendar.Days
    import Data.Time.Clock.Internal.UTCTime
    import Data.Time.Clock.Internal.UniversalTime
    import Data.Time.Format.Locale
    import Data.Time.Format.Parse.Class
    import Data.Time.Format.Parse.Instances ()
    import Data.Time.LocalTime.Internal.LocalTime
    import Data.Time.LocalTime.Internal.TimeOfDay
    import Data.Time.LocalTime.Internal.TimeZone
    import Data.Time.LocalTime.Internal.ZonedTime
    import Data.Traversable
    import Text.ParserCombinators.ReadP hiding (char, string)
    import Prelude hiding (fail)

    -- | Parses a time value given a format string.
    -- Missing information will be derived from 1970-01-01 00:00 UTC (which was a Thursday).
    -- Supports the same %-codes as 'formatTime', including @%-@, @%_@ and @%0@ modifiers, however padding widths are not supported.
    -- Case is not significant in the input string.
    -- Some variations in the input are accepted:
    --
    -- [@%z@ @%Ez@] accepts any of @±HHMM@ or @±HH:MM@.
    --
    -- [@%Z@ @%EZ@] accepts any string of letters, or any of the formats accepted by @%z@.
    --
    -- [@%0Y@] accepts exactly four digits.
    --
    -- [@%0G@] accepts exactly four digits.
    --
    -- [@%0C@] accepts exactly two digits.
    --
    -- [@%0f@] accepts exactly two digits.
    --
    -- For example, to parse a date in YYYY-MM-DD format, while allowing the month
    -- and date to have optional leading zeros (notice the @-@ modifier used for @%m@
    -- and @%d@):
    --
    -- > Prelude Data.Time> parseTimeM True defaultTimeLocale "%Y-%-m-%-d" "2010-3-04" :: Maybe Day
    -- > Just 2010-03-04
    parseTimeM ::
        (MonadFail m, ParseTime t) =>
        -- | Accept leading and trailing whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Format string.
        String ->
        -- | Input string.
        String ->
        -- | Return the time value, or fail if the input could not be parsed using the given format.
        m t
    parseTimeM :: forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    acceptWS TimeLocale
    l String
    fmt String
    s = Bool -> TimeLocale -> [(String, String)] -> m t
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> [(String, String)] -> m t
    parseTimeMultipleM Bool
    acceptWS TimeLocale
    l [(String
    fmt, String
    s)]

    -- | Parses a time value given a list of pairs of format and input.
    -- Resulting value is constructed from all provided specifiers.
    parseTimeMultipleM' ::
        (MonadFail m, ParseTime t) =>
        Proxy t ->
        -- | Accept leading and trailing whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Pairs of (format string, input string).
        [(String, String)] ->
        -- | Return the time value, or fail if the input could not be parsed using the given format.
        m t
    parseTimeMultipleM' :: forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Proxy t -> Bool -> TimeLocale -> [(String, String)] -> m t
    parseTimeMultipleM' Proxy t
    pt Bool
    acceptWS TimeLocale
    l [(String, String)]
    fmts = do
        specss <- [(String, String)]
    -> ((String, String) -> m [(Char, String)]) -> m [[(Char, String)]]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for [(String, String)]
    fmts (((String, String) -> m [(Char, String)]) -> m [[(Char, String)]])
    -> ((String, String) -> m [(Char, String)]) -> m [[(Char, String)]]
    forall a b. (a -> b) -> a -> b
    $ \(String
    fmt, String
    s) -> Proxy t
    -> Bool -> TimeLocale -> String -> String -> m [(Char, String)]
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Proxy t
    -> Bool -> TimeLocale -> String -> String -> m [(Char, String)]
    parseTimeSpecifiersM Proxy t
    pt Bool
    acceptWS TimeLocale
    l String
    fmt String
    s
        case buildTime l $ mconcat specss of
            Just t
    t -> t -> m t
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return t
    t
            Maybe t
    Nothing -> String -> m t
    forall a. HasCallStack => String -> m a
    forall (m :: * -> *) a.
    (MonadFail m, HasCallStack) =>
    String -> m a
    fail String
    "parseTimeM: cannot construct"

    -- | Parses a time value given a list of pairs of format and input.
    -- Resulting value is constructed from all provided specifiers.
    parseTimeMultipleM ::
        (MonadFail m, ParseTime t) =>
        -- | Accept leading and trailing whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Pairs of (format string, input string).
        [(String, String)] ->
        -- | Return the time value, or fail if the input could not be parsed using the given format.
        m t
    parseTimeMultipleM :: forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> [(String, String)] -> m t
    parseTimeMultipleM = Proxy t -> Bool -> TimeLocale -> [(String, String)] -> m t
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Proxy t -> Bool -> TimeLocale -> [(String, String)] -> m t
    parseTimeMultipleM' Proxy t
    forall {k} (t :: k). Proxy t
    Proxy

    -- | Parse a time value given a format string. Fails if the input could
    -- not be parsed using the given format. See 'parseTimeM' for details.
    parseTimeOrError ::
        ParseTime t =>
        -- | Accept leading and trailing whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Format string.
        String ->
        -- | Input string.
        String ->
        -- | The time value.
        t
    parseTimeOrError :: forall t.
    ParseTime t =>
    Bool -> TimeLocale -> String -> String -> t
    parseTimeOrError Bool
    acceptWS TimeLocale
    l String
    fmt String
    s =
        case Bool -> TimeLocale -> String -> String -> [t]
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    acceptWS TimeLocale
    l String
    fmt String
    s of
            [t
    t] -> t
    t
            [] -> String -> t
    forall a. HasCallStack => String -> a
    error (String -> t) -> String -> t
    forall a b. (a -> b) -> a -> b
    $ String
    "parseTimeOrError: no parse of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    s
            [t]
    _ -> String -> t
    forall a. HasCallStack => String -> a
    error (String -> t) -> String -> t
    forall a b. (a -> b) -> a -> b
    $ String
    "parseTimeOrError: multiple parses of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    s

    parseTimeSpecifiersM ::
        (MonadFail m, ParseTime t) =>
        Proxy t ->
        -- | Accept leading and trailing whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Format string
        String ->
        -- | Input string.
        String ->
        m [(Char, String)]
    parseTimeSpecifiersM :: forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Proxy t
    -> Bool -> TimeLocale -> String -> String -> m [(Char, String)]
    parseTimeSpecifiersM Proxy t
    pt Bool
    acceptWS TimeLocale
    l String
    fmt String
    s =
        case Proxy t
    -> Bool -> TimeLocale -> String -> String -> [[(Char, String)]]
    forall t.
    ParseTime t =>
    Proxy t
    -> Bool -> TimeLocale -> String -> String -> [[(Char, String)]]
    parseTimeSpecifiers Proxy t
    pt Bool
    acceptWS TimeLocale
    l String
    fmt String
    s of
            [[(Char, String)]
    t] -> [(Char, String)] -> m [(Char, String)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Char, String)]
    t
            [] -> String -> m [(Char, String)]
    forall a. HasCallStack => String -> m a
    forall (m :: * -> *) a.
    (MonadFail m, HasCallStack) =>
    String -> m a
    fail (String -> m [(Char, String)]) -> String -> m [(Char, String)]
    forall a b. (a -> b) -> a -> b
    $ String
    "parseTimeM: no parse of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    s
            [[(Char, String)]]
    _ -> String -> m [(Char, String)]
    forall a. HasCallStack => String -> m a
    forall (m :: * -> *) a.
    (MonadFail m, HasCallStack) =>
    String -> m a
    fail (String -> m [(Char, String)]) -> String -> m [(Char, String)]
    forall a b. (a -> b) -> a -> b
    $ String
    "parseTimeM: multiple parses of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    s

    parseTimeSpecifiers ::
        ParseTime t =>
        Proxy t ->
        -- | Accept leading and trailing whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Format string
        String ->
        -- | Input string.
        String ->
        [[(Char, String)]]
    parseTimeSpecifiers :: forall t.
    ParseTime t =>
    Proxy t
    -> Bool -> TimeLocale -> String -> String -> [[(Char, String)]]
    parseTimeSpecifiers Proxy t
    pt Bool
    False TimeLocale
    l String
    fmt String
    s = [[(Char, String)]
    t | ([(Char, String)]
    t, String
    "") <- ReadP [(Char, String)] -> ReadS [(Char, String)]
    forall a. ReadP a -> ReadS a
    readP_to_S (Proxy t -> Bool -> TimeLocale -> String -> ReadP [(Char, String)]
    forall t.
    ParseTime t =>
    Proxy t -> Bool -> TimeLocale -> String -> ReadP [(Char, String)]
    readPSpecifiers Proxy t
    pt Bool
    False TimeLocale
    l String
    fmt) String
    s]
    parseTimeSpecifiers Proxy t
    pt Bool
    True TimeLocale
    l String
    fmt String
    s = [[(Char, String)]
    t | ([(Char, String)]
    t, String
    r) <- ReadP [(Char, String)] -> ReadS [(Char, String)]
    forall a. ReadP a -> ReadS a
    readP_to_S (Proxy t -> Bool -> TimeLocale -> String -> ReadP [(Char, String)]
    forall t.
    ParseTime t =>
    Proxy t -> Bool -> TimeLocale -> String -> ReadP [(Char, String)]
    readPSpecifiers Proxy t
    pt Bool
    True TimeLocale
    l String
    fmt) String
    s, (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace String
    r]

    -- | Parse a time value given a format string.  See 'parseTimeM' for details.
    readSTime ::
        ParseTime t =>
        -- | Accept leading whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Format string
        String ->
        ReadS t
    readSTime :: forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
    readSTime Bool
    acceptWS TimeLocale
    l String
    f = ReadP t -> ReadS t
    forall a. ReadP a -> ReadS a
    readP_to_S (ReadP t -> ReadS t) -> ReadP t -> ReadS t
    forall a b. (a -> b) -> a -> b
    $ Bool -> TimeLocale -> String -> ReadP t
    forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadP t
    readPTime Bool
    acceptWS TimeLocale
    l String
    f

    readPSpecifiers ::
        ParseTime t =>
        Proxy t ->
        -- | Accept leading whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Format string
        String ->
        ReadP [(Char, String)]
    readPSpecifiers :: forall t.
    ParseTime t =>
    Proxy t -> Bool -> TimeLocale -> String -> ReadP [(Char, String)]
    readPSpecifiers Proxy t
    pt Bool
    False TimeLocale
    l String
    f = Proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
    forall t.
    ParseTime t =>
    Proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
    parseSpecifiers Proxy t
    pt TimeLocale
    l String
    f
    readPSpecifiers Proxy t
    pt Bool
    True TimeLocale
    l String
    f = (ReadP ()
    skipSpaces ReadP () -> ReadP [(Char, String)] -> ReadP [(Char, String)]
    forall a b. ReadP a -> ReadP b -> ReadP b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
    forall t.
    ParseTime t =>
    Proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
    parseSpecifiers Proxy t
    pt TimeLocale
    l String
    f) ReadP [(Char, String)]
    -> ReadP [(Char, String)] -> ReadP [(Char, String)]
    forall a. ReadP a -> ReadP a -> ReadP a
    <++ Proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
    forall t.
    ParseTime t =>
    Proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
    parseSpecifiers Proxy t
    pt TimeLocale
    l String
    f

    -- | Parse a time value given a format string.  See 'parseTimeM' for details.
    readPTime' ::
        ParseTime t =>
        Proxy t ->
        -- | Accept leading whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Format string
        String ->
        ReadP t
    readPTime' :: forall t.
    ParseTime t =>
    Proxy t -> Bool -> TimeLocale -> String -> ReadP t
    readPTime' Proxy t
    pt Bool
    ws TimeLocale
    l String
    f = do
        pairs <- Proxy t -> Bool -> TimeLocale -> String -> ReadP [(Char, String)]
    forall t.
    ParseTime t =>
    Proxy t -> Bool -> TimeLocale -> String -> ReadP [(Char, String)]
    readPSpecifiers Proxy t
    pt Bool
    ws TimeLocale
    l String
    f
        case buildTime l pairs of
            Just t
    t -> t -> ReadP t
    forall a. a -> ReadP a
    forall (m :: * -> *) a. Monad m => a -> m a
    return t
    t
            Maybe t
    Nothing -> ReadP t
    forall a. ReadP a
    pfail

    -- | Parse a time value given a format string.  See 'parseTimeM' for details.
    readPTime ::
        ParseTime t =>
        -- | Accept leading whitespace?
        Bool ->
        -- | Time locale.
        TimeLocale ->
        -- | Format string
        String ->
        ReadP t
    readPTime :: forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadP t
    readPTime = Proxy t -> Bool -> TimeLocale -> String -> ReadP t
    forall t.
    ParseTime t =>
    Proxy t -> Bool -> TimeLocale -> String -> ReadP t
    readPTime' Proxy t
    forall {k} (t :: k). Proxy t
    Proxy

    -- * Read instances for time package types

    instance Read Day where
        readsPrec :: Int -> ReadS Day
    readsPrec Int
    _ = Bool -> ReadS Day -> ReadS Day
    forall a. Bool -> ReadS a -> ReadS a
    readParen Bool
    False (ReadS Day -> ReadS Day) -> ReadS Day -> ReadS Day
    forall a b. (a -> b) -> a -> b
    $ Bool -> TimeLocale -> String -> ReadS Day
    forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
    readSTime Bool
    True TimeLocale
    defaultTimeLocale String
    "%Y-%m-%d"

    instance Read TimeOfDay where
        readsPrec :: Int -> ReadS TimeOfDay
    readsPrec Int
    _ = Bool -> ReadS TimeOfDay -> ReadS TimeOfDay
    forall a. Bool -> ReadS a -> ReadS a
    readParen Bool
    False (ReadS TimeOfDay -> ReadS TimeOfDay)
    -> ReadS TimeOfDay -> ReadS TimeOfDay
    forall a b. (a -> b) -> a -> b
    $ Bool -> TimeLocale -> String -> ReadS TimeOfDay
    forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
    readSTime Bool
    True TimeLocale
    defaultTimeLocale String
    "%H:%M:%S%Q"

    instance Read LocalTime where
        readsPrec :: Int -> ReadS LocalTime
    readsPrec Int
    _ = Bool -> ReadS LocalTime -> ReadS LocalTime
    forall a. Bool -> ReadS a -> ReadS a
    readParen Bool
    False (ReadS LocalTime -> ReadS LocalTime)
    -> ReadS LocalTime -> ReadS LocalTime
    forall a b. (a -> b) -> a -> b
    $ Bool -> TimeLocale -> String -> ReadS LocalTime
    forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
    readSTime Bool
    True TimeLocale
    defaultTimeLocale String
    "%Y-%m-%d %H:%M:%S%Q"

    -- | This only works for @±HHMM@ format,
    -- single-letter military time-zones,
    -- and these time-zones: \"UTC\", \"UT\", \"GMT\", \"EST\", \"EDT\", \"CST\", \"CDT\", \"MST\", \"MDT\", \"PST\", \"PDT\",
    -- per RFC 822 section 5.
    instance Read TimeZone where
        readsPrec :: Int -> ReadS TimeZone
    readsPrec Int
    _ = Bool -> ReadS TimeZone -> ReadS TimeZone
    forall a. Bool -> ReadS a -> ReadS a
    readParen Bool
    False (ReadS TimeZone -> ReadS TimeZone)
    -> ReadS TimeZone -> ReadS TimeZone
    forall a b. (a -> b) -> a -> b
    $ Bool -> TimeLocale -> String -> ReadS TimeZone
    forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
    readSTime Bool
    True TimeLocale
    defaultTimeLocale String
    "%Z"

    -- | This only works for a 'zonedTimeZone' in @±HHMM@ format,
    -- single-letter military time-zones,
    -- and these time-zones: \"UTC\", \"UT\", \"GMT\", \"EST\", \"EDT\", \"CST\", \"CDT\", \"MST\", \"MDT\", \"PST\", \"PDT\",
    -- per RFC 822 section 5.
    instance Read ZonedTime where
        readsPrec :: Int -> ReadS ZonedTime
    readsPrec Int
    n = Bool -> ReadS ZonedTime -> ReadS ZonedTime
    forall a. Bool -> ReadS a -> ReadS a
    readParen Bool
    False (ReadS ZonedTime -> ReadS ZonedTime)
    -> ReadS ZonedTime -> ReadS ZonedTime
    forall a b. (a -> b) -> a -> b
    $ \String
    s -> [(LocalTime -> TimeZone -> ZonedTime
    ZonedTime LocalTime
    t TimeZone
    z, String
    r2) | (LocalTime
    t, String
    r1) <- Int -> ReadS LocalTime
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    n String
    s, (TimeZone
    z, String
    r2) <- Int -> ReadS TimeZone
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    n String
    r1]

    (<||) :: [a] -> [a] -> [a]
    [] <|| :: forall a. [a] -> [a] -> [a]
    <|| [a]
    b = [a]
    b
    [a]
    a <|| [a]
    _ = [a]
    a

    instance Read UTCTime where
        readsPrec :: Int -> ReadS UTCTime
    readsPrec Int
    n String
    s = do
            (lt, s') <- Int -> ReadS LocalTime
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    n String
    s
            (tz, s'') <- readsPrec n s' <|| pure (utc, s')
            return (localTimeToUTC tz lt, s'')

    instance Read UniversalTime where
        readsPrec :: Int -> ReadS UniversalTime
    readsPrec Int
    n String
    s = [(Rational -> LocalTime -> UniversalTime
    localTimeToUT1 Rational
    0 LocalTime
    t, String
    r) | (LocalTime
    t, String
    r) <- Int -> ReadS LocalTime
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    n String
    s]