+{-# LANGUAGE
+ FlexibleInstances
+ , MultiParamTypeClasses
+ , OverloadedStrings
+ , TemplateHaskell
+ , UnicodeSyntax
+ #-}
+-- |This module provides functions to parse and format HTTP\/1.1 date
+-- and time formats.
+--
+-- The HTTP\/1.1 specification (RFC 2616) says that HTTP\/1.1 clients
+-- and servers which parse the date value MUST accept all the
+-- following formats, though they MUST only generate the RFC 1123
+-- format for representing HTTP-date values in header fields:
+--
+-- > Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123
+-- > Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036
+-- > Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() format
+--
+-- It also says that all HTTP date\/time stamps MUST be represented in
+-- Greenwich Mean Time (GMT), without exception. For the purposes of
+-- HTTP, GMT is exactly equal to UTC (Coordinated Universal
+-- Time). This is indicated in the first two formats by the inclusion
+-- of @\"GMT\"@ as the three-letter abbreviation for time zone, and
+-- MUST be assumed when reading the asctime format.
+--
+-- > HTTP-date = rfc1123-date | rfc850-date | asctime-date
+-- > rfc1123-date = wkday "," SP date1 SP time SP "GMT"
+-- > rfc850-date = weekday "," SP date2 SP time SP "GMT"
+-- > asctime-date = wkday SP date3 SP time SP 4DIGIT
+-- > date1 = 2DIGIT SP month SP 4DIGIT
+-- > ; day month year (e.g., 02 Jun 1982)
+-- > date2 = 2DIGIT "-" month "-" 2DIGIT
+-- > ; day-month-year (e.g., 02-Jun-82)
+-- > date3 = month SP ( 2DIGIT | ( SP 1DIGIT ))
+-- > ; month day (e.g., Jun 2)
+-- > time = 2DIGIT ":" 2DIGIT ":" 2DIGIT
+-- > ; 00:00:00 - 23:59:59
+-- > wkday = "Mon" | "Tue" | "Wed"
+-- > | "Thu" | "Fri" | "Sat" | "Sun"
+-- > weekday = "Monday" | "Tuesday" | "Wednesday"
+-- > | "Thursday" | "Friday" | "Saturday" | "Sunday"
+-- > month = "Jan" | "Feb" | "Mar" | "Apr"
+-- > | "May" | "Jun" | "Jul" | "Aug"
+-- > | "Sep" | "Oct" | "Nov" | "Dec"
module Data.Time.HTTP
- ( format
- , parse
+ ( HTTP
+ , httpDateAndTime
)
where
+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.Asctime
+import Data.Time.RFC1123
+import Data.Time.RFC733
+import Data.Time.RFC822
+import Data.Time.HTTP.Common
+import Prelude.Unicode
-import qualified Data.Time.RFC1123 as RFC1123
-import qualified Text.Parsec as P
+-- |FIXME: doc
+data HTTP
-import Data.Time
-import Data.Time.HTTP.Parsec
+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
-format :: UTCTime -> String
-format utcTime
- = let timeZone = TimeZone 0 False "GMT"
- zonedTime = utcToZonedTime timeZone utcTime
- in
- RFC1123.format zonedTime
+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.
+--
+-- 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
+ ]
-parse :: String -> Maybe UTCTime
-parse src = case P.parse p "" src of
- Right ut -> Just ut
- Left _ -> Nothing
+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 |])
+ ]