-- |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           Data.Time
import           Data.Time.Calendar.WeekDate
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import           Network.HTTP.Lucu.Format
import           Network.HTTP.Lucu.Parser
import           Prelude hiding (min)


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

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

-- |Format a 'System.Time.CalendarTime' to RFC 1123 Date and Time
-- string.
formatRFC1123DateTime :: ZonedTime -> String
formatRFC1123DateTime zonedTime
    = let localTime          = zonedTimeToLocalTime zonedTime
          timeZone           = zonedTimeZone zonedTime
          (year, month, day) = toGregorian (localDay localTime)
          (_, _, week)       = toWeekDate (localDay localTime)
          timeOfDay          = localTimeOfDay localTime
      in
        id       (weekStr !! (week - 1))
        ++ ", " ++
        fmtDec 2 day
        ++ " "  ++
        id       (monthStr !! (month - 1))
        ++ " " ++
        fmtDec 4 (fromInteger year)
        ++ " " ++
        fmtDec 2 (todHour timeOfDay)
        ++ ":" ++
        fmtDec 2 (todMin timeOfDay)
        ++ ":" ++
        fmtDec 2 (floor (todSec timeOfDay))
        ++ " " ++
        id       (timeZoneName timeZone)
      

-- |Format a 'System.Time.ClockTime' to HTTP Date and Time. Time zone
-- will be always UTC but prints as GMT.
formatHTTPDateTime :: UTCTime -> String
formatHTTPDateTime utcTime
    = let timeZone  = TimeZone 0 False "GMT"
          zonedTime = utcToZonedTime timeZone utcTime
      in
        formatRFC1123DateTime zonedTime


-- |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 :: Lazy.ByteString -> Maybe UTCTime
parseHTTPDateTime src
    = case parse httpDateTime src of
        (# Success ct, _ #) -> Just ct
        (# _         , _ #) -> Nothing


httpDateTime :: Parser UTCTime
httpDateTime = do foldl (<|>) failP (map string weekStr)
                  char ','
                  char ' '
                  day  <- liftM read (count 2 digit)
                  char ' '
                  mon  <- foldl (<|>) failP (map tryEqToFst (zip monthStr [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) :: Parser Int
                  char ' '
                  string "GMT"
                  eof
                  let julianDay = fromGregorian year mon day
                      timeOfDay = TimeOfDay hour min (fromIntegral sec)
                      utcTime   = UTCTime julianDay (timeOfDayToTime timeOfDay)
                  return utcTime
    where
      tryEqToFst :: (String, a) -> Parser a
      tryEqToFst (str, a) = string str >> return a