Data/Time/RFC822/Parsec.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# OPTIONS_HADDOCK prune     #-}
   3
   4 module Data.Time.RFC822.Parsec
   5     ( rfc822DateAndTime
   6
   7       -- private
   8     , rfc822time
   9     )
  10     where
  11
  12 import Control.Monad
  13 import Data.Fixed
  14 import Data.Time
  15 import Data.Time.Calendar.WeekDate
  16 import Data.Time.HTTP.Common
  17 import Text.Parsec
  18
  19 -- |This is a parsec parser for RFC 822 date and time strings.
  20 rfc822DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime
  21 rfc822DateAndTime = dateTime
  22
  23 dateTime :: Stream s m Char => ParsecT s u m ZonedTime
  24 dateTime = do weekDay <- optionMaybe $
  25                          do w <- shortWeekDayNameP
  26                             _ <- string ", "
  27                             return w
  28               gregDay <- date
  29               case weekDay of
  30                 Nothing
  31                     -> return () -- No day in week exists.
  32                 Just givenWD
  33                     -> assertWeekDayIsGood givenWD gregDay
  34               (tod, timeZone) <- rfc822time
  35               let lt = LocalTime gregDay tod
  36                   zt = ZonedTime lt timeZone
  37               return zt
  38
  39 date :: Stream s m Char => ParsecT s u m Day
  40 date = do day   <- read2
  41           _     <- char ' '
  42           month <- shortMonthNameP
  43           _     <- char ' '
  44           year  <- liftM (+ 1900) read2
  45           _     <- char ' '
  46           assertGregorianDateIsGood year month day
  47
  48 rfc822time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
  49 rfc822time = do tod <- hour
  50                 _   <- char ' '
  51                 tz  <- zone
  52                 return (tod, tz)
  53
  54 hour :: Stream s m Char => ParsecT s u m TimeOfDay
  55 hour = do hour   <- read2
  56           minute <- char ':' >> read2
  57           second <- option 0 (char ':' >> read2)
  58           assertTimeOfDayIsGood hour minute second
  59
  60 zone :: Stream s m Char => ParsecT s u m TimeZone
  61 zone = choice [ string "UT"  >> return (TimeZone 0 False "UT" )
  62               , string "GMT" >> return (TimeZone 0 False "GMT")
  63               , char 'E'
  64                 >> choice [ string "ST" >> return (TimeZone ((-5) * 60) False "EST")
  65                           , string "DT" >> return (TimeZone ((-4) * 60) True  "EDT")
  66                           ]
  67               , char 'C'
  68                 >> choice [ string "ST" >> return (TimeZone ((-6) * 60) False "CST")
  69                           , string "DT" >> return (TimeZone ((-5) * 60) True  "CDT")
  70                           ]
  71               , char 'M'
  72                 >> choice [ string "ST" >> return (TimeZone ((-7) * 60) False "MST")
  73                           , string "DT" >> return (TimeZone ((-6) * 60) True  "MDT")
  74                           , return (TimeZone ((-12) * 60) False "M")
  75                           ]
  76               , char 'P'
  77                 >> choice [ string "ST" >> return (TimeZone ((-8) * 60) False "PST")
  78                           , string "DT" >> return (TimeZone ((-7) * 60) True  "PDT")
  79                           ]
  80               , char 'Z' >> return (TimeZone 0           False "Z")
  81               , char 'A' >> return (TimeZone ((-1) * 60) False "A")
  82               , char 'N' >> return (TimeZone (  1  * 60) False "N")
  83               , char 'Y' >> return (TimeZone ( 12  * 60) False "Y")
  84               , read4digitsTZ
  85               ]