X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Data%2FTime%2FRFC1123%2FInternal.hs;h=bfb03675e7b0128531d9d6903888361be2cbe9cb;hp=1dc2a1ddbd426a0a2929c350a2a6361943ff5853;hb=24bf3b8;hpb=d82d61b7f6627c026d0a61209a6cceda5e572214 diff --git a/Data/Time/RFC1123/Internal.hs b/Data/Time/RFC1123/Internal.hs index 1dc2a1d..bfb0367 100644 --- a/Data/Time/RFC1123/Internal.hs +++ b/Data/Time/RFC1123/Internal.hs @@ -1,41 +1,71 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE + OverloadedStrings + , UnicodeSyntax + #-} module Data.Time.RFC1123.Internal ( rfc1123DateAndTime + , toAsciiBuilder ) where -import Control.Monad +import Data.Ascii (AsciiBuilder) +import qualified Data.Ascii as A import Data.Attoparsec.Char8 -import Data.Fixed +import Data.Monoid.Unicode import Data.Time import Data.Time.Calendar.WeekDate import Data.Time.HTTP.Common -import Data.Time.RFC822.Internal +import Data.Time.RFC822.Internal hiding (toAsciiBuilder) -- |Parse an RFC 1123 date and time string. -rfc1123DateAndTime :: Parser ZonedTime +rfc1123DateAndTime ∷ Parser ZonedTime rfc1123DateAndTime = dateTime -dateTime :: Parser ZonedTime -dateTime = do weekDay <- optionMaybe $ - do w <- shortWeekDayNameP - _ <- string ", " +dateTime ∷ Parser ZonedTime +dateTime = do weekDay ← optionMaybe $ + do w ← shortWeekDayNameP + _ ← string ", " return w - gregDay <- date + gregDay ← date case weekDay of Nothing - -> return () -- No day in week exists. + → return () Just givenWD - -> assertWeekDayIsGood givenWD gregDay - (tod, timeZone) <- rfc822time + → assertWeekDayIsGood givenWD gregDay + (tod, timeZone) ← rfc822time let lt = LocalTime gregDay tod zt = ZonedTime lt timeZone return zt -date :: Stream s m Char => ParsecT s u m Day -date = do day <- read2 - _ <- char ' ' - month <- shortMonthNameP - _ <- char ' ' - year <- read4 - _ <- char ' ' +date ∷ Parser Day +date = do day ← read2 + _ ← char ' ' + month ← shortMonthNameP + _ ← char ' ' + year ← read4 + _ ← char ' ' assertGregorianDateIsGood year month day + +-- |Convert a 'ZonedTime' to RFC 1123 date and time string. +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 " " + ⊕ showRFC822TimeZone timeZone