Data/Time/RFC822/Parsec.hs

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