--- /dev/null
+module Data.Time.RFC733
+ ( format
+ , parse
+ )
+ where
+
+import qualified Text.Parsec as P
+
+import Data.Time
+import Data.Time.Calendar.WeekDate
+import Data.Time.HTTP.Common
+import Data.Time.RFC733.Parsec
+
+{-
+date-time = [ day-of-week "," ] date time
+
+day-of-week = "Monday" / "Mon" / "Tuesday" / "Tue"
+ / "Wednesday" / "Wed" / "Thursday" / "Thu"
+ / "Friday" / "Fri" / "Saturday" / "Sat"
+ / "Sunday" / "Sun"
+
+date = 1*2DIGIT ["-"] month ; day month year
+ ["-"] (2DIGIT /4DIGIT) ; e.g. 20 Aug [19]77
+
+month = "January" / "Jan" / "February" / "Feb"
+ / "March" / "Mar" / "April" / "Apr"
+ / "May" / "June" / "Jun"
+ / "July" / "Jul" / "August" / "Aug"
+ / "September" / "Sep" / "October" / "Oct"
+ / "November" / "Nov" / "December" / "Dec"
+
+time = hour zone ; ANSI and Military
+ ; (seconds optional)
+
+hour = 2DIGIT [":"] 2DIGIT [ [":"] 2DIGIT ]
+ ; 0000[00] - 2359[59]
+
+zone = ( ["-"] ( "GMT" ; Relative to GMT:
+ ; North American
+ / "NST" / ; Newfoundland:-3:30
+ / "AST" / "ADT" ; Atlantic: - 4/ - 3
+ / "EST" / "EDT" ; Eastern: - 5/ - 4
+ / "CST" / "CDT" ; Central: - 6/ - 5
+ / "MST" / "MDT" ; Mountain: - 7/ - 6
+ / "PST" / "PDT" ; Pacific: - 8/ - 7
+ / "YST" / "YDT" ; Yukon: - 9/ - 8
+ / "HST" / "HDT" ; Haw/Ala -10/ - 9
+ / "BST" / "BDT" ; Bering: -11/ -10
+ 1ALPHA )) ; Military: Z = GMT;
+ ; A:-1; (J not used)
+ ; M:-12; N:+1; Y:+12
+ / ( ("+" / "-") 4DIGIT ) ; Local differential
+ ; hours/min. (HHMM)
+-}
+
+format :: ZonedTime -> String
+format zonedTime
+ = let localTime = zonedTimeToLocalTime zonedTime
+ timeZone = zonedTimeZone zonedTime
+ (year, month, day) = toGregorian (localDay localTime)
+ (_, _, week) = toWeekDate (localDay localTime)
+ timeOfDay = localTimeOfDay localTime
+ in
+ concat [ longWeekDayName week
+ , ", "
+ , show2 day
+ , "-"
+ , shortMonthName month
+ , "-"
+ , show4 year
+ , " "
+ , show2 (todHour timeOfDay)
+ , ":"
+ , show2 (todMin timeOfDay)
+ , ":"
+ , show2 (floor (todSec timeOfDay))
+ , " "
+ , showTZ timeZone
+ ]
+
+parse :: String -> Maybe ZonedTime
+parse src = case P.parse p "" src of
+ Right zt -> Just zt
+ Left _ -> Nothing
+ where
+ p = do zt <- parser
+ _ <- P.eof
+ return zt