--- /dev/null
+{-# LANGUAGE
+ FlexibleInstances
+ , MultiParamTypeClasses
+ , OverloadedStrings
+ , TemplateHaskell
+ , UnicodeSyntax
+ #-}
+-- |This module provides functions to parse and format RFC 1123 date
+-- and time strings (<http://tools.ietf.org/html/rfc1123#page-55>).
+--
+-- The format is basically same as RFC 822, but the syntax for @date@
+-- is changed from:
+--
+-- > year ::= 2DIGIT
+--
+-- to:
+--
+-- > year ::= 4DIGIT
+module Data.Time.Format.RFC1123
+ ( RFC1123
+ , rfc1123DateAndTime
+ )
+ 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.Monoid.Unicode
+import Data.Tagged
+import Data.Time
+import Data.Time.Calendar.WeekDate
+import Data.Time.Format.HTTP.Common
+import Data.Time.Format.RFC822.Internal
+import Prelude.Unicode
+
+-- |The phantom type for conversions between RFC 1123 date and time
+-- strings and 'ZonedTime'.
+--
+-- >>> convertSuccess (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc)
+-- Tagged "Sun, 06 Nov 1994 08:49:37 GMT"
+data RFC1123
+
+instance ConvertSuccess ZonedTime (Tagged RFC1123 Ascii) where
+ {-# INLINE convertSuccess #-}
+ convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
+
+instance ConvertSuccess ZonedTime (Tagged RFC1123 AsciiBuilder) where
+ {-# INLINE convertSuccess #-}
+ convertSuccess = Tagged ∘ toAsciiBuilder
+
+instance ConvertAttempt (Tagged RFC1123 Ascii) ZonedTime where
+ {-# INLINE convertAttempt #-}
+ convertAttempt = parseAttempt' rfc1123DateAndTime ∘ untag
+
+-- |Parse an RFC 1123 date and time string.
+rfc1123DateAndTime ∷ Parser ZonedTime
+rfc1123DateAndTime = dateTime
+
+dateTime ∷ Parser ZonedTime
+dateTime = do weekDay ← optionMaybe $
+ do w ← shortWeekDayNameP
+ _ ← string ", "
+ return w
+ gregDay ← date
+ case weekDay of
+ Nothing
+ → return ()
+ Just givenWD
+ → assertWeekDayIsGood givenWD gregDay
+ (tod, timeZone) ← rfc822Time
+ let lt = LocalTime gregDay tod
+ zt = ZonedTime lt timeZone
+ return zt
+
+date ∷ Parser Day
+date = do day ← read2
+ _ ← char ' '
+ month ← shortMonthNameP
+ _ ← char ' '
+ year ← read4
+ _ ← char ' '
+ assertGregorianDateIsGood year month day
+
+toAsciiBuilder ∷ ZonedTime → AsciiBuilder
+toAsciiBuilder zonedTime
+ = let localTime = zonedTimeToLocalTime zonedTime
+ timeZone = zonedTimeZone zonedTime
+ (year, month, day) = toGregorian (localDay localTime)
+ (_, _, week) = toWeekDate (localDay localTime)
+ timeOfDay = localTimeOfDay localTime
+ in
+ shortWeekDayName week
+ ⊕ A.toAsciiBuilder ", "
+ ⊕ show2 day
+ ⊕ A.toAsciiBuilder " "
+ ⊕ shortMonthName month
+ ⊕ A.toAsciiBuilder " "
+ ⊕ show4 year
+ ⊕ A.toAsciiBuilder " "
+ ⊕ show2 (todHour timeOfDay)
+ ⊕ A.toAsciiBuilder ":"
+ ⊕ show2 (todMin timeOfDay)
+ ⊕ A.toAsciiBuilder ":"
+ ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
+ ⊕ A.toAsciiBuilder " "
+ ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)
+
+deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC1123 Ascii |])
+ , ([t| ZonedTime |], [t| Tagged RFC1123 AsciiBuilder |])
+ ]