{-# LANGUAGE
    FlexibleInstances
  , MultiParamTypeClasses
  , OverloadedStrings
  , TemplateHaskell
  , TypeSynonymInstances
  , UnicodeSyntax
  #-}
-- |This module provides functions to parse and format HTTP\/1.1 date
-- and time strings
-- (<http://tools.ietf.org/html/rfc2616#section-3.3>).
--
-- The HTTP\/1.1 specification (RFC 2616) says that HTTP\/1.1 clients
-- and servers which parse the date value MUST accept all the
-- following formats, though they MUST only generate the RFC 1123
-- format for representing HTTP-date values in header fields:
--
-- > Sun, 06 Nov 1994 08:49:37 GMT  ; RFC 822, updated by RFC 1123
-- > Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036
-- > Sun Nov  6 08:49:37 1994       ; ANSI C's asctime() format
--
-- It also says that all HTTP date\/time stamps MUST be represented in
-- Greenwich Mean Time (GMT), without exception. For the purposes of
-- HTTP, GMT is exactly equal to UTC (Coordinated Universal
-- Time). This is indicated in the first two formats by the inclusion
-- of @\"GMT\"@ as the three-letter abbreviation for time zone, and
-- MUST be assumed when reading the asctime format.
--
-- > HTTP-date    = rfc1123-date | rfc850-date | asctime-date
-- > rfc1123-date = wkday "," SP date1 SP time SP "GMT"
-- > rfc850-date  = weekday "," SP date2 SP time SP "GMT"
-- > asctime-date = wkday SP date3 SP time SP 4DIGIT
-- > date1        = 2DIGIT SP month SP 4DIGIT
-- >                ; day month year (e.g., 02 Jun 1982)
-- > date2        = 2DIGIT "-" month "-" 2DIGIT
-- >                ; day-month-year (e.g., 02-Jun-82)
-- > date3        = month SP ( 2DIGIT | ( SP 1DIGIT ))
-- >                ; month day (e.g., Jun  2)
-- > time         = 2DIGIT ":" 2DIGIT ":" 2DIGIT
-- >                ; 00:00:00 - 23:59:59
-- > wkday        = "Mon" | "Tue" | "Wed"
-- >              | "Thu" | "Fri" | "Sat" | "Sun"
-- > weekday      = "Monday" | "Tuesday" | "Wednesday"
-- >              | "Thursday" | "Friday" | "Saturday" | "Sunday"
-- > month        = "Jan" | "Feb" | "Mar" | "Apr"
-- >              | "May" | "Jun" | "Jul" | "Aug"
-- >              | "Sep" | "Oct" | "Nov" | "Dec"
module Data.Time.Format.HTTP
    ( HTTP
    )
    where
import Control.Applicative
import Data.Ascii (Ascii, AsciiBuilder)
import qualified Data.Ascii as A
import Data.Attoparsec.Char8
import Data.Convertible.Base
import Data.Default
import Data.Tagged
import Data.Time
import Data.Time.Format.C
import Data.Time.Format.HTTP.Common
import Data.Time.Format.RFC733
import Data.Time.Format.RFC822
import Data.Time.Format.RFC1123
import Prelude.Unicode

-- |The phantom type for conversions between HTTP/1.1 date and time
-- strings and 'UTCTime'.
--
-- >>> convertSuccess (Tagged (UTCTime (ModifiedJulianDay 49662) 31777) :: Tagged HTTP UTCTime)
-- "Sun, 06 Nov 1994 08:49:37 GMT"
data HTTP

instance ConvertSuccess (Tagged HTTP UTCTime) Ascii where
    {-# INLINE convertSuccess #-}
    convertSuccess = A.fromAsciiBuilder ∘ cs

instance ConvertSuccess (Tagged HTTP UTCTime) AsciiBuilder where
    {-# INLINE convertSuccess #-}
    convertSuccess = toAsciiBuilder

instance ConvertAttempt Ascii (Tagged HTTP UTCTime) where
    {-# INLINE convertAttempt #-}
    convertAttempt = parseAttempt' def

-- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850
-- and ANSI C's asctime() formats.
--
-- This parser is even more permissive than what HTTP\/1.1 (RFC 2616)
-- specifies. That is, it accepts 2-digit years in RFC 822, omitted
-- separator symbols in RFC 850, omitted sec fields, and non-GMT time
-- zones. I believe this behavior will not cause a problem though.
instance Default (Parser (Tagged HTTP UTCTime)) where
    {-# INLINEABLE def #-}
    def = Tagged
          <$>
          choice [ (zonedTimeToUTC     ∘ untag) <$> try (def ∷ Parser (Tagged RFC1123 ZonedTime))
                 , (zonedTimeToUTC     ∘ untag) <$> try (def ∷ Parser (Tagged RFC733  ZonedTime))
                 , (zonedTimeToUTC     ∘ untag) <$> try (def ∷ Parser (Tagged RFC822  ZonedTime))
                 , (localTimeToUTC utc ∘ untag) <$>     (def ∷ Parser (Tagged C       LocalTime))
                 ]

toAsciiBuilder ∷ Tagged HTTP UTCTime → AsciiBuilder
{-# INLINEABLE toAsciiBuilder #-}
toAsciiBuilder = cs ∘ (ut2zt <$>) ∘ retag'
    where
      ut2zt ∷ UTCTime → ZonedTime
      {-# INLINE ut2zt #-}
      ut2zt = utcToZonedTime gmt

      gmt ∷ TimeZone
      {-# INLINE CONLIKE gmt #-}
      gmt = TimeZone 0 False "GMT"

      retag' ∷ Tagged τ α → Tagged RFC1123 α
      {-# INLINE retag' #-}
      retag' = retag

deriveAttempts [ ([t| Tagged HTTP UTCTime |], [t| Ascii        |])
               , ([t| Tagged HTTP UTCTime |], [t| AsciiBuilder |])
               ]