module Network.HTTP.Lucu.RFC1123DateTime
    ( formatRFC1123DateTime -- CalendarTime -> String
    , formatHTTPDateTime    -- ClockTime -> String
    , parseHTTPDateTime     -- String -> Maybe ClockTime
    )
    where

import Control.Monad
import System.Time
import System.Locale
import Text.ParserCombinators.Parsec
import Text.Printf

month = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
week  = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]

formatRFC1123DateTime :: CalendarTime -> String
formatRFC1123DateTime time
    = printf "%s, %02d %s %04d %02d:%02d:%02d %s"
      (week     !! fromEnum (ctWDay  time))
      (ctDay    time)
      (month    !! fromEnum (ctMonth time))
      (ctYear   time)
      (ctHour   time)
      (ctMin    time)
      (ctSec    time)
      (ctTZName time)


formatHTTPDateTime :: ClockTime -> String
formatHTTPDateTime = formatRFC1123DateTime . (\cal -> cal { ctTZName = "GMT" }) . toUTCTime


parseHTTPDateTime :: String -> Maybe ClockTime
parseHTTPDateTime src
    = case parse httpDateTime "" src of
        Right ct  -> Just ct
        Left  err -> Nothing

httpDateTime :: Parser ClockTime
httpDateTime = do foldl (<|>) (unexpected "") (map (try . string) week)
                  char ','
                  char ' '
                  day  <- liftM read (count 2 digit)
                  char ' '
                  mon  <- foldl (<|>) (unexpected "") (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) = try $ string str >> return a