X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Data%2FTime%2FFormat%2FRFC822%2FInternal.hs;fp=Data%2FTime%2FFormat%2FRFC822%2FInternal.hs;h=0000000000000000000000000000000000000000;hp=a4c3c22ba49d86506a83fe8d74eb16248f0b2258;hb=e8f778a92c4aa7c7606bb1b17dada43639543509;hpb=9e1f758b33355286df79648ffcf1f73cb414b5d9 diff --git a/Data/Time/Format/RFC822/Internal.hs b/Data/Time/Format/RFC822/Internal.hs deleted file mode 100644 index a4c3c22..0000000 --- a/Data/Time/Format/RFC822/Internal.hs +++ /dev/null @@ -1,165 +0,0 @@ -{-# LANGUAGE - FlexibleContexts - , FlexibleInstances - , MultiParamTypeClasses - , OverloadedStrings - , TemplateHaskell - , UnicodeSyntax - #-} -module Data.Time.Format.RFC822.Internal - ( RFC822 - , rfc822DateAndTime - , rfc822Time - ) - where -import Control.Applicative -import Control.Failure -import Data.Ascii (Ascii, AsciiBuilder) -import qualified Data.Ascii as A -import Data.Attoparsec.Char8 -import Data.Convertible.Base -import Data.Convertible.Utils -import Data.Monoid.Unicode -import Data.Tagged -import Data.Time -import Data.Time.Calendar.WeekDate -import Data.Time.Format.HTTP.Common -import Prelude.Unicode - --- |The phantom type for conversions between RFC 822 date and time --- strings and 'ZonedTime'. --- --- >>> convertAttempt (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc) --- Success (Tagged "Sun, 06 Nov 94 08:49:37 GMT") --- --- Note that RFC 822 has a Y2K problem so converting 'ZonedTime' whose --- gregorian year is earlier than 1900 or from 2000 onward results in --- @'ConvertBoundsException' 'Day' 'ZonedTime'@. -data RFC822 - -instance ConvertAttempt ZonedTime (Tagged RFC822 Ascii) where - {-# INLINE convertAttempt #-} - convertAttempt = ((A.fromAsciiBuilder <$>) <$>) ∘ ca - -instance ConvertAttempt ZonedTime (Tagged RFC822 AsciiBuilder) where - {-# INLINE convertAttempt #-} - convertAttempt = (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 - -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 ∷ Failure (ConvertBoundsException Day ZonedTime) f - ⇒ ZonedTime - → f AsciiBuilder -toAsciiBuilder zonedTime - = let localTime = zonedTimeToLocalTime zonedTime - timeZone = zonedTimeZone zonedTime - (year, month, day) = toGregorian (localDay localTime) - (_, _, week) = toWeekDate (localDay localTime) - timeOfDay = localTimeOfDay localTime - in - if year < 1900 ∨ year ≥ 2000 then - let minDay = fromGregorian 1900 1 1 - maxDay = fromGregorian 1999 12 31 - in - failure $ ConvertBoundsException minDay maxDay zonedTime - else - return $ - 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| TimeZone |], [t| Tagged RFC822 Ascii |]) - , ([t| TimeZone |], [t| Tagged RFC822 AsciiBuilder |]) - ]