Data/Time/RFC1123/Internal.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5 module Data.Time.RFC1123.Internal
   6     ( rfc1123DateAndTime
   7     , toAsciiBuilder
   8     )
   9     where
  10 import Data.Ascii (AsciiBuilder)
  11 import qualified Data.Ascii as A
  12 import Data.Attoparsec.Char8
  13 import Data.Monoid.Unicode
  14 import Data.Time
  15 import Data.Time.Calendar.WeekDate
  16 import Data.Time.HTTP.Common
  17 import Data.Time.RFC822.Internal hiding (toAsciiBuilder)
  18
  19 -- |Parse an RFC 1123 date and time string.
  20 rfc1123DateAndTime ∷ Parser ZonedTime
  21 rfc1123DateAndTime = dateTime
  22
  23 dateTime ∷ Parser ZonedTime
  24 dateTime = do weekDay ← optionMaybe $
  25                          do w ← shortWeekDayNameP
  26                             _ ← string ", "
  27                             return w
  28               gregDay ← date
  29               case weekDay of
  30                 Nothing
  31                     → return ()
  32                 Just givenWD
  33                     → assertWeekDayIsGood givenWD gregDay
  34               (tod, timeZone) ← rfc822time
  35               let lt = LocalTime gregDay tod
  36                   zt = ZonedTime lt timeZone
  37               return zt
  38
  39 date ∷ Parser Day
  40 date = do day   ← read2
  41           _     ← char ' '
  42           month ← shortMonthNameP
  43           _     ← char ' '
  44           year  ← read4
  45           _     ← char ' '
  46           assertGregorianDateIsGood year month day
  47
  48 -- |Convert a 'ZonedTime' to RFC 1123 date and time string.
  49 toAsciiBuilder ∷ ZonedTime → AsciiBuilder
  50 toAsciiBuilder zonedTime
  51     = let localTime          = zonedTimeToLocalTime zonedTime
  52           timeZone           = zonedTimeZone zonedTime
  53           (year, month, day) = toGregorian (localDay localTime)
  54           (_, _, week)       = toWeekDate  (localDay localTime)
  55           timeOfDay          = localTimeOfDay localTime
  56       in
  57         shortWeekDayName week
  58         ⊕ A.toAsciiBuilder ", "
  59         ⊕ show2 day
  60         ⊕ A.toAsciiBuilder " "
  61         ⊕ shortMonthName month
  62         ⊕ A.toAsciiBuilder " "
  63         ⊕ show4 year
  64         ⊕ A.toAsciiBuilder " "
  65         ⊕ show2 (todHour timeOfDay)
  66         ⊕ A.toAsciiBuilder ":"
  67         ⊕ show2 (todMin timeOfDay)
  68         ⊕ A.toAsciiBuilder ":"
  69         ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
  70         ⊕ A.toAsciiBuilder " "
  71         ⊕ showRFC822TimeZone timeZone