Data/Time/RFC733/Internal.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 module Data.Time.RFC733.Internal
   3     ( rfc733DateAndTime
   4     )
   5     where
   6 import Control.Monad
   7 import Data.Fixed
   8 import Data.Time
   9 import Data.Time.Calendar.WeekDate
  10 import Data.Time.HTTP.Common
  11
  12 -- |This is a parsec parser for RFC 733 date and time strings.
  13 rfc733DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime
  14 rfc733DateAndTime = dateTime
  15
  16 dateTime :: Stream s m Char => ParsecT s u m ZonedTime
  17 dateTime = do weekDay <- optionMaybe $
  18                          do w <- try longWeekDayNameP
  19                                  <|>
  20                                  shortWeekDayNameP
  21                             _ <- string ", "
  22                             return w
  23               gregDay <- date
  24               case weekDay of
  25                 Nothing
  26                     -> return ()
  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 '-' <|> char ' '
  37           month <- try longMonthNameP
  38                    <|>
  39                    shortMonthNameP
  40           _     <- char '-' <|> char ' '
  41           year  <- try read4
  42                    <|>
  43                    liftM (+ 1900) read2
  44           _     <- char ' '
  45           assertGregorianDateIsGood year month day
  46
  47 time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
  48 time = do tod <- hour
  49           _   <- char '-' <|> char ' '
  50           tz  <- zone
  51           return (tod, tz)
  52
  53 hour :: Stream s m Char => ParsecT s u m TimeOfDay
  54 hour = do hour   <- read2
  55           _      <- optional (char ':')
  56           minute <- read2
  57           second <- option 0 $
  58                     do _ <- optional (char ':')
  59                        read2
  60           assertTimeOfDayIsGood hour minute second
  61
  62 zone :: Stream s m Char => ParsecT s u m TimeZone
  63 zone = choice [ string "GMT" >> return (TimeZone 0 False "GMT")
  64               , char 'N'
  65                 >> choice [ string "ST" >> return (TimeZone ((-3) * 60 - 30) False "NST")
  66                           , return (TimeZone (1 * 60) False "N")
  67                           ]
  68               , char 'A'
  69                 >> choice [ string "ST" >> return (TimeZone ((-4) * 60) False "AST")
  70                           , string "DT" >> return (TimeZone ((-3) * 60) False "AST")
  71                           , return (TimeZone ((-1) * 60) False "A")
  72                           ]
  73               , char 'E'
  74                 >> choice [ string "ST" >> return (TimeZone ((-5) * 60) False "EST")
  75                           , string "DT" >> return (TimeZone ((-4) * 60) True  "EDT")
  76                           ]
  77               , char 'C'
  78                 >> choice [ string "ST" >> return (TimeZone ((-6) * 60) False "CST")
  79                           , string "DT" >> return (TimeZone ((-5) * 60) True  "CDT")
  80                           ]
  81               , char 'M'
  82                 >> choice [ string "ST" >> return (TimeZone ((-7) * 60) False "MST")
  83                           , string "DT" >> return (TimeZone ((-6) * 60) True  "MDT")
  84                           , return (TimeZone ((-12) * 60) False "M")
  85                           ]
  86               , char 'P'
  87                 >> choice [ string "ST" >> return (TimeZone ((-8) * 60) False "PST")
  88                           , string "DT" >> return (TimeZone ((-7) * 60) True  "PDT")
  89                           ]
  90               , char 'Y'
  91                 >> choice [ string "ST" >> return (TimeZone ((-9) * 60) False "YST")
  92                           , string "DT" >> return (TimeZone ((-8) * 60) True  "YDT")
  93                           , return (TimeZone ( 12  * 60) False "Y")
  94                           ]
  95               , char 'H'
  96                 >> choice [ string "ST" >> return (TimeZone ((-10) * 60) False "HST")
  97                           , string "DT" >> return (TimeZone (( -9) * 60) True  "HDT")
  98                           ]
  99               , char 'B'
 100                 >> choice [ string "ST" >> return (TimeZone ((-11) * 60) False "BST")
 101                           , string "DT" >> return (TimeZone ((-10) * 60) True  "BDT")
 102                           ]
 103               , char 'Z' >> return (TimeZone 0 False "Z")
 104               , read4digitsTZ
 105               ]