+-- |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 Data.Time
+import Data.Time.Calendar.WeekDate
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import Network.HTTP.Lucu.Format
+import Network.HTTP.Lucu.Parser
+import Prelude hiding (min)
-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)
+monthStr :: [String]
+monthStr = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
+weekStr :: [String]
+weekStr = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
-formatHTTPDateTime :: ClockTime -> String
-formatHTTPDateTime = formatRFC1123DateTime . (\cal -> cal { ctTZName = "GMT" }) . toUTCTime
+-- |Format a 'System.Time.CalendarTime' to RFC 1123 Date and Time
+-- string.
+formatRFC1123DateTime :: ZonedTime -> String
+formatRFC1123DateTime zonedTime
+ = let localTime = zonedTimeToLocalTime zonedTime
+ timeZone = zonedTimeZone zonedTime
+ (year, month, day) = toGregorian (localDay localTime)
+ (_, _, week) = toWeekDate (localDay localTime)
+ timeOfDay = localTimeOfDay localTime
+ in
+ id (weekStr !! (week - 1))
+ ++ ", " ++
+ fmtDec 2 day
+ ++ " " ++
+ id (monthStr !! (month - 1))
+ ++ " " ++
+ fmtDec 4 (fromInteger year)
+ ++ " " ++
+ fmtDec 2 (todHour timeOfDay)
+ ++ ":" ++
+ fmtDec 2 (todMin timeOfDay)
+ ++ ":" ++
+ fmtDec 2 (floor (todSec timeOfDay))
+ ++ " " ++
+ id (timeZoneName timeZone)
+
+-- |Format a 'System.Time.ClockTime' to HTTP Date and Time. Time zone
+-- will be always UTC but prints as GMT.
+formatHTTPDateTime :: UTCTime -> String
+formatHTTPDateTime utcTime
+ = let timeZone = TimeZone 0 False "GMT"
+ zonedTime = utcToZonedTime timeZone utcTime
+ in
+ formatRFC1123DateTime zonedTime
-parseHTTPDateTime :: String -> Maybe ClockTime
+
+-- |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 :: Lazy.ByteString -> Maybe UTCTime
parseHTTPDateTime src
- = case parse httpDateTime "" src of
- Right ct -> Just ct
- Left err -> Nothing
+ = case parse httpDateTime src of
+ (# Success ct, _ #) -> Just ct
+ (# _ , _ #) -> Nothing
+
-httpDateTime :: Parser ClockTime
-httpDateTime = do foldl (<|>) (unexpected "") (map (try . string) week)
- char ','
- char ' '
+httpDateTime :: Parser UTCTime
+httpDateTime = do _ <- foldl (<|>) failP (map string weekStr)
+ _ <- char ','
+ _ <- char ' '
day <- liftM read (count 2 digit)
- char ' '
- mon <- foldl (<|>) (unexpected "") (map tryEqToFst (zip month [1..]))
- char ' '
+ _ <- char ' '
+ mon <- foldl (<|>) failP (map tryEqToFst (zip monthStr [1..]))
+ _ <- char ' '
year <- liftM read (count 4 digit)
- char ' '
+ _ <- char ' '
hour <- liftM read (count 2 digit)
- char ':'
+ _ <- char ':'
min <- liftM read (count 2 digit)
- char ':'
- sec <- liftM read (count 2 digit)
- char ' '
- string "GMT"
+ _ <- char ':'
+ sec <- liftM read (count 2 digit) :: Parser Int
+ _ <- 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
- }
+ let julianDay = fromGregorian year mon day
+ timeOfDay = TimeOfDay hour min (fromIntegral sec)
+ utcTime = UTCTime julianDay (timeOfDayToTime timeOfDay)
+ return utcTime
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
projects / Lucu.git / blobdiff