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

module Data.Time.Format.Parse
    (
    -- * UNIX-style parsing
      parseTimeM
    , parseTimeMultipleM
    , parseTimeOrError
    , readSTime
    , readPTime
    , ParseTime()
    -- * Locale
    , module Data.Time.Format.Locale
    ) where

import Control.Applicative ((<|>))
import Control.Monad.Fail
import Data.Char
import Data.Proxy
import Data.Traversable
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 Prelude hiding (fail)
import Text.ParserCombinators.ReadP hiding (char, string)

-- | 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)
    => Bool -- ^ Accept leading and trailing whitespace?
    -> TimeLocale -- ^ Time locale.
    -> String -- ^ Format string.
    -> String -- ^ Input string.
    -> m t -- ^ Return the time value, or fail if the input could not be parsed using the given format.
parseTimeM :: forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
acceptWS TimeLocale
l String
fmt String
s = 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
    -> Bool -- ^ Accept leading and trailing whitespace?
    -> TimeLocale -- ^ Time locale.
    -> [(String, String)] -- ^ Pairs of (format string, input string).
    -> m t -- ^ Return the time value, or fail if the input could not be parsed using the given format.
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
    [[(Char, String)]]
specss <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(String, String)]
fmts forall a b. (a -> b) -> a -> b
$ \(String
fmt,String
s) -> 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 forall t. ParseTime t => TimeLocale -> [(Char, String)] -> Maybe t
buildTime TimeLocale
l forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[(Char, String)]]
specss of
        Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return t
t
        Maybe t
Nothing -> forall (m :: * -> *) a. MonadFail m => 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)
    => Bool -- ^ Accept leading and trailing whitespace?
    -> TimeLocale -- ^ Time locale.
    -> [(String, String)] -- ^ Pairs of (format string, input string).
    -> m t -- ^ Return the time value, or fail if the input could not be parsed using the given format.
parseTimeMultipleM :: forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> [(String, String)] -> m t
parseTimeMultipleM = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Proxy t -> Bool -> TimeLocale -> [(String, String)] -> m t
parseTimeMultipleM' 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
    => Bool -- ^ Accept leading and trailing whitespace?
    -> TimeLocale -- ^ Time locale.
    -> String -- ^ Format string.
    -> String -- ^ Input string.
    -> t -- ^ The time value.
parseTimeOrError :: forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
acceptWS TimeLocale
l String
fmt String
s =
    case 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
        [] -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"parseTimeOrError: no parse of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s
        [t]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"parseTimeOrError: multiple parses of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s

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

parseTimeSpecifiers ::
       ParseTime t
    => Proxy t
    -> Bool -- ^ Accept leading and trailing whitespace?
    -> TimeLocale -- ^ Time locale.
    -> String -- ^ Format string
    -> String -- ^ Input 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
"") <- forall a. ReadP a -> ReadS a
readP_to_S (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) <- forall a. ReadP a -> ReadS a
readP_to_S (forall t.
ParseTime t =>
Proxy t -> Bool -> TimeLocale -> String -> ReadP [(Char, String)]
readPSpecifiers Proxy t
pt Bool
True TimeLocale
l String
fmt) String
s, 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
    => Bool -- ^ Accept leading whitespace?
    -> TimeLocale -- ^ Time locale.
    -> String -- ^ Format string
    -> ReadS t
readSTime :: forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
readSTime Bool
acceptWS TimeLocale
l String
f = forall a. ReadP a -> ReadS a
readP_to_S forall a b. (a -> b) -> a -> b
$ forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadP t
readPTime Bool
acceptWS TimeLocale
l String
f

readPSpecifiers ::
       ParseTime t
    => Proxy t
    -> Bool -- ^ Accept leading whitespace?
    -> TimeLocale -- ^ Time locale.
    -> String -- ^ Format 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 = 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t.
ParseTime t =>
Proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
parseSpecifiers Proxy t
pt TimeLocale
l String
f) forall a. ReadP a -> ReadP a -> ReadP a
<++ 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
    -> Bool -- ^ Accept leading whitespace?
    -> TimeLocale -- ^ Time locale.
    -> String -- ^ Format 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
    [(Char, String)]
pairs <- forall t.
ParseTime t =>
Proxy t -> Bool -> TimeLocale -> String -> ReadP [(Char, String)]
readPSpecifiers Proxy t
pt Bool
ws TimeLocale
l String
f
    case forall t. ParseTime t => TimeLocale -> [(Char, String)] -> Maybe t
buildTime TimeLocale
l [(Char, String)]
pairs of
        Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return t
t
        Maybe t
Nothing -> forall a. ReadP a
pfail

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

-- * Read instances for time package types
instance Read Day where
    readsPrec :: Int -> ReadS Day
readsPrec Int
_ = forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False forall a b. (a -> b) -> a -> b
$ 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
_ = forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False forall a b. (a -> b) -> a -> b
$ 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
_ = forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False forall a b. (a -> b) -> a -> b
$ 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\".
instance Read TimeZone where
    readsPrec :: Int -> ReadS TimeZone
readsPrec Int
_ = forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False forall a b. (a -> b) -> a -> b
$ 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\".
instance Read ZonedTime where
    readsPrec :: Int -> ReadS ZonedTime
readsPrec Int
n = forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False forall a b. (a -> b) -> a -> b
$ \String
s -> [(LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
t TimeZone
z, String
r2) | (LocalTime
t, String
r1) <- forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s, (TimeZone
z, String
r2) <- forall a. Read a => Int -> ReadS a
readsPrec Int
n String
r1]

instance Read UTCTime where
    readsPrec :: Int -> ReadS UTCTime
readsPrec Int
n String
s = do
        (LocalTime
lt, String
s') <- forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s
        (TimeZone
tz, String
s'') <- forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeZone
utc, String
s')
        forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
tz LocalTime
lt, String
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) <- forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s]