Data/Time/RFC733/Internal.hs

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