-- |This module parses and prints RFC 1123 Date and Time string.
-- 
-- In general you don't have to use this module directly.
module Network.HTTP.Lucu.RFC1123DateTime
    ( formatRFC1123DateTime
    , formatHTTPDateTime
    , parseHTTPDateTime
    )
    where

import           Control.Monad
import           Network.HTTP.Lucu.Format
import           Network.HTTP.Lucu.Parser
import           System.Time

month :: [String]
month =  ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]

week :: [String]
week =  ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]

-- |Format a @CalendarTime@ to RFC 1123 Date and Time string.
formatRFC1123DateTime :: CalendarTime -> String
formatRFC1123DateTime time
    = time `seq`

      id       (week     !! fromEnum (ctWDay  time))
      ++ ", " ++
      fmtDec 2 (ctDay    time)
      ++ " "  ++
      id       (month    !! fromEnum (ctMonth time))
      ++ " "  ++
      fmtDec 4 (ctYear   time)
      ++ " "  ++
      fmtDec 2 (ctHour   time)
      ++ ":"  ++
      fmtDec 2 (ctMin    time)
      ++ ":"  ++
      fmtDec 2 (ctSec    time)
      ++ " "  ++
      id       (ctTZName time)
      

-- |Format a @ClockTime@ to HTTP Date and Time. Time zone will be
-- always UTC but prints as GMT.
formatHTTPDateTime :: ClockTime -> String
formatHTTPDateTime time
    = time `seq`
      formatRFC1123DateTime $! (\cal -> cal { ctTZName = "GMT" }) $! toUTCTime time

-- |Parse an HTTP Date and Time.
--
-- Limitation: RFC 2616 (HTTP\/1.1) says we must accept these three
-- formats:
--
-- * @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@
--
-- ...but currently this function only supports the RFC 1123
-- format. This is a violation of RFC 2616 so this should be fixed
-- later. What a bother!
parseHTTPDateTime :: String -> Maybe ClockTime
parseHTTPDateTime src
    = case parseStr httpDateTime src of
        (Success ct, _) -> Just ct
        _               -> Nothing


httpDateTime :: Parser ClockTime
httpDateTime = do foldl (<|>) failP (map string week)
                  char ','
                  char ' '
                  day  <- liftM read (count 2 digit)
                  char ' '
                  mon  <- foldl (<|>) failP (map tryEqToFst (zip month [1..]))
                  char ' '
                  year <- liftM read (count 4 digit)
                  char ' '
                  hour <- liftM read (count 2 digit)
                  char ':'
                  min  <- liftM read (count 2 digit)
                  char ':'
                  sec  <- liftM read (count 2 digit)
                  char ' '
                  string "GMT"
                  eof
                  return $ toClockTime $ CalendarTime {
                               ctYear    = year
                             , ctMonth   = toEnum (mon - 1)
                             , ctDay     = day
                             , ctHour    = hour
                             , ctMin     = min
                             , ctSec     = sec
                             , ctPicosec = 0
                             , ctTZ      = 0
                             , ctWDay    = undefined
                             , ctYDay    = undefined
                             , ctTZName  = undefined
                             , ctIsDST   = undefined
                             }
    where
      tryEqToFst :: (String, a) -> Parser a
      tryEqToFst (str, a) = string str >> return a