1{-# LANGUAGE CPP #-}
2module Data.Time.Format.Compat (
3    -- * UNIX-style formatting
4    FormatTime(),formatTime,
5
6    -- * UNIX-style parsing
7    -- ** __Note__ in compat mode acceptWS argument is ignored, it's always 'True'.
8    parseTimeM,
9    -- parseTimeMultipleM, -- TODO
10    parseTimeOrError,
11    readSTime, readPTime,
12    parseTime, readTime, readsTime,
13    ParseTime(),
14
15    -- * Locale
16    TimeLocale(..),
17
18    defaultTimeLocale,
19
20    iso8601DateFormat,
21    rfc822DateFormat,
22    ) where
23
24import Data.Time.Orphans ()
25
26#if !MIN_VERSION_time(1,5,0)
27import Data.Time.Format
28import System.Locale (TimeLocale, defaultTimeLocale, iso8601DateFormat, rfc822DateFormat)
29import Text.ParserCombinators.ReadP (readP_to_S, readS_to_P, ReadP)
30#else
31#if !(MIN_VERSION_time(1,9,0)) || !(MIN_VERSION_base(4,9,0))
32import Data.Time.Format hiding (parseTimeM)
33#else
34import Data.Time.Format
35#endif
36#endif
37
38import qualified Control.Monad.Fail as Fail
39import qualified Data.Time.Format
40
41#if !MIN_VERSION_time(1,5,0)
42parseTimeM
43    :: (Fail.MonadFail m, ParseTime t)
44    => Bool       -- ^ Accept leading and trailing whitespace?
45    -> TimeLocale -- ^ Time locale.
46    -> String     -- ^ Format string.
47    -> String     -- ^ Input string.
48    -> m t        -- ^ Return the time value, or fail if the in
49parseTimeM _acceptWS l fmt s = case parseTime l fmt s of
50    Just x  -> return x
51    Nothing -> Fail.fail "parseTimeM: no parse"
52
53parseTimeOrError
54    :: ParseTime t
55    => Bool       -- ^ Accept leading and trailing whitespace?
56    -> TimeLocale -- ^ Time locale.
57    -> String     -- ^ Format string.
58    -> String     -- ^ Input string.
59    -> t          -- ^ The time value.
60parseTimeOrError _acceptWS l fmt s = case parseTime l fmt s of
61    Just x  -> x
62    Nothing -> error "parseTimeOrError: no parse"
63
64-- | Parse a time value given a format string.  See 'parseTimeM' for details.
65readSTime :: ParseTime t =>
66             Bool       -- ^ Accept leading whitespace?
67          -> TimeLocale -- ^ Time locale.
68          -> String     -- ^ Format string
69          -> ReadS t
70readSTime _acceptWS l f  = readsTime l f
71
72-- | Parse a time value given a format string.  See 'parseTimeM' for details.
73readPTime :: ParseTime t =>
74             Bool       -- ^ Accept leading whitespace?
75          -> TimeLocale -- ^ Time locale.
76          -> String     -- ^ Format string
77          -> ReadP t
78readPTime acceptWS l f = readS_to_P (readSTime acceptWS l f)
79
80#else
81
82-- parseTimeM has always Fail.MonadFail constraint
83#if !MIN_VERSION_time(1,9,0) || !MIN_VERSION_base(4,9,0)
84-- | Parses a time value given a format string.
85--
86-- This variant from @time-compat@ has always 'Fail.MonadFail' constraint.
87--
88-- Look at 'Data.Time.Format.parseTimeM' for documentation.
89parseTimeM
90    :: (Fail.MonadFail m, ParseTime t)
91    => Bool       -- ^ Accept leading and trailing whitespace?
92    -> TimeLocale -- ^ Time locale.
93    -> String     -- ^ Format string.
94    -> String     -- ^ Input string.
95    -> m t        -- ^ Return the time value, or fail if the in
96parseTimeM = Data.Time.Format.parseTimeM
97#endif
98#endif
99
100#if MIN_VERSION_time(1,10,0)
101{-# DEPRECATED parseTime "use \"parseTimeM True\" instead" #-}
102parseTime :: ParseTime t =>
103             TimeLocale -- ^ Time locale.
104          -> String     -- ^ Format string.
105          -> String     -- ^ Input string.
106          -> Maybe t    -- ^ The time value, or 'Nothing' if the input could
107                        -- not be parsed using the given format.
108parseTime = parseTimeM True
109
110{-# DEPRECATED readTime "use \"parseTimeOrError True\" instead" #-}
111readTime :: ParseTime t =>
112            TimeLocale -- ^ Time locale.
113         -> String     -- ^ Format string.
114         -> String     -- ^ Input string.
115         -> t          -- ^ The time value.
116readTime = parseTimeOrError True
117
118{-# DEPRECATED readsTime "use \"readSTime True\" instead" #-}
119readsTime :: ParseTime t =>
120             TimeLocale -- ^ Time locale.
121          -> String     -- ^ Format string
122          -> ReadS t
123readsTime = readSTime True
124#endif
125
126-- TODO:
127--
128-- #if !MIN_VERSION_time(1,11,0)
129-- -- | Parses a time value given a list of pairs of format and input.
130-- -- Resulting value is constructed from all provided specifiers.
131-- parseTimeMultipleM
132--     :: (Fail.MonadFail m, ParseTime t)
133--     => Bool -- ^ Accept leading and trailing whitespace?
134--     -> TimeLocale -- ^ Time locale.
135--     -> [(String, String)] -- ^ Pairs of (format string, input string).
136--     -> m t -- ^ Return the time value, or fail if the input could not be parsed using the given format.
137-- parseTimeMultipleM = undefined -- parseTimeMultipleM' Proxy
138-- #endif
139