+{-# LANGUAGE
+ FlexibleInstances
+ , MultiParamTypeClasses
+ , OverloadedStrings
+ , TemplateHaskell
+ , UnicodeSyntax
+ #-}
-- |This module provides functions to parse and format HTTP\/1.1 date
-- and time formats.
--
-- > | "May" | "Jun" | "Jul" | "Aug"
-- > | "Sep" | "Oct" | "Nov" | "Dec"
module Data.Time.HTTP
- ( format
- , parse
+ ( HTTP
+ , httpDateAndTime
)
where
-import qualified Data.Time.RFC1123 as RFC1123
+import Control.Applicative
+import Data.Ascii (Ascii, AsciiBuilder)
+import qualified Data.Ascii as A
+import Data.Attoparsec.Char8
+import Data.Convertible.Base
+import Data.Tagged
import Data.Time
-import Data.Time.HTTP.Internal
+import Data.Time.Asctime
+import Data.Time.RFC1123
+import Data.Time.RFC733
+import Data.Time.RFC822
+import Data.Time.HTTP.Common
+import Prelude.Unicode
--- |Format an 'UTCTime' in RFC 1123 date and time.
-format :: UTCTime -> String
-format utcTime
- = let timeZone = TimeZone 0 False "GMT"
- zonedTime = utcToZonedTime timeZone utcTime
- in
- RFC1123.format zonedTime
+-- |FIXME: doc
+data HTTP
+
+instance ConvertSuccess UTCTime (Tagged HTTP Ascii) where
+ {-# INLINE convertSuccess #-}
+ convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
+
+instance ConvertSuccess UTCTime (Tagged HTTP AsciiBuilder) where
+ {-# INLINE convertSuccess #-}
+ convertSuccess = Tagged ∘ toAsciiBuilder
+
+instance ConvertAttempt (Tagged HTTP Ascii) UTCTime where
+ {-# INLINE convertAttempt #-}
+ convertAttempt = parseAttempt' httpDateAndTime ∘ untag
-- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850
--- and ANSI C's asctime() formats. When the string can't be parsed, it
--- returns 'Nothing'.
+-- and ANSI C's asctime() formats.
--
--- This function is even more permissive than what HTTP\/1.1
--- specifies. That is, it accepts 2-digit years in RFC 822, omitted
--- separator symbols in RFC 850, omitted sec fields, and non-GMT time
--- zones. I believe this behavior will not cause a problem but you
--- should know this.
-parse :: String -> Maybe UTCTime
-parse src = case P.parse p "" src of
- Right ut -> Just ut
- Left _ -> Nothing
+-- This function is even more permissive than what HTTP\/1.1 (RFC
+-- 2616) specifies. That is, it accepts 2-digit years in RFC 822,
+-- omitted separator symbols in RFC 850, omitted sec fields, and
+-- non-GMT time zones. I believe this behavior will not cause a
+-- problem though.
+httpDateAndTime ∷ Parser UTCTime
+httpDateAndTime
+ = choice [ zonedTimeToUTC <$> try rfc1123DateAndTime
+ , zonedTimeToUTC <$> try rfc733DateAndTime
+ , zonedTimeToUTC <$> try rfc822DateAndTime
+ , localTimeToUTC utc <$> asctime
+ ]
+
+toAsciiBuilder ∷ UTCTime → AsciiBuilder
+toAsciiBuilder = untag' ∘ cs ∘ ut2zt
where
- p = do zt <- rfc2616DateAndTime
- _ <- P.eof
- return zt
+ untag' ∷ Tagged RFC1123 AsciiBuilder → AsciiBuilder
+ {-# INLINE CONLIKE untag' #-}
+ untag' = untag
+
+ ut2zt ∷ UTCTime → ZonedTime
+ {-# INLINE ut2zt #-}
+ ut2zt = utcToZonedTime gmt
+
+ gmt ∷ TimeZone
+ {-# INLINE CONLIKE gmt #-}
+ gmt = TimeZone 0 False "GMT"
+
+deriveAttempts [ ([t| UTCTime |], [t| Tagged HTTP Ascii |])
+ , ([t| UTCTime |], [t| Tagged HTTP AsciiBuilder |])
+ ]