X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRFC1123DateTime.hs;h=4d7aa1576a1acf308b99c9e6ae4e36b3520f2a8e;hb=7b3c7c2c5be4fc05ee03008aa0af56fab798e1bb;hp=ad683a9b490478e35bad9dfcc552de544212f2e2;hpb=b340a77fa7bd051dd13a41d0a5b1ad30220bc6b6;p=Lucu.git diff --git a/Network/HTTP/Lucu/RFC1123DateTime.hs b/Network/HTTP/Lucu/RFC1123DateTime.hs index ad683a9..4d7aa15 100644 --- a/Network/HTTP/Lucu/RFC1123DateTime.hs +++ b/Network/HTTP/Lucu/RFC1123DateTime.hs @@ -1,3 +1,6 @@ +-- |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 @@ -6,33 +9,59 @@ module Network.HTTP.Lucu.RFC1123DateTime where import Control.Monad -import qualified Data.ByteString.Lazy.Char8 as B -import Data.ByteString.Lazy.Char8 (ByteString) +import Network.HTTP.Lucu.Format import Network.HTTP.Lucu.Parser import System.Time -import System.Locale -import Text.Printf -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 parseStr httpDateTime src of @@ -41,12 +70,12 @@ parseHTTPDateTime src httpDateTime :: Parser ClockTime -httpDateTime = do foldl (<|>) (fail "") (map string week) +httpDateTime = do foldl (<|>) failP (map string week) char ',' char ' ' day <- liftM read (count 2 digit) char ' ' - mon <- foldl (<|>) (fail "") (map tryEqToFst (zip month [1..])) + mon <- foldl (<|>) failP (map tryEqToFst (zip month [1..])) char ' ' year <- liftM read (count 4 digit) char ' '