1 -- |This module parses and prints RFC 1123 Date and Time string.
3 -- In general you don't have to use this module directly.
4 module Network.HTTP.Lucu.RFC1123DateTime
5 ( formatRFC1123DateTime
13 import Data.Time.Calendar.WeekDate
14 import qualified Data.ByteString.Lazy as Lazy (ByteString)
15 import Network.HTTP.Lucu.Format
16 import Network.HTTP.Lucu.Parser
17 import Prelude hiding (min)
21 monthStr = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
24 weekStr = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
26 -- |Format a 'System.Time.CalendarTime' to RFC 1123 Date and Time
28 formatRFC1123DateTime :: ZonedTime -> String
29 formatRFC1123DateTime zonedTime
30 = let localTime = zonedTimeToLocalTime zonedTime
31 timeZone = zonedTimeZone zonedTime
32 (year, month, day) = toGregorian (localDay localTime)
33 (_, _, week) = toWeekDate (localDay localTime)
34 timeOfDay = localTimeOfDay localTime
36 id (weekStr !! (week - 1))
40 id (monthStr !! (month - 1))
42 fmtDec 4 (fromInteger year)
44 fmtDec 2 (todHour timeOfDay)
46 fmtDec 2 (todMin timeOfDay)
48 fmtDec 2 (floor (todSec timeOfDay))
50 id (timeZoneName timeZone)
53 -- |Format a 'System.Time.ClockTime' to HTTP Date and Time. Time zone
54 -- will be always UTC but prints as GMT.
55 formatHTTPDateTime :: UTCTime -> String
56 formatHTTPDateTime utcTime
57 = let timeZone = TimeZone 0 False "GMT"
58 zonedTime = utcToZonedTime timeZone utcTime
60 formatRFC1123DateTime zonedTime
63 -- |Parse an HTTP Date and Time.
65 -- Limitation: RFC 2616 (HTTP\/1.1) says we must accept these three
68 -- * @Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123@
70 -- * @Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036@
72 -- * @Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() format@
74 -- ...but currently this function only supports the RFC 1123
75 -- format. This is a violation of RFC 2616 so this should be fixed
76 -- later. What a bother!
77 parseHTTPDateTime :: Lazy.ByteString -> Maybe UTCTime
79 = case parse httpDateTime src of
80 (# Success ct, _ #) -> Just ct
81 (# _ , _ #) -> Nothing
84 httpDateTime :: Parser UTCTime
85 httpDateTime = do foldl (<|>) failP (map string weekStr)
88 day <- liftM read (count 2 digit)
90 mon <- foldl (<|>) failP (map tryEqToFst (zip monthStr [1..]))
92 year <- liftM read (count 4 digit)
94 hour <- liftM read (count 2 digit)
96 min <- liftM read (count 2 digit)
98 sec <- liftM read (count 2 digit) :: Parser Int
102 let julianDay = fromGregorian year mon day
103 timeOfDay = TimeOfDay hour min (fromIntegral sec)
104 utcTime = UTCTime julianDay (timeOfDayToTime timeOfDay)
107 tryEqToFst :: (String, a) -> Parser a
108 tryEqToFst (str, a) = string str >> return a