, MultiParamTypeClasses
, OverloadedStrings
, TemplateHaskell
+ , TypeSynonymInstances
, UnicodeSyntax
#-}
-- |This module provides functions to parse and format HTTP\/1.1 date
-- > | "Sep" | "Oct" | "Nov" | "Dec"
module Data.Time.Format.HTTP
( HTTP
- , http
- , httpDateAndTime
)
where
import Control.Applicative
import qualified Data.Ascii as A
import Data.Attoparsec.Char8
import Data.Convertible.Base
-import Data.Proxy
+import Data.Default
import Data.Tagged
import Data.Time
import Data.Time.Format.C
-- |The phantom type for conversions between HTTP/1.1 date and time
-- strings and 'UTCTime'.
--
--- >>> convertSuccess (UTCTime (ModifiedJulianDay 49662) 31777)
--- Tagged "Sun, 06 Nov 1994 08:49:37 GMT"
+-- >>> convertSuccess (Tagged (UTCTime (ModifiedJulianDay 49662) 31777) :: Tagged HTTP UTCTime)
+-- "Sun, 06 Nov 1994 08:49:37 GMT"
data HTTP
--- |The proxy for conversions between ANSI HTTP/1.1 date and time
--- strings and 'UTCTime'.
-http ∷ Proxy HTTP
-{-# INLINE CONLIKE http #-}
-http = Proxy
-
-instance ConvertSuccess UTCTime (Tagged HTTP Ascii) where
+instance ConvertSuccess (Tagged HTTP UTCTime) Ascii where
{-# INLINE convertSuccess #-}
- convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
+ convertSuccess = A.fromAsciiBuilder ∘ cs
-instance ConvertSuccess UTCTime (Tagged HTTP AsciiBuilder) where
+instance ConvertSuccess (Tagged HTTP UTCTime) AsciiBuilder where
{-# INLINE convertSuccess #-}
- convertSuccess = Tagged ∘ toAsciiBuilder
+ convertSuccess = toAsciiBuilder
-instance ConvertAttempt (Tagged HTTP Ascii) UTCTime where
+instance ConvertAttempt Ascii (Tagged HTTP UTCTime) where
{-# INLINE convertAttempt #-}
- convertAttempt = parseAttempt' httpDateAndTime ∘ untag
+ convertAttempt = parseAttempt' def
-- |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 <$> cDateAndTime
- ]
+-- This parser 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.
+instance Default (Parser (Tagged HTTP UTCTime)) where
+ {-# INLINEABLE def #-}
+ def = Tagged
+ <$>
+ choice [ (zonedTimeToUTC ∘ untag) <$> try (def ∷ Parser (Tagged RFC1123 ZonedTime))
+ , (zonedTimeToUTC ∘ untag) <$> try (def ∷ Parser (Tagged RFC733 ZonedTime))
+ , (zonedTimeToUTC ∘ untag) <$> try (def ∷ Parser (Tagged RFC822 ZonedTime))
+ , (localTimeToUTC utc ∘ untag) <$> (def ∷ Parser (Tagged C LocalTime))
+ ]
-toAsciiBuilder ∷ UTCTime → AsciiBuilder
-{-# INLINE toAsciiBuilder #-}
-toAsciiBuilder = flip proxy rfc1123 ∘ cs ∘ ut2zt
+toAsciiBuilder ∷ Tagged HTTP UTCTime → AsciiBuilder
+{-# INLINEABLE toAsciiBuilder #-}
+toAsciiBuilder = cs ∘ (ut2zt <$>) ∘ retag'
where
ut2zt ∷ UTCTime → ZonedTime
{-# INLINE ut2zt #-}
{-# INLINE CONLIKE gmt #-}
gmt = TimeZone 0 False "GMT"
-deriveAttempts [ ([t| UTCTime |], [t| Tagged HTTP Ascii |])
- , ([t| UTCTime |], [t| Tagged HTTP AsciiBuilder |])
+ retag' ∷ Tagged τ α → Tagged RFC1123 α
+ {-# INLINE retag' #-}
+ retag' = retag
+
+deriveAttempts [ ([t| Tagged HTTP UTCTime |], [t| Ascii |])
+ , ([t| Tagged HTTP UTCTime |], [t| AsciiBuilder |])
]