Network/HTTP/Lucu/RFC1123DateTime.hs

   1 module Network.HTTP.Lucu.RFC1123DateTime
   2     ( formatRFC1123DateTime -- CalendarTime -> String
   3     , formatHTTPDateTime    -- ClockTime -> String
   4     , parseHTTPDateTime     -- String -> Maybe ClockTime
   5     )
   6     where
   7
   8 import Control.Monad
   9 import System.Time
  10 import System.Locale
  11 import Text.ParserCombinators.Parsec
  12 import Text.Printf
  13
  14 month = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
  15 week  = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
  16
  17 formatRFC1123DateTime :: CalendarTime -> String
  18 formatRFC1123DateTime time
  19     = printf "%s, %02d %s %04d %02d:%02d:%02d %s"
  20       (week     !! fromEnum (ctWDay  time))
  21       (ctDay    time)
  22       (month    !! fromEnum (ctMonth time))
  23       (ctYear   time)
  24       (ctHour   time)
  25       (ctMin    time)
  26       (ctSec    time)
  27       (ctTZName time)
  28
  29
  30 formatHTTPDateTime :: ClockTime -> String
  31 formatHTTPDateTime = formatRFC1123DateTime . (\cal -> cal { ctTZName = "GMT" }) . toUTCTime
  32
  33
  34 parseHTTPDateTime :: String -> Maybe ClockTime
  35 parseHTTPDateTime src
  36     = case parse httpDateTime "" src of
  37         Right ct  -> Just ct
  38         Left  err -> Nothing
  39
  40 httpDateTime :: Parser ClockTime
  41 httpDateTime = do foldl (<|>) (unexpected "") (map (try . string) week)
  42                   char ','
  43                   char ' '
  44                   day  <- liftM read (count 2 digit)
  45                   char ' '
  46                   mon  <- foldl (<|>) (unexpected "") (map tryEqToFst (zip month [1..]))
  47                   char ' '
  48                   year <- liftM read (count 4 digit)
  49                   char ' '
  50                   hour <- liftM read (count 2 digit)
  51                   char ':'
  52                   min  <- liftM read (count 2 digit)
  53                   char ':'
  54                   sec  <- liftM read (count 2 digit)
  55                   char ' '
  56                   string "GMT"
  57                   eof
  58                   return $ toClockTime $ CalendarTime {
  59                                ctYear    = year
  60                              , ctMonth   = toEnum (mon - 1)
  61                              , ctDay     = day
  62                              , ctHour    = hour
  63                              , ctMin     = min
  64                              , ctSec     = sec
  65                              , ctPicosec = 0
  66                              , ctTZ      = 0
  67                              , ctWDay    = undefined
  68                              , ctYDay    = undefined
  69                              , ctTZName  = undefined
  70                              , ctIsDST   = undefined
  71                              }
  72     where
  73       tryEqToFst :: (String, a) -> Parser a
  74       tryEqToFst (str, a) = try $ string str >> return a
  75