Data/Time/RFC733/Internal.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5 module Data.Time.RFC733.Internal
   6     ( rfc733DateAndTime
   7     )
   8     where
   9 import Control.Applicative
  10 import Data.Attoparsec.Char8
  11 import Data.Time
  12 import Data.Time.HTTP.Common
  13
  14 -- |Parse RFC 733 date and time strings.
  15 rfc733DateAndTime ∷ Parser ZonedTime
  16 rfc733DateAndTime = dateTime
  17
  18 dateTime ∷ Parser ZonedTime
  19 dateTime = do weekDay ← optionMaybe $
  20                         do w ← longWeekDayNameP
  21                                <|>
  22                                shortWeekDayNameP
  23                            _ ← string ", "
  24                            return w
  25               gregDay ← date
  26               case weekDay of
  27                 Nothing
  28                     → return ()
  29                 Just givenWD
  30                     → assertWeekDayIsGood givenWD gregDay
  31               (tod, timeZone) ← time
  32               let lt = LocalTime gregDay tod
  33                   zt = ZonedTime lt timeZone
  34               return zt
  35
  36 date ∷ Parser Day
  37 date = do day   ← read2
  38           _     ← char '-' <|> char ' '
  39           month ← try longMonthNameP
  40                   <|>
  41                   shortMonthNameP
  42           _     ← char '-' <|> char ' '
  43           year  ← try read4
  44                   <|>
  45                   (+ 1900) <$> read2
  46           _     ← char ' '
  47           assertGregorianDateIsGood year month day
  48
  49 time ∷ Parser (TimeOfDay, TimeZone)
  50 time = do tod ← hms
  51           _   ← char '-' <|> char ' '
  52           tz  ← zone
  53           return (tod, tz)
  54
  55 hms ∷ Parser TimeOfDay
  56 hms = do hour   ← read2
  57          _      ← optional (char ':')
  58          minute ← read2
  59          second ← option 0 $
  60                   do _ ← optional (char ':')
  61                      read2
  62          assertTimeOfDayIsGood hour minute second
  63
  64 zone ∷ Parser TimeZone
  65 zone = choice [ string "GMT" *> return (TimeZone 0 False "GMT")
  66               , char 'N'
  67                 *> choice [ string "ST" *> return (TimeZone ((-3) * 60 - 30) False "NST")
  68                           , return (TimeZone (1 * 60) False "N")
  69                           ]
  70               , char 'A'
  71                 *> choice [ string "ST" *> return (TimeZone ((-4) * 60) False "AST")
  72                           , string "DT" *> return (TimeZone ((-3) * 60) False "AST")
  73                           , return (TimeZone ((-1) * 60) False "A")
  74                           ]
  75               , char 'E'
  76                 *> choice [ string "ST" *> return (TimeZone ((-5) * 60) False "EST")
  77                           , string "DT" *> return (TimeZone ((-4) * 60) True  "EDT")
  78                           ]
  79               , char 'C'
  80                 *> choice [ string "ST" *> return (TimeZone ((-6) * 60) False "CST")
  81                           , string "DT" *> return (TimeZone ((-5) * 60) True  "CDT")
  82                           ]
  83               , char 'M'
  84                 *> choice [ string "ST" *> return (TimeZone ((-7) * 60) False "MST")
  85                           , string "DT" *> return (TimeZone ((-6) * 60) True  "MDT")
  86                           , return (TimeZone ((-12) * 60) False "M")
  87                           ]
  88               , char 'P'
  89                 *> choice [ string "ST" *> return (TimeZone ((-8) * 60) False "PST")
  90                           , string "DT" *> return (TimeZone ((-7) * 60) True  "PDT")
  91                           ]
  92               , char 'Y'
  93                 *> choice [ string "ST" *> return (TimeZone ((-9) * 60) False "YST")
  94                           , string "DT" *> return (TimeZone ((-8) * 60) True  "YDT")
  95                           , return (TimeZone ( 12  * 60) False "Y")
  96                           ]
  97               , char 'H'
  98                 *> choice [ string "ST" *> return (TimeZone ((-10) * 60) False "HST")
  99                           , string "DT" *> return (TimeZone (( -9) * 60) True  "HDT")
 100                           ]
 101               , char 'B'
 102                 *> choice [ string "ST" *> return (TimeZone ((-11) * 60) False "BST")
 103                           , string "DT" *> return (TimeZone ((-10) * 60) True  "BDT")
 104                           ]
 105               , char 'Z' *> return (TimeZone 0 False "Z")
 106               , read4digitsTZ
 107               ]