Data/Time/RFC822/Internal.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 module Data.Time.RFC822.Internal
   3     ( rfc822DateAndTime
   4
   5       -- private
   6     , rfc822time
   7     )
   8     where
   9 import Control.Monad
  10 import Data.Fixed
  11 import Data.Time
  12 import Data.Time.Calendar.WeekDate
  13 import Data.Time.HTTP.Common
  14
  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
  18
  19 dateTime :: Stream s m Char => ParsecT s u m ZonedTime
  20 dateTime = do weekDay <- optionMaybe $
  21                          do w <- shortWeekDayNameP
  22                             _ <- string ", "
  23                             return w
  24               gregDay <- date
  25               case weekDay of
  26                 Nothing
  27                     -> return () -- No day in week exists.
  28                 Just givenWD
  29                     -> assertWeekDayIsGood givenWD gregDay
  30               (tod, timeZone) <- rfc822time
  31               let lt = LocalTime gregDay tod
  32                   zt = ZonedTime lt timeZone
  33               return zt
  34
  35 date :: Stream s m Char => ParsecT s u m Day
  36 date = do day   <- read2
  37           _     <- char ' '
  38           month <- shortMonthNameP
  39           _     <- char ' '
  40           year  <- liftM (+ 1900) read2
  41           _     <- char ' '
  42           assertGregorianDateIsGood year month day
  43
  44 rfc822time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
  45 rfc822time = do tod <- hour
  46                 _   <- char ' '
  47                 tz  <- zone
  48                 return (tod, tz)
  49
  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
  55
  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")
  59               , char 'E'
  60                 >> choice [ string "ST" >> return (TimeZone ((-5) * 60) False "EST")
  61                           , string "DT" >> return (TimeZone ((-4) * 60) True  "EDT")
  62                           ]
  63               , char 'C'
  64                 >> choice [ string "ST" >> return (TimeZone ((-6) * 60) False "CST")
  65                           , string "DT" >> return (TimeZone ((-5) * 60) True  "CDT")
  66                           ]
  67               , char 'M'
  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")
  71                           ]
  72               , char 'P'
  73                 >> choice [ string "ST" >> return (TimeZone ((-8) * 60) False "PST")
  74                           , string "DT" >> return (TimeZone ((-7) * 60) True  "PDT")
  75                           ]
  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")
  80               , read4digitsTZ
  81               ]