module Data.Time.Format.RFC1123
( 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.Proxy
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
data RFC1123
rfc1123 ∷ Proxy RFC1123
rfc1123 = Proxy
instance ConvertSuccess ZonedTime (Tagged RFC1123 Ascii) where
convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
instance ConvertSuccess ZonedTime (Tagged RFC1123 AsciiBuilder) where
convertSuccess = Tagged ∘ toAsciiBuilder
instance ConvertAttempt (Tagged RFC1123 Ascii) ZonedTime where
convertAttempt = parseAttempt' rfc1123DateAndTime ∘ untag
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 |])
]