Data/Time/RFC822/Internal.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5 module Data.Time.RFC822.Internal
   6     ( rfc822DateAndTime
   7     , rfc822time
   8     )
   9     where
  10 import Control.Applicative
  11 import Data.Attoparsec.Char8
  12 import Data.Time
  13 import Data.Time.HTTP.Common
  14
  15 -- |Parse an RFC 822 date and time string.
  16 rfc822DateAndTime ∷ Parser ZonedTime
  17 rfc822DateAndTime = dateTime
  18
  19 dateTime ∷ Parser 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 ()
  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 ∷ Parser Day
  36 date = do day   ← read2
  37           _     ← char ' '
  38           month ← shortMonthNameP
  39           _     ← char ' '
  40           year  ← (+ 1900) <$> read2
  41           _     ← char ' '
  42           assertGregorianDateIsGood year month day
  43
  44 -- |Parse the time and time zone of an RFC 822 date and time string.
  45 rfc822time ∷ Parser (TimeOfDay, TimeZone)
  46 rfc822time = do tod ← hms
  47                 _   ← char ' '
  48                 tz  ← zone
  49                 return (tod, tz)
  50
  51 hms ∷ Parser TimeOfDay
  52 hms = do hour   ← read2
  53          minute ← char ':' *> read2
  54          second ← option 0 (char ':' *> read2)
  55          assertTimeOfDayIsGood hour minute second
  56
  57 zone ∷ Parser TimeZone
  58 zone = choice [ string "UT"  *> return (TimeZone 0 False "UT" )
  59               , string "GMT" *> return (TimeZone 0 False "GMT")
  60               , char 'E'
  61                 *> choice [ string "ST" *> return (TimeZone ((-5) * 60) False "EST")
  62                           , string "DT" *> return (TimeZone ((-4) * 60) True  "EDT")
  63                           ]
  64               , char 'C'
  65                 *> choice [ string "ST" *> return (TimeZone ((-6) * 60) False "CST")
  66                           , string "DT" *> return (TimeZone ((-5) * 60) True  "CDT")
  67                           ]
  68               , char 'M'
  69                 *> choice [ string "ST" *> return (TimeZone ((-7) * 60) False "MST")
  70                           , string "DT" *> return (TimeZone ((-6) * 60) True  "MDT")
  71                           , return (TimeZone ((-12) * 60) False "M")
  72                           ]
  73               , char 'P'
  74                 *> choice [ string "ST" *> return (TimeZone ((-8) * 60) False "PST")
  75                           , string "DT" *> return (TimeZone ((-7) * 60) True  "PDT")
  76                           ]
  77               , char 'Z' *> return (TimeZone 0           False "Z")
  78               , char 'A' *> return (TimeZone ((-1) * 60) False "A")
  79               , char 'N' *> return (TimeZone (  1  * 60) False "N")
  80               , char 'Y' *> return (TimeZone ( 12  * 60) False "Y")
  81               , read4digitsTZ
  82               ]