Network/HTTP/Lucu/RFC1123DateTime.hs

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