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

module Data.Time.Format.Parse
    (
    -- * UNIX-style parsing
      parseTimeM
    , parseTimeOrError
    , readSTime
    , readPTime
    , ParseTime()
    -- * Locale
    , module Data.Time.Format.Locale
    ) 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 Prelude hiding (fail)
import Text.ParserCombinators.ReadP hiding (char, string)

-- | 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@ @%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 acceptWS l fmt s =
    case parseTimeList acceptWS l fmt s of
        [t] -> return t
        [] -> fail $ "parseTimeM: no parse of " ++ show s
        _ -> fail $ "parseTimeM: multiple parses of " ++ show 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 acceptWS l fmt s =
    case parseTimeList acceptWS l fmt s of
        [t] -> t
        [] -> error $ "parseTimeOrError: no parse of " ++ show s
        _ -> error $ "parseTimeOrError: multiple parses of " ++ show s

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

readPOnlyTime' :: ParseTime t => Proxy t -> TimeLocale -> String -> ReadP t
readPOnlyTime' pt l f = do
    pairs <- parseSpecifiers pt l f
    case buildTime l pairs of
        Just t -> return t
        Nothing -> 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 = readPOnlyTime' Proxy

-- * Read instances for time package types
instance Read Day where
    readsPrec _ = readParen False $ readSTime True defaultTimeLocale "%Y-%m-%d"

instance Read TimeOfDay where
    readsPrec _ = readParen False $ readSTime True defaultTimeLocale "%H:%M:%S%Q"

instance Read LocalTime where
    readsPrec _ = readParen False $ readSTime True defaultTimeLocale "%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 _ = readParen False $ readSTime True defaultTimeLocale "%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 n = readParen False $ \s -> [(ZonedTime t z, r2) | (t, r1) <- readsPrec n s, (z, r2) <- readsPrec n r1]

instance Read UTCTime where
    readsPrec n s = [(zonedTimeToUTC t, r) | (t, r) <- readsPrec n s]

instance Read UniversalTime where
    readsPrec n s = [(localTimeToUT1 0 t, r) | (t, r) <- readsPrec n s]