X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Data%2FTime%2FRFC1123%2FInternal.hs;h=9fd1e83247d55f556edc07e5fe001fbf48a0da2f;hp=b7bb6c9a3521056473d6da77c6b74cc3ed251690;hb=2371481fd02415a8a99297679c003b8c70be4f8b;hpb=82afb594c5b4254385435491700befcbea185a5d diff --git a/Data/Time/RFC1123/Internal.hs b/Data/Time/RFC1123/Internal.hs index b7bb6c9..9fd1e83 100644 --- a/Data/Time/RFC1123/Internal.hs +++ b/Data/Time/RFC1123/Internal.hs @@ -1,40 +1,74 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE + OverloadedStrings + , UnicodeSyntax + #-} +-- |Internal functions for "Data.Time.RFC1123". module Data.Time.RFC1123.Internal ( rfc1123DateAndTime + , toAsciiBuilder ) where -import Control.Monad -import Data.Fixed +import Data.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.HTTP.Common -import Data.Time.RFC822.Internal +import Data.Time.RFC822 --- |This is a parsec parser for RFC 1123 date and time strings. -rfc1123DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime +-- |Parse an RFC 1123 date and time string. +rfc1123DateAndTime ∷ Parser ZonedTime rfc1123DateAndTime = dateTime -dateTime :: Stream s m Char => ParsecT s u m 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 " " + ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)