X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRFC1123DateTime.hs;h=9962c16924a935aa1e28e57bc7d72dd8f310b880;hb=8e78bc83bfe67a376293c346ae0b30f1a684c787;hp=9c58e51db91048c196c6a8d54a03c1c9bf272d67;hpb=3c7a58ab749a55a30466a033b170536bcdf18b98;p=Lucu.git

diff --git a/Network/HTTP/Lucu/RFC1123DateTime.hs b/Network/HTTP/Lucu/RFC1123DateTime.hs
index 9c58e51..9962c16 100644
--- a/Network/HTTP/Lucu/RFC1123DateTime.hs
+++ b/Network/HTTP/Lucu/RFC1123DateTime.hs
@@ -1,49 +1,81 @@
+-- |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 -- CalendarTime -> String
-    , formatHTTPDateTime    -- ClockTime -> String
-    , parseHTTPDateTime     -- String -> Maybe ClockTime
+    ( formatRFC1123DateTime
+    , formatHTTPDateTime
+    , parseHTTPDateTime
     )
     where
 
-import Control.Monad
-import System.Time
-import System.Locale
-import Text.ParserCombinators.Parsec
-import Text.Printf
+import           Control.Monad
+import           Network.HTTP.Lucu.Format
+import           Network.HTTP.Lucu.Parser
+import           System.Time
 
-month = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
-week  = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
+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
-    = 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)
+    = 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 = formatRFC1123DateTime . (\cal -> cal { ctTZName = "GMT" }) . toUTCTime
-
+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 parse httpDateTime "" src of
-        Right ct  -> Just ct
-        Left  err -> Nothing
+    = case parseStr httpDateTime src of
+        (Success ct, _) -> Just ct
+        _               -> Nothing
+
 
 httpDateTime :: Parser ClockTime
-httpDateTime = do foldl (<|>) (unexpected "") (map (try . string) week)
+httpDateTime = do foldl (<|>) (fail "") (map string week)
                   char ','
                   char ' '
                   day  <- liftM read (count 2 digit)
                   char ' '
-                  mon  <- foldl (<|>) (unexpected "") (map tryEqToFst (zip month [1..]))
+                  mon  <- foldl (<|>) (fail "") (map tryEqToFst (zip month [1..]))
                   char ' '
                   year <- liftM read (count 4 digit)
                   char ' '
@@ -71,5 +103,5 @@ httpDateTime = do foldl (<|>) (unexpected "") (map (try . string) week)
                              }
     where
       tryEqToFst :: (String, a) -> Parser a
-      tryEqToFst (str, a) = try $ string str >> return a
+      tryEqToFst (str, a) = string str >> return a
       
\ No newline at end of file