From 269a28dfe8b08af854f7217bbe9c141c9c18f1ec Mon Sep 17 00:00:00 2001 From: PHO Date: Wed, 17 Mar 2010 16:00:27 +0900 Subject: [PATCH] RFC1123 --- Data/Time/RFC1123.hs | 52 +++++++++++++++++++++++++++++++++++++ Data/Time/RFC1123/Parsec.hs | 42 ++++++++++++++++++++++++++++++ Data/Time/RFC733.hs | 2 +- Data/Time/RFC733/Parsec.hs | 6 ++--- Data/Time/RFC822.hs | 2 +- Data/Time/RFC822/Parsec.hs | 21 ++++++++------- time-http.cabal | 6 +++-- 7 files changed, 115 insertions(+), 16 deletions(-) create mode 100644 Data/Time/RFC1123.hs create mode 100644 Data/Time/RFC1123/Parsec.hs diff --git a/Data/Time/RFC1123.hs b/Data/Time/RFC1123.hs new file mode 100644 index 0000000..abb0a6d --- /dev/null +++ b/Data/Time/RFC1123.hs @@ -0,0 +1,52 @@ +module Data.Time.RFC1123 + ( format + , parse + ) + where + +import qualified Text.Parsec as P + +import Data.Time +import Data.Time.Calendar.WeekDate +import Data.Time.HTTP.Common +import Data.Time.RFC1123.Parsec + +{- + The syntax for the date is hereby changed to: + + date = 1*2DIGIT month 2*4DIGIT +-} + +format :: ZonedTime -> String +format zonedTime + = let localTime = zonedTimeToLocalTime zonedTime + timeZone = zonedTimeZone zonedTime + (year, month, day) = toGregorian (localDay localTime) + (_, _, week) = toWeekDate (localDay localTime) + timeOfDay = localTimeOfDay localTime + in + concat [ shortWeekDayName week + , ", " + , show2 day + , " " + , shortMonthName month + , " " + , show4 year + , " " + , show2 (todHour timeOfDay) + , ":" + , show2 (todMin timeOfDay) + , ":" + , show2 (floor (todSec timeOfDay)) + , " " + , show4digitsTZ timeZone + ] + +parse :: String -> Maybe ZonedTime +parse src = case P.parse p "" src of + Right zt -> Just zt + Left _ -> Nothing + where + p = do zt <- rfc1123DateAndTime + _ <- P.eof + return zt diff --git a/Data/Time/RFC1123/Parsec.hs b/Data/Time/RFC1123/Parsec.hs new file mode 100644 index 0000000..f2176cf --- /dev/null +++ b/Data/Time/RFC1123/Parsec.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE FlexibleContexts #-} +module Data.Time.RFC1123.Parsec + ( rfc1123DateAndTime + ) + where + +import Control.Monad +import Data.Fixed +import Data.Time +import Data.Time.Calendar.WeekDate +import Data.Time.HTTP.Common +import Data.Time.RFC822.Parsec +import Text.Parsec + + +rfc1123DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime +rfc1123DateAndTime = dateTime + +dateTime :: Stream s m Char => ParsecT s u m ZonedTime +dateTime = do weekDay <- optionMaybe $ + do w <- shortWeekDayNameP + _ <- string ", " + return w + gregDay <- date + case weekDay of + Nothing + -> return () -- No day in week exists. + Just givenWD + -> 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 ' ' + assertGregorianDateIsGood (toInteger year) month day diff --git a/Data/Time/RFC733.hs b/Data/Time/RFC733.hs index c7a1e6b..615ce2a 100644 --- a/Data/Time/RFC733.hs +++ b/Data/Time/RFC733.hs @@ -83,6 +83,6 @@ parse src = case P.parse p "" src of Right zt -> Just zt Left _ -> Nothing where - p = do zt <- parser + p = do zt <- rfc733DateAndTime _ <- P.eof return zt diff --git a/Data/Time/RFC733/Parsec.hs b/Data/Time/RFC733/Parsec.hs index baf2469..996c94e 100644 --- a/Data/Time/RFC733/Parsec.hs +++ b/Data/Time/RFC733/Parsec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} module Data.Time.RFC733.Parsec - ( parser + ( rfc733DateAndTime ) where @@ -12,8 +12,8 @@ import Data.Time.HTTP.Common import Text.Parsec -parser :: Stream s m Char => ParsecT s u m ZonedTime -parser = dateTime +rfc733DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime +rfc733DateAndTime = dateTime dateTime :: Stream s m Char => ParsecT s u m ZonedTime dateTime = do weekDay <- optionMaybe $ diff --git a/Data/Time/RFC822.hs b/Data/Time/RFC822.hs index c31c244..8feeb76 100644 --- a/Data/Time/RFC822.hs +++ b/Data/Time/RFC822.hs @@ -74,6 +74,6 @@ parse src = case P.parse p "" src of Right zt -> Just zt Left _ -> Nothing where - p = do zt <- parser + p = do zt <- rfc822DateAndTime _ <- P.eof return zt diff --git a/Data/Time/RFC822/Parsec.hs b/Data/Time/RFC822/Parsec.hs index 138b9a4..0c6762e 100644 --- a/Data/Time/RFC822/Parsec.hs +++ b/Data/Time/RFC822/Parsec.hs @@ -1,6 +1,9 @@ {-# LANGUAGE FlexibleContexts #-} module Data.Time.RFC822.Parsec - ( parser + ( rfc822DateAndTime + + -- private + , rfc822time ) where @@ -12,8 +15,8 @@ import Data.Time.HTTP.Common import Text.Parsec -parser :: Stream s m Char => ParsecT s u m ZonedTime -parser = dateTime +rfc822DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime +rfc822DateAndTime = dateTime dateTime :: Stream s m Char => ParsecT s u m ZonedTime dateTime = do weekDay <- optionMaybe $ @@ -26,7 +29,7 @@ dateTime = do weekDay <- optionMaybe $ -> return () -- No day in week exists. Just givenWD -> assertWeekDayIsGood givenWD gregDay - (tod, timeZone) <- time + (tod, timeZone) <- rfc822time let lt = LocalTime gregDay tod zt = ZonedTime lt timeZone return zt @@ -40,11 +43,11 @@ date = do day <- read2 _ <- char ' ' assertGregorianDateIsGood (toInteger year) month day -time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone) -time = do tod <- hour - _ <- char ' ' - tz <- zone - return (tod, tz) +rfc822time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone) +rfc822time = do tod <- hour + _ <- char ' ' + tz <- zone + return (tod, tz) hour :: Stream s m Char => ParsecT s u m TimeOfDay hour = do hour <- read2 diff --git a/time-http.cabal b/time-http.cabal index cfdc663..aeef0f6 100644 --- a/time-http.cabal +++ b/time-http.cabal @@ -21,10 +21,12 @@ Source-Repository head Library Exposed-modules: - Data.Time.RFC822 - Data.Time.RFC822.Parsec Data.Time.RFC733 Data.Time.RFC733.Parsec + Data.Time.RFC822 + Data.Time.RFC822.Parsec + Data.Time.RFC1123 + Data.Time.RFC1123.Parsec Other-modules: Data.Time.HTTP.Common -- 2.40.0