From: PHO Date: Sun, 11 Dec 2011 08:26:45 +0000 (+0900) Subject: RFC822 X-Git-Tag: RELEASE-0.3~1^2~8 X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=2371481;p=time-http.git RFC822 Ditz-issue: 0a3272772c73cf31486eb2b6691fa38232d3c4c5 --- diff --git a/Data/Time/RFC1123/Internal.hs b/Data/Time/RFC1123/Internal.hs index 4ae25b7..9fd1e83 100644 --- a/Data/Time/RFC1123/Internal.hs +++ b/Data/Time/RFC1123/Internal.hs @@ -11,11 +11,13 @@ module Data.Time.RFC1123.Internal 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 hiding (toAsciiBuilder) +import Data.Time.RFC822 -- |Parse an RFC 1123 date and time string. rfc1123DateAndTime ∷ Parser ZonedTime @@ -32,7 +34,7 @@ dateTime = do weekDay ← optionMaybe $ → return () Just givenWD → assertWeekDayIsGood givenWD gregDay - (tod, timeZone) ← rfc822time + (tod, timeZone) ← rfc822Time let lt = LocalTime gregDay tod zt = ZonedTime lt timeZone return zt @@ -69,4 +71,4 @@ toAsciiBuilder zonedTime ⊕ A.toAsciiBuilder ":" ⊕ show2 (floor (todSec timeOfDay) ∷ Int) ⊕ A.toAsciiBuilder " " - ⊕ showRFC822TimeZone timeZone + ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder) diff --git a/Data/Time/RFC733.hs b/Data/Time/RFC733.hs index e6981af..a6eb286 100644 --- a/Data/Time/RFC733.hs +++ b/Data/Time/RFC733.hs @@ -58,7 +58,7 @@ import Data.Monoid.Unicode import Data.Tagged import Data.Time import Data.Time.Calendar.WeekDate -import Data.Time.RFC822.Internal hiding (toAsciiBuilder) +import Data.Time.RFC822 import Data.Time.HTTP.Common import Prelude.Unicode @@ -193,7 +193,7 @@ toAsciiBuilder zonedTime ⊕ A.toAsciiBuilder ":" ⊕ show2 (floor (todSec timeOfDay) ∷ Int) ⊕ A.toAsciiBuilder " " - ⊕ showRFC822TimeZone timeZone + ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder) deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC733 Ascii |]) , ([t| ZonedTime |], [t| Tagged RFC733 AsciiBuilder |]) diff --git a/Data/Time/RFC822.hs b/Data/Time/RFC822.hs index 152d992..a5c1a0b 100644 --- a/Data/Time/RFC822.hs +++ b/Data/Time/RFC822.hs @@ -1,5 +1,9 @@ {-# LANGUAGE - UnicodeSyntax + FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings + , TemplateHaskell + , UnicodeSyntax #-} -- |This module provides functions to parse and format RFC 822 date -- and time formats. @@ -31,31 +35,143 @@ -- > | "Y" ; +12 -- > | ("+" | "-") 4DIGIT ; Local diff: HHMM module Data.Time.RFC822 - ( -- * Formatting - toAscii - , toAsciiBuilder - - -- * Parsing - , fromAscii + ( RFC822 , rfc822DateAndTime + , rfc822Time ) where -import Data.Ascii (Ascii) +import Control.Applicative +import Data.Ascii (Ascii, AsciiBuilder) import qualified Data.Ascii as A -import qualified Data.Attoparsec.Char8 as P +import Data.Attoparsec.Char8 +import Data.Convertible.Base +import Data.Monoid.Unicode +import Data.Tagged import Data.Time -import Data.Time.RFC822.Internal +import Data.Time.Calendar.WeekDate +import Data.Time.HTTP.Common import Prelude.Unicode --- |Convert a 'ZonedTime' to RFC 822 date and time string. -toAscii ∷ ZonedTime → Ascii -toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder +-- |FIXME: docs +data RFC822 --- |Parse an RFC 822 date and time string. When the string can't be --- parsed, it returns @'Left' err@. -fromAscii ∷ Ascii → Either String ZonedTime -fromAscii = P.parseOnly p ∘ A.toByteString - where - p = do zt ← rfc822DateAndTime - P.endOfInput - return zt +instance ConvertSuccess ZonedTime (Tagged RFC822 Ascii) where + {-# INLINE convertSuccess #-} + convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs + +instance ConvertSuccess ZonedTime (Tagged RFC822 AsciiBuilder) where + {-# INLINE convertSuccess #-} + convertSuccess = Tagged ∘ toAsciiBuilder + +instance ConvertSuccess TimeZone (Tagged RFC822 Ascii) where + {-# INLINE convertSuccess #-} + convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs + +instance ConvertSuccess TimeZone (Tagged RFC822 AsciiBuilder) where + {-# INLINE convertSuccess #-} + convertSuccess tz + | timeZoneMinutes tz ≡ 0 = Tagged $ A.toAsciiBuilder "GMT" + | otherwise = Tagged $ show4digitsTZ tz + +instance ConvertAttempt (Tagged RFC822 Ascii) ZonedTime where + {-# INLINE convertAttempt #-} + convertAttempt = parseAttempt' rfc822DateAndTime ∘ untag + +-- |Parse an RFC 822 date and time string. +rfc822DateAndTime ∷ Parser ZonedTime +rfc822DateAndTime = 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 ← (+ 1900) <$> read2 + _ ← char ' ' + assertGregorianDateIsGood year month day + +-- |Parse the time and time zone of an RFC 822 date and time string. +rfc822Time ∷ Parser (TimeOfDay, TimeZone) +rfc822Time = do tod ← hms + _ ← char ' ' + tz ← zone + return (tod, tz) + +hms ∷ Parser TimeOfDay +hms = do hour ← read2 + minute ← char ':' *> read2 + second ← option 0 (char ':' *> read2) + assertTimeOfDayIsGood hour minute second + +zone ∷ Parser TimeZone +zone = choice [ string "UT" *> return (TimeZone 0 False "UT" ) + , string "GMT" *> return (TimeZone 0 False "GMT") + , char 'E' + *> choice [ string "ST" *> return (TimeZone ((-5) * 60) False "EST") + , string "DT" *> return (TimeZone ((-4) * 60) True "EDT") + ] + , char 'C' + *> choice [ string "ST" *> return (TimeZone ((-6) * 60) False "CST") + , string "DT" *> return (TimeZone ((-5) * 60) True "CDT") + ] + , char 'M' + *> choice [ string "ST" *> return (TimeZone ((-7) * 60) False "MST") + , string "DT" *> return (TimeZone ((-6) * 60) True "MDT") + , return (TimeZone ((-12) * 60) False "M") + ] + , char 'P' + *> choice [ string "ST" *> return (TimeZone ((-8) * 60) False "PST") + , string "DT" *> return (TimeZone ((-7) * 60) True "PDT") + ] + , char 'Z' *> return (TimeZone 0 False "Z") + , char 'A' *> return (TimeZone ((-1) * 60) False "A") + , char 'N' *> return (TimeZone ( 1 * 60) False "N") + , char 'Y' *> return (TimeZone ( 12 * 60) False "Y") + , read4digitsTZ + ] + +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 " " + ⊕ show2 (year `mod` 100) + ⊕ 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 RFC822 Ascii |]) + , ([t| ZonedTime |], [t| Tagged RFC822 AsciiBuilder |]) + , ([t| TimeZone |], [t| Tagged RFC822 Ascii |]) + , ([t| TimeZone |], [t| Tagged RFC822 AsciiBuilder |]) + ] diff --git a/Data/Time/RFC822/Internal.hs b/Data/Time/RFC822/Internal.hs deleted file mode 100644 index 607cf88..0000000 --- a/Data/Time/RFC822/Internal.hs +++ /dev/null @@ -1,121 +0,0 @@ -{-# LANGUAGE - OverloadedStrings - , UnicodeSyntax - #-} --- |Internal functions for "Data.Time.RFC822". -module Data.Time.RFC822.Internal - ( rfc822DateAndTime - , rfc822time - , showRFC822TimeZone - , toAsciiBuilder - ) - where -import Control.Applicative -import Data.Ascii (AsciiBuilder) -import qualified Data.Ascii as A -import Data.Attoparsec.Char8 -import Data.Monoid.Unicode -import Data.Time -import Data.Time.Calendar.WeekDate -import Data.Time.HTTP.Common -import Prelude.Unicode - --- |Parse an RFC 822 date and time string. -rfc822DateAndTime ∷ Parser ZonedTime -rfc822DateAndTime = 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 ← (+ 1900) <$> read2 - _ ← char ' ' - assertGregorianDateIsGood year month day - --- |Parse the time and time zone of an RFC 822 date and time string. -rfc822time ∷ Parser (TimeOfDay, TimeZone) -rfc822time = do tod ← hms - _ ← char ' ' - tz ← zone - return (tod, tz) - -hms ∷ Parser TimeOfDay -hms = do hour ← read2 - minute ← char ':' *> read2 - second ← option 0 (char ':' *> read2) - assertTimeOfDayIsGood hour minute second - -zone ∷ Parser TimeZone -zone = choice [ string "UT" *> return (TimeZone 0 False "UT" ) - , string "GMT" *> return (TimeZone 0 False "GMT") - , char 'E' - *> choice [ string "ST" *> return (TimeZone ((-5) * 60) False "EST") - , string "DT" *> return (TimeZone ((-4) * 60) True "EDT") - ] - , char 'C' - *> choice [ string "ST" *> return (TimeZone ((-6) * 60) False "CST") - , string "DT" *> return (TimeZone ((-5) * 60) True "CDT") - ] - , char 'M' - *> choice [ string "ST" *> return (TimeZone ((-7) * 60) False "MST") - , string "DT" *> return (TimeZone ((-6) * 60) True "MDT") - , return (TimeZone ((-12) * 60) False "M") - ] - , char 'P' - *> choice [ string "ST" *> return (TimeZone ((-8) * 60) False "PST") - , string "DT" *> return (TimeZone ((-7) * 60) True "PDT") - ] - , char 'Z' *> return (TimeZone 0 False "Z") - , char 'A' *> return (TimeZone ((-1) * 60) False "A") - , char 'N' *> return (TimeZone ( 1 * 60) False "N") - , char 'Y' *> return (TimeZone ( 12 * 60) False "Y") - , read4digitsTZ - ] - --- |No need to explain. -showRFC822TimeZone ∷ TimeZone → AsciiBuilder -showRFC822TimeZone tz - | timeZoneMinutes tz ≡ 0 = A.toAsciiBuilder "GMT" - | otherwise = show4digitsTZ tz - --- |Convert a 'ZonedTime' to RFC 822 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 " " - ⊕ show2 (year `mod` 100) - ⊕ A.toAsciiBuilder " " - ⊕ show2 (todHour timeOfDay) - ⊕ A.toAsciiBuilder ":" - ⊕ show2 (todMin timeOfDay) - ⊕ A.toAsciiBuilder ":" - ⊕ show2 (floor (todSec timeOfDay) ∷ Int) - ⊕ A.toAsciiBuilder " " - ⊕ showRFC822TimeZone timeZone diff --git a/time-http.cabal b/time-http.cabal index bd7072c..46d18cc 100644 --- a/time-http.cabal +++ b/time-http.cabal @@ -36,7 +36,6 @@ Library Data.Time.HTTP.Common Data.Time.HTTP.Internal Data.Time.RFC1123.Internal - Data.Time.RFC822.Internal Build-depends: ascii == 0.0.*,