Data/Time/RFC1123/Internal.hs

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