Data/Time/RFC822/Internal.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5 -- |Internal functions for "Data.Time.RFC822".
   6 module Data.Time.RFC822.Internal
   7     ( rfc822DateAndTime
   8     , rfc822time
   9     , showRFC822TimeZone
  10     , toAsciiBuilder
  11     )
  12     where
  13 import Control.Applicative
  14 import Data.Ascii (AsciiBuilder)
  15 import qualified Data.Ascii as A
  16 import Data.Attoparsec.Char8
  17 import Data.Monoid.Unicode
  18 import Data.Time
  19 import Data.Time.Calendar.WeekDate
  20 import Data.Time.HTTP.Common
  21 import Prelude.Unicode
  22
  23 -- |Parse an RFC 822 date and time string.
  24 rfc822DateAndTime ∷ Parser ZonedTime
  25 rfc822DateAndTime = dateTime
  26
  27 dateTime ∷ Parser ZonedTime
  28 dateTime = do weekDay ← optionMaybe $
  29                         do w ← shortWeekDayNameP
  30                            _ ← string ", "
  31                            return w
  32               gregDay ← date
  33               case weekDay of
  34                 Nothing
  35                     -> return ()
  36                 Just givenWD
  37                     -> assertWeekDayIsGood givenWD gregDay
  38               (tod, timeZone) ← rfc822time
  39               let lt = LocalTime gregDay tod
  40                   zt = ZonedTime lt timeZone
  41               return zt
  42
  43 date ∷ Parser Day
  44 date = do day   ← read2
  45           _     ← char ' '
  46           month ← shortMonthNameP
  47           _     ← char ' '
  48           year  ← (+ 1900) <$> read2
  49           _     ← char ' '
  50           assertGregorianDateIsGood year month day
  51
  52 -- |Parse the time and time zone of an RFC 822 date and time string.
  53 rfc822time ∷ Parser (TimeOfDay, TimeZone)
  54 rfc822time = do tod ← hms
  55                 _   ← char ' '
  56                 tz  ← zone
  57                 return (tod, tz)
  58
  59 hms ∷ Parser TimeOfDay
  60 hms = do hour   ← read2
  61          minute ← char ':' *> read2
  62          second ← option 0 (char ':' *> read2)
  63          assertTimeOfDayIsGood hour minute second
  64
  65 zone ∷ Parser TimeZone
  66 zone = choice [ string "UT"  *> return (TimeZone 0 False "UT" )
  67               , string "GMT" *> return (TimeZone 0 False "GMT")
  68               , char 'E'
  69                 *> choice [ string "ST" *> return (TimeZone ((-5) * 60) False "EST")
  70                           , string "DT" *> return (TimeZone ((-4) * 60) True  "EDT")
  71                           ]
  72               , char 'C'
  73                 *> choice [ string "ST" *> return (TimeZone ((-6) * 60) False "CST")
  74                           , string "DT" *> return (TimeZone ((-5) * 60) True  "CDT")
  75                           ]
  76               , char 'M'
  77                 *> choice [ string "ST" *> return (TimeZone ((-7) * 60) False "MST")
  78                           , string "DT" *> return (TimeZone ((-6) * 60) True  "MDT")
  79                           , return (TimeZone ((-12) * 60) False "M")
  80                           ]
  81               , char 'P'
  82                 *> choice [ string "ST" *> return (TimeZone ((-8) * 60) False "PST")
  83                           , string "DT" *> return (TimeZone ((-7) * 60) True  "PDT")
  84                           ]
  85               , char 'Z' *> return (TimeZone 0           False "Z")
  86               , char 'A' *> return (TimeZone ((-1) * 60) False "A")
  87               , char 'N' *> return (TimeZone (  1  * 60) False "N")
  88               , char 'Y' *> return (TimeZone ( 12  * 60) False "Y")
  89               , read4digitsTZ
  90               ]
  91
  92 -- |No need to explain.
  93 showRFC822TimeZone ∷ TimeZone → AsciiBuilder
  94 showRFC822TimeZone tz
  95     | timeZoneMinutes tz ≡ 0 = A.toAsciiBuilder "GMT"
  96     | otherwise              = show4digitsTZ tz
  97
  98 -- |Convert a 'ZonedTime' to RFC 822 date and time string.
  99 toAsciiBuilder ∷ ZonedTime → AsciiBuilder
 100 toAsciiBuilder zonedTime
 101     = let localTime          = zonedTimeToLocalTime zonedTime
 102           timeZone           = zonedTimeZone zonedTime
 103           (year, month, day) = toGregorian (localDay localTime)
 104           (_, _, week)       = toWeekDate  (localDay localTime)
 105           timeOfDay          = localTimeOfDay localTime
 106       in
 107         shortWeekDayName week
 108         ⊕ A.toAsciiBuilder ", "
 109         ⊕ show2 day
 110         ⊕ A.toAsciiBuilder " "
 111         ⊕ shortMonthName month
 112         ⊕ A.toAsciiBuilder " "
 113         ⊕ show2 (year `mod` 100)
 114         ⊕ A.toAsciiBuilder " "
 115         ⊕ show2 (todHour timeOfDay)
 116         ⊕ A.toAsciiBuilder ":"
 117         ⊕ show2 (todMin timeOfDay)
 118         ⊕ A.toAsciiBuilder ":"
 119         ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
 120         ⊕ A.toAsciiBuilder " "
 121         ⊕ showRFC822TimeZone timeZone