Data/Time/RFC822/Parsec.hs

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