1 {-# LANGUAGE FlexibleContexts #-}
2 module Data.Time.RFC822.Internal
12 import Data.Time.Calendar.WeekDate
13 import Data.Time.HTTP.Common
15 -- |This is a parsec parser for RFC 822 date and time strings.
16 rfc822DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime
17 rfc822DateAndTime = dateTime
19 dateTime :: Stream s m Char => ParsecT s u m ZonedTime
20 dateTime = do weekDay <- optionMaybe $
21 do w <- shortWeekDayNameP
27 -> return () -- No day in week exists.
29 -> assertWeekDayIsGood givenWD gregDay
30 (tod, timeZone) <- rfc822time
31 let lt = LocalTime gregDay tod
32 zt = ZonedTime lt timeZone
35 date :: Stream s m Char => ParsecT s u m Day
36 date = do day <- read2
38 month <- shortMonthNameP
40 year <- liftM (+ 1900) read2
42 assertGregorianDateIsGood year month day
44 rfc822time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
45 rfc822time = do tod <- hour
50 hour :: Stream s m Char => ParsecT s u m TimeOfDay
51 hour = do hour <- read2
52 minute <- char ':' >> read2
53 second <- option 0 (char ':' >> read2)
54 assertTimeOfDayIsGood hour minute second
56 zone :: Stream s m Char => ParsecT s u m TimeZone
57 zone = choice [ string "UT" >> return (TimeZone 0 False "UT" )
58 , string "GMT" >> return (TimeZone 0 False "GMT")
60 >> choice [ string "ST" >> return (TimeZone ((-5) * 60) False "EST")
61 , string "DT" >> return (TimeZone ((-4) * 60) True "EDT")
64 >> choice [ string "ST" >> return (TimeZone ((-6) * 60) False "CST")
65 , string "DT" >> return (TimeZone ((-5) * 60) True "CDT")
68 >> choice [ string "ST" >> return (TimeZone ((-7) * 60) False "MST")
69 , string "DT" >> return (TimeZone ((-6) * 60) True "MDT")
70 , return (TimeZone ((-12) * 60) False "M")
73 >> choice [ string "ST" >> return (TimeZone ((-8) * 60) False "PST")
74 , string "DT" >> return (TimeZone ((-7) * 60) True "PDT")
76 , char 'Z' >> return (TimeZone 0 False "Z")
77 , char 'A' >> return (TimeZone ((-1) * 60) False "A")
78 , char 'N' >> return (TimeZone ( 1 * 60) False "N")
79 , char 'Y' >> return (TimeZone ( 12 * 60) False "Y")