{-# OPTIONS -fno-warn-orphans #-}
module Data.Time.Format.Parse
    (
    -- * UNIX-style parsing
    parseTimeM, parseTimeOrError, readSTime, readPTime,
    parseTime, readTime, readsTime,
    ParseTime(),
    -- * Locale
    module Data.Time.Format.Locale
    ) where

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

-- | Parses a time value given a format string.
-- 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@] accepts any of @±HHMM@ or @±HH:MM@.
--
-- [@%Z@] 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 :: (
#if MIN_VERSION_base(4,9,0)
    MonadFail m
#else
    Monad m
#endif
    ,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 = case Bool -> TimeLocale -> String -> String -> [t]
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> [t]
parseTimeList Bool
acceptWS TimeLocale
l String
fmt String
s of
    [t
t] -> t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return t
t
    []  -> String -> m t
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m t) -> String -> m t
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
    [t]
_   -> String -> m t
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m t) -> String -> m t
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

-- | 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 Bool -> TimeLocale -> String -> String -> [t]
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> [t]
parseTimeList 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

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

-- | 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 Bool
False TimeLocale
l String
f = TimeLocale -> String -> ReadP t
forall t. ParseTime t => TimeLocale -> String -> ReadP t
readPOnlyTime TimeLocale
l String
f
readPTime Bool
True TimeLocale
l String
f = (ReadP ()
skipSpaces ReadP () -> ReadP t -> ReadP t
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeLocale -> String -> ReadP t
forall t. ParseTime t => TimeLocale -> String -> ReadP t
readPOnlyTime TimeLocale
l String
f) ReadP t -> ReadP t -> ReadP t
forall a. ReadP a -> ReadP a -> ReadP a
<++ TimeLocale -> String -> ReadP t
forall t. ParseTime t => TimeLocale -> String -> ReadP t
readPOnlyTime TimeLocale
l String
f

readPOnlyTime' :: ParseTime t => proxy t -> TimeLocale -> String -> ReadP t
readPOnlyTime' :: forall t (proxy :: * -> *).
ParseTime t =>
proxy t -> TimeLocale -> String -> ReadP t
readPOnlyTime' proxy t
pt TimeLocale
l String
f = do
    [(Char, String)]
pairs <- proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
forall t (proxy :: * -> *).
ParseTime t =>
proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
parseSpecifiers proxy t
pt TimeLocale
l String
f
    case TimeLocale -> [(Char, String)] -> Maybe t
forall t. ParseTime t => TimeLocale -> [(Char, String)] -> Maybe t
buildTime TimeLocale
l [(Char, String)]
pairs of
        Just t
t -> t -> ReadP t
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 (without allowing leading whitespace).  See 'parseTimeM' for details.
readPOnlyTime :: ParseTime t =>
             TimeLocale -- ^ Time locale.
          -> String     -- ^ Format string
          -> ReadP t
readPOnlyTime :: forall t. ParseTime t => TimeLocale -> String -> ReadP t
readPOnlyTime = Proxy t -> TimeLocale -> String -> ReadP t
forall t (proxy :: * -> *).
ParseTime t =>
proxy t -> TimeLocale -> String -> ReadP t
readPOnlyTime' Proxy t
forall {k} (t :: k). Proxy t
Proxy

{-# DEPRECATED parseTime "use \"parseTimeM True\" instead" #-}
parseTime :: ParseTime t =>
             TimeLocale -- ^ Time locale.
          -> String     -- ^ Format string.
          -> String     -- ^ Input string.
          -> Maybe t    -- ^ The time value, or 'Nothing' if the input could
                        -- not be parsed using the given format.
parseTime :: forall t. ParseTime t => TimeLocale -> String -> String -> Maybe t
parseTime = Bool -> TimeLocale -> String -> String -> Maybe t
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True

{-# DEPRECATED readTime "use \"parseTimeOrError True\" instead" #-}
readTime :: ParseTime t =>
            TimeLocale -- ^ Time locale.
         -> String     -- ^ Format string.
         -> String     -- ^ Input string.
         -> t          -- ^ The time value.
readTime :: forall t. ParseTime t => TimeLocale -> String -> String -> t
readTime = Bool -> TimeLocale -> String -> String -> t
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
True

{-# DEPRECATED readsTime "use \"readSTime True\" instead" #-}
readsTime :: ParseTime t =>
             TimeLocale -- ^ Time locale.
          -> String     -- ^ Format string
          -> ReadS t
readsTime :: forall t. ParseTime t => TimeLocale -> String -> ReadS t
readsTime = Bool -> TimeLocale -> String -> ReadS t
forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
readSTime Bool
True

-- * 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\".
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\".
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]

instance Read UTCTime where
    readsPrec :: Int -> ReadS UTCTime
readsPrec Int
n String
s = [ (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
t, String
r) | (ZonedTime
t,String
r) <- Int -> ReadS ZonedTime
forall a. Read a => Int -> ReadS a
readsPrec Int
n 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) <- Int -> ReadS LocalTime
forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s ]