time-http-0.2: Data/Time/RFC1123/Internal.hs

{-# LANGUAGE
    OverloadedStrings
  , UnicodeSyntax
  #-}
-- |Internal functions for "Data.Time.RFC1123".
module Data.Time.RFC1123.Internal
    ( rfc1123DateAndTime
    , toAsciiBuilder
    )
    where
import Data.Ascii (AsciiBuilder)
import qualified Data.Ascii as A
import Data.Attoparsec.Char8
import Data.Monoid.Unicode
import Data.Time
import Data.Time.Calendar.WeekDate
import Data.Time.HTTP.Common
import Data.Time.RFC822.Internal hiding (toAsciiBuilder)

-- |Parse an RFC 1123 date and time string.
rfc1123DateAndTime ∷ Parser ZonedTime
rfc1123DateAndTime = dateTime

dateTime ∷ Parser ZonedTime
dateTime = do weekDay ← optionMaybe $
                         do w ← shortWeekDayNameP
                            _ ← string ", "
                            return w
              gregDay ← date
              case weekDay of
                Nothing
                    → return ()
                Just givenWD
                    → assertWeekDayIsGood givenWD gregDay
              (tod, timeZone) ← rfc822time
              let lt = LocalTime gregDay tod
                  zt = ZonedTime lt timeZone
              return zt

date ∷ Parser Day
date = do day   ← read2
          _     ← char ' '
          month ← shortMonthNameP
          _     ← char ' '
          year  ← read4
          _     ← char ' '
          assertGregorianDateIsGood year month day

-- |Convert a 'ZonedTime' to RFC 1123 date and time string.
toAsciiBuilder ∷ ZonedTime → AsciiBuilder
toAsciiBuilder zonedTime
    = let localTime          = zonedTimeToLocalTime zonedTime
          timeZone           = zonedTimeZone zonedTime
          (year, month, day) = toGregorian (localDay localTime)
          (_, _, week)       = toWeekDate  (localDay localTime)
          timeOfDay          = localTimeOfDay localTime
      in
        shortWeekDayName week
        ⊕ A.toAsciiBuilder ", "
        ⊕ show2 day
        ⊕ A.toAsciiBuilder " "
        ⊕ shortMonthName month
        ⊕ A.toAsciiBuilder " "
        ⊕ show4 year
        ⊕ A.toAsciiBuilder " "
        ⊕ show2 (todHour timeOfDay)
        ⊕ A.toAsciiBuilder ":"
        ⊕ show2 (todMin timeOfDay)
        ⊕ A.toAsciiBuilder ":"
        ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
        ⊕ A.toAsciiBuilder " "
        ⊕ showRFC822TimeZone timeZone