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.Convertible.Base
  15 import Data.Monoid.Unicode
  16 import Data.Tagged
  17 import Data.Time
  18 import Data.Time.Calendar.WeekDate
  19 import Data.Time.HTTP.Common
  20 import Data.Time.RFC822
  21
  22 -- |Parse an RFC 1123 date and time string.
  23 rfc1123DateAndTime ∷ Parser ZonedTime
  24 rfc1123DateAndTime = dateTime
  25
  26 dateTime ∷ Parser ZonedTime
  27 dateTime = do weekDay ← optionMaybe $
  28                          do w ← shortWeekDayNameP
  29                             _ ← string ", "
  30                             return w
  31               gregDay ← date
  32               case weekDay of
  33                 Nothing
  34                     → return ()
  35                 Just givenWD
  36                     → assertWeekDayIsGood givenWD gregDay
  37               (tod, timeZone) ← rfc822Time
  38               let lt = LocalTime gregDay tod
  39                   zt = ZonedTime lt timeZone
  40               return zt
  41
  42 date ∷ Parser Day
  43 date = do day   ← read2
  44           _     ← char ' '
  45           month ← shortMonthNameP
  46           _     ← char ' '
  47           year  ← read4
  48           _     ← char ' '
  49           assertGregorianDateIsGood year month day
  50
  51 -- |Convert a 'ZonedTime' to RFC 1123 date and time string.
  52 toAsciiBuilder ∷ ZonedTime → AsciiBuilder
  53 toAsciiBuilder zonedTime
  54     = let localTime          = zonedTimeToLocalTime zonedTime
  55           timeZone           = zonedTimeZone zonedTime
  56           (year, month, day) = toGregorian (localDay localTime)
  57           (_, _, week)       = toWeekDate  (localDay localTime)
  58           timeOfDay          = localTimeOfDay localTime
  59       in
  60         shortWeekDayName week
  61         ⊕ A.toAsciiBuilder ", "
  62         ⊕ show2 day
  63         ⊕ A.toAsciiBuilder " "
  64         ⊕ shortMonthName month
  65         ⊕ A.toAsciiBuilder " "
  66         ⊕ show4 year
  67         ⊕ A.toAsciiBuilder " "
  68         ⊕ show2 (todHour timeOfDay)
  69         ⊕ A.toAsciiBuilder ":"
  70         ⊕ show2 (todMin timeOfDay)
  71         ⊕ A.toAsciiBuilder ":"
  72         ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
  73         ⊕ A.toAsciiBuilder " "
  74         ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)