time-http (empty) → 0.1
raw patch · 14 files changed
+1018/−0 lines, 14 filesdep +basedep +parsecdep +timesetup-changed
Dependencies added: base, parsec, time
Files
- COPYING +29/−0
- Data/Time/Asctime.hs +65/−0
- Data/Time/Asctime/Parsec.hs +34/−0
- Data/Time/HTTP.hs +75/−0
- Data/Time/HTTP/Common.hs +276/−0
- Data/Time/HTTP/Parsec.hs +21/−0
- Data/Time/RFC1123.hs +61/−0
- Data/Time/RFC1123/Parsec.hs +42/−0
- Data/Time/RFC733.hs +88/−0
- Data/Time/RFC733/Parsec.hs +107/−0
- Data/Time/RFC822.hs +88/−0
- Data/Time/RFC822/Parsec.hs +85/−0
- Setup.hs +3/−0
- time-http.cabal +44/−0
+ COPYING view
@@ -0,0 +1,29 @@+<!-- -*- xml -*-++time-http はパブリックドメインに在ります。+time-http is in the public domain.++See http://creativecommons.org/licenses/publicdomain/++-->++<rdf:RDF xmlns="http://web.resource.org/cc/"+ xmlns:dc="http://purl.org/dc/elements/1.1/"+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">+ <Work rdf:about="http://cielonegro.org/HTTPDateTime.html">+ <dc:title>time-http</dc:title>+ <dc:rights>+ <Agent>+ <dc:title>PHO</dc:title>+ </Agent>+ </dc:rights>+ <license rdf:resource="http://web.resource.org/cc/PublicDomain" />+ </Work>++ <License rdf:about="http://web.resource.org/cc/PublicDomain">+ <permits rdf:resource="http://web.resource.org/cc/Reproduction" />+ <permits rdf:resource="http://web.resource.org/cc/Distribution" />+ <permits rdf:resource="http://web.resource.org/cc/DerivativeWorks" />+ </License>++</rdf:RDF>
+ Data/Time/Asctime.hs view
@@ -0,0 +1,65 @@+-- |This module provides functions for ANSI C's asctime() format.+--+-- ANSI C's asctime() format looks like:+--+-- @Wdy Mon DD HH:MM:SS YYYY@+--+-- The exact syntax is as follows:+--+-- > date-time ::= wday SP month SP day SP time SP year+-- > wday ::= "Mon" | "Tue" | "Wed" | "Thu"+-- > | "Fri" | "Sat" | "Sun"+-- > month ::= "Jan" | "Feb" | "Mar" | "Apr"+-- > | "May" | "Jun" | "Jul" | "Aug"+-- > | "Sep" | "Oct" | "Nov" | "Dec"+-- > day ::= 2DIGIT+-- > time ::= 2DIGIT ':' 2DIGIT [':' 2DIGIT]+-- > year ::= 4DIGIT+--+-- As you can see, it has no time zone info. "Data.Time.HTTP" will+-- treat it as UTC.+module Data.Time.Asctime+ ( 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.Asctime.Parsec++-- |Format a 'LocalTime' in the ANSI C's asctime() way.+format :: LocalTime -> String+format localTime+ = let (year, month, day) = toGregorian (localDay localTime)+ (_, _, week) = toWeekDate (localDay localTime)+ timeOfDay = localTimeOfDay localTime+ in+ concat [ shortWeekDayName week+ , ", "+ , shortMonthName month+ , " "+ , show2 day+ , " "+ , show2 (todHour timeOfDay)+ , ":"+ , show2 (todMin timeOfDay)+ , ":"+ , show2 (floor (todSec timeOfDay))+ , " "+ , show4 year+ ]++-- |Parse an ANSI C's asctime() format to 'LocalTime'. When the string+-- can't be parsed, it returns 'Nothing'.+parse :: String -> Maybe LocalTime+parse src = case P.parse p "" src of+ Right zt -> Just zt+ Left _ -> Nothing+ where+ p = do zt <- asctime+ _ <- P.eof+ return zt
+ Data/Time/Asctime/Parsec.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleContexts #-}+module Data.Time.Asctime.Parsec+ ( asctime+ )+ where++import Control.Monad+import Data.Fixed+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.HTTP.Common+import Text.Parsec++-- |This is a parsec parser for ANSI C's asctime() format.+asctime :: Stream s m Char => ParsecT s u m LocalTime+asctime = do weekDay <- shortWeekDayNameP+ _ <- string ", "+ month <- shortMonthNameP+ _ <- char ' '+ day <- read2+ _ <- char ' '+ hour <- read2+ _ <- char ':'+ minute <- read2+ _ <- char ':'+ second <- read2+ _ <- char ' '+ year <- read4++ gregDay <- assertGregorianDateIsGood year month day+ _ <- assertWeekDayIsGood weekDay gregDay+ tod <- assertTimeOfDayIsGood hour minute second++ return (LocalTime gregDay tod)
+ Data/Time/HTTP.hs view
@@ -0,0 +1,75 @@+-- |This module provides functions to parse and format HTTP\/1.1 date+-- and time formats.+--+-- The HTTP\/1.1 specification (RFC 2616) says that HTTP\/1.1 clients+-- and servers which parse the date value MUST accept all the+-- following formats, though they MUST only generate the RFC 1123+-- format for representing HTTP-date values in header fields:+--+-- > 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+--+-- It also says that all HTTP date\/time stamps MUST be represented in+-- Greenwich Mean Time (GMT), without exception. For the purposes of+-- HTTP, GMT is exactly equal to UTC (Coordinated Universal+-- Time). This is indicated in the first two formats by the inclusion+-- of @\"GMT\"@ as the three-letter abbreviation for time zone, and+-- MUST be assumed when reading the asctime format.+--+-- > HTTP-date = rfc1123-date | rfc850-date | asctime-date+-- > rfc1123-date = wkday "," SP date1 SP time SP "GMT"+-- > rfc850-date = weekday "," SP date2 SP time SP "GMT"+-- > asctime-date = wkday SP date3 SP time SP 4DIGIT+-- > date1 = 2DIGIT SP month SP 4DIGIT+-- > ; day month year (e.g., 02 Jun 1982)+-- > date2 = 2DIGIT "-" month "-" 2DIGIT+-- > ; day-month-year (e.g., 02-Jun-82)+-- > date3 = month SP ( 2DIGIT | ( SP 1DIGIT ))+-- > ; month day (e.g., Jun 2)+-- > time = 2DIGIT ":" 2DIGIT ":" 2DIGIT+-- > ; 00:00:00 - 23:59:59+-- > wkday = "Mon" | "Tue" | "Wed"+-- > | "Thu" | "Fri" | "Sat" | "Sun"+-- > weekday = "Monday" | "Tuesday" | "Wednesday"+-- > | "Thursday" | "Friday" | "Saturday" | "Sunday"+-- > month = "Jan" | "Feb" | "Mar" | "Apr"+-- > | "May" | "Jun" | "Jul" | "Aug"+-- > | "Sep" | "Oct" | "Nov" | "Dec"+module Data.Time.HTTP+ ( format+ , parse+ )+ where++import qualified Data.Time.RFC1123 as RFC1123+import qualified Text.Parsec as P++import Data.Time+import Data.Time.HTTP.Parsec++-- |Format an 'UTCTime' in RFC 1123 date and time.+format :: UTCTime -> String+format utcTime+ = let timeZone = TimeZone 0 False "GMT"+ zonedTime = utcToZonedTime timeZone utcTime+ in+ RFC1123.format zonedTime++-- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850+-- and ANSI C's asctime() formats. When the string can't be parsed, it+-- returns 'Nothing'.+--+-- This function is even more permissive than what HTTP\/1.1+-- specifies. That is, it accepts 2-digit years in RFC 822, omitted+-- separator symbols in RFC 850, omitted sec fields, and non-GMT time+-- zones. I believe this behavior will not cause a problem but you+-- should know this.+parse :: String -> Maybe UTCTime+parse src = case P.parse p "" src of+ Right ut -> Just ut+ Left _ -> Nothing+ where+ p = do zt <- rfc2616DateAndTime+ _ <- P.eof+ return zt
+ Data/Time/HTTP/Common.hs view
@@ -0,0 +1,276 @@+{-# LANGUAGE FlexibleContexts #-}+module Data.Time.HTTP.Common+ ( shortWeekDayName+ , shortWeekDayNameP++ , longWeekDayName+ , longWeekDayNameP++ , shortMonthName+ , shortMonthNameP++ , longMonthName+ , longMonthNameP++ , show2+ , show4++ , read2+ , read4++ , show4digitsTZ+ , read4digitsTZ++ , assertWeekDayIsGood+ , assertGregorianDateIsGood+ , assertTimeOfDayIsGood+ )+ where++import Control.Monad+import Data.Fixed+import Data.Time+import Data.Time.Calendar.WeekDate+import Text.Parsec++shortWeekDayName :: Int -> String+shortWeekDayName 1 = "Mon"+shortWeekDayName 2 = "Tue"+shortWeekDayName 3 = "Wed"+shortWeekDayName 4 = "Thu"+shortWeekDayName 5 = "Fri"+shortWeekDayName 6 = "Sat"+shortWeekDayName 7 = "Sun"+shortWeekDayName n = error ("shortWeekDayName: unknown day number: " ++ show n)++shortWeekDayNameP :: Stream s m Char => ParsecT s u m Int+shortWeekDayNameP+ = choice [ string "Mon" >> return 1+ , char 'T'+ >> choice [ string "ue" >> return 2+ , string "hu" >> return 4+ ]+ , string "Wed" >> return 3+ , string "Fri" >> return 5+ , char 'S'+ >> choice [ string "at" >> return 6+ , string "un" >> return 7+ ]+ ]++longWeekDayName :: Int -> String+longWeekDayName 1 = "Monday"+longWeekDayName 2 = "Tuesday"+longWeekDayName 3 = "Wednesday"+longWeekDayName 4 = "Thursday"+longWeekDayName 5 = "Friday"+longWeekDayName 6 = "Saturday"+longWeekDayName 7 = "Sunday"++longWeekDayNameP :: Stream s m Char => ParsecT s u m Int+longWeekDayNameP+ = choice [ string "Monday" >> return 1+ , char 'T'+ >> choice [ string "uesday" >> return 2+ , string "hursday" >> return 4+ ]+ , string "Wednesday" >> return 3+ , string "Friday" >> return 5+ , char 'S'+ >> choice [ string "aturday" >> return 6+ , string "unday" >> return 7+ ]+ ]++shortMonthName :: Int -> String+shortMonthName 1 = "Jan"+shortMonthName 2 = "Feb"+shortMonthName 3 = "Mar"+shortMonthName 4 = "Apr"+shortMonthName 5 = "May"+shortMonthName 6 = "Jun"+shortMonthName 7 = "Jul"+shortMonthName 8 = "Aug"+shortMonthName 9 = "Sep"+shortMonthName 10 = "Oct"+shortMonthName 11 = "Nov"+shortMonthName 12 = "Dec"+shortMonthName n = error ("shortMonthName: unknown month number: " ++ show n)++shortMonthNameP :: Stream s m Char => ParsecT s u m Int+shortMonthNameP+ = choice [ char 'J'+ >> choice [ string "an" >> return 1+ , char 'u'+ >> choice [ char 'n' >> return 6+ , char 'l' >> return 7+ ]+ ]+ , string "Feb" >> return 2+ , string "Ma"+ >> choice [ char 'r' >> return 3+ , char 'y' >> return 5+ ]+ , char 'A'+ >> choice [ string "pr" >> return 4+ , string "ug" >> return 8+ ]+ , string "Sep" >> return 9+ , string "Oct" >> return 10+ , string "Nov" >> return 11+ , string "Dec" >> return 12+ ]++longMonthName :: Int -> String+longMonthName 1 = "January"+longMonthName 2 = "February"+longMonthName 3 = "March"+longMonthName 4 = "April"+longMonthName 5 = "May"+longMonthName 6 = "June"+longMonthName 7 = "July"+longMonthName 8 = "August"+longMonthName 9 = "September"+longMonthName 10 = "October"+longMonthName 11 = "November"+longMonthName 12 = "December"+longMonthName n = error ("longMonthName: unknown month number: " ++ show n)++longMonthNameP :: Stream s m Char => ParsecT s u m Int+longMonthNameP+ = choice [ char 'J'+ >> choice [ string "anuary" >> return 1+ , char 'u'+ >> choice [ string "ne" >> return 6+ , string "ly" >> return 7+ ]+ ]+ , string "February" >> return 2+ , string "Ma"+ >> choice [ string "rch" >> return 3+ , char 'y' >> return 5+ ]+ , char 'A'+ >> choice [ string "pril" >> return 4+ , string "ugust" >> return 8+ ]+ , string "September" >> return 9+ , string "October" >> return 10+ , string "November" >> return 11+ , string "December" >> return 12+ ]++show4 :: Integral i => i -> String+show4 i+ | i >= 0 && i < 10 = "000" ++ show i+ | i >= 0 && i < 100 = "00" ++ show i+ | i >= 0 && i < 1000 = "0" ++ show i+ | i >= 0 && i < 10000 = show i+ | otherwise = error ("show4: the integer i must satisfy 0 <= i < 10000: " ++ show i)++show2 :: Integral i => i -> String+show2 i+ | i >= 0 && i < 10 = "0" ++ show i+ | i >= 0 && i < 100 = show i+ | otherwise = error ("show2: the integer i must satisfy 0 <= i < 100: " ++ show i)++read4 :: (Stream s m Char, Num n) => ParsecT s u m n+read4 = do n1 <- digit'+ n2 <- digit'+ n3 <- digit'+ n4 <- digit'+ return (n1 * 1000 + n2 * 100 + n3 * 10 + n4)++read2 :: (Stream s m Char, Num n) => ParsecT s u m n+read2 = do n1 <- digit'+ n2 <- digit'+ return (n1 * 10 + n2)++digit' :: (Stream s m Char, Num n) => ParsecT s u m n+digit' = liftM fromC digit++fromC :: Num n => Char -> n+fromC '0' = 0+fromC '1' = 1+fromC '2' = 2+fromC '3' = 3+fromC '4' = 4+fromC '5' = 5+fromC '6' = 6+fromC '7' = 7+fromC '8' = 8+fromC '9' = 9+fromC _ = undefined++show4digitsTZ :: TimeZone -> String+show4digitsTZ tz+ = case timeZoneMinutes tz of+ offset | offset < 0 -> '-' : showTZ' (negate offset)+ | otherwise -> '+' : showTZ' offset+ where+ showTZ' offset+ = let h = offset `div` 60+ m = offset - h * 60+ in+ concat [show2 h, show2 m]++read4digitsTZ :: Stream s m Char => ParsecT s u m TimeZone+read4digitsTZ+ = do sign <- (char '+' >> return 1)+ <|>+ (char '-' >> return (-1))+ hour <- read2+ minute <- read2+ let tz = TimeZone {+ timeZoneMinutes = (sign * (hour * 60 + minute))+ , timeZoneSummerOnly = False+ , timeZoneName = timeZoneOffsetString tz+ }+ return tz++assertWeekDayIsGood :: Stream s m t => Int -> Day -> ParsecT s u m ()+assertWeekDayIsGood givenWD gregDay+ = let (_, _, correctWD ) = toWeekDate gregDay+ (year, month, day) = toGregorian gregDay+ in+ unless (givenWD == correctWD)+ $ fail+ $ concat [ "Gregorian day "+ , show year+ , "-"+ , show month+ , "-"+ , show day+ , " is "+ , longWeekDayName correctWD+ , ", not "+ , longWeekDayName givenWD+ ]++assertGregorianDateIsGood :: Stream s m t => Integer -> Int -> Int -> ParsecT s u m Day+assertGregorianDateIsGood year month day+ = case fromGregorianValid year month day of+ Nothing+ -> fail $ concat [ "Invalid gregorian day: "+ , show year+ , "-"+ , show month+ , "-"+ , show day+ ]+ Just gregDay+ -> return gregDay++assertTimeOfDayIsGood :: Stream s m t => Int -> Int -> Pico -> ParsecT s u m TimeOfDay+assertTimeOfDayIsGood hour minute second+ = case makeTimeOfDayValid hour minute second of+ Nothing+ -> fail $ concat [ "Invalid time of day: "+ , show hour+ , ":"+ , show minute+ , ":"+ , showFixed True second+ ]+ Just tod+ -> return tod
+ Data/Time/HTTP/Parsec.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE FlexibleContexts #-}+module Data.Time.HTTP.Parsec+ ( rfc2616DateAndTime+ )+ where++import Control.Monad+import Data.Time+import Data.Time.RFC1123.Parsec+import Data.Time.RFC733.Parsec+import Data.Time.Asctime.Parsec+import Text.Parsec++-- |This is a parsec parser for date and time formats allowed in+-- HTTP\/1.1 (RFC 2616).+rfc2616DateAndTime :: Stream s m Char => ParsecT s u m UTCTime+rfc2616DateAndTime+ = choice [ liftM zonedTimeToUTC $ try rfc1123DateAndTime+ , liftM zonedTimeToUTC $ try rfc733DateAndTime+ , liftM (localTimeToUTC utc) $ asctime+ ]
+ Data/Time/RFC1123.hs view
@@ -0,0 +1,61 @@+-- |This module provides functions to parse and format RFC 1123 date+-- and time formats.+--+-- The format is basically same as RFC 822, but the syntax for @date@+-- is changed from:+--+-- > year ::= 2DIGIT+--+-- to:+--+-- > year ::= 4DIGIT+module Data.Time.RFC1123+ ( 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.RFC822 (showRFC822TimeZone)+import Data.Time.RFC1123.Parsec++-- |Format a 'ZonedTime' in RFC 1123.+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 [ shortWeekDayName week+ , ", "+ , show2 day+ , " "+ , shortMonthName month+ , " "+ , show4 year+ , " "+ , show2 (todHour timeOfDay)+ , ":"+ , show2 (todMin timeOfDay)+ , ":"+ , show2 (floor (todSec timeOfDay))+ , " "+ , showRFC822TimeZone timeZone+ ]++-- |Parse an RFC 1123 date and time string. When the string can't be+-- parsed, it returns 'Nothing'.+parse :: String -> Maybe ZonedTime+parse src = case P.parse p "" src of+ Right zt -> Just zt+ Left _ -> Nothing+ where+ p = do zt <- rfc1123DateAndTime+ _ <- P.eof+ return zt
+ Data/Time/RFC1123/Parsec.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleContexts #-}+module Data.Time.RFC1123.Parsec+ ( rfc1123DateAndTime+ )+ where++import Control.Monad+import Data.Fixed+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.HTTP.Common+import Data.Time.RFC822.Parsec+import Text.Parsec++-- |This is a parsec parser for RFC 1123 date and time strings.+rfc1123DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime+rfc1123DateAndTime = dateTime++dateTime :: Stream s m Char => ParsecT s u m ZonedTime+dateTime = do weekDay <- optionMaybe $+ do w <- shortWeekDayNameP+ _ <- string ", "+ return w+ gregDay <- date+ case weekDay of+ Nothing+ -> return () -- No day in week exists.+ Just givenWD+ -> assertWeekDayIsGood givenWD gregDay+ (tod, timeZone) <- rfc822time+ let lt = LocalTime gregDay tod+ zt = ZonedTime lt timeZone+ return zt++date :: Stream s m Char => ParsecT s u m Day+date = do day <- read2+ _ <- char ' '+ month <- shortMonthNameP+ _ <- char ' '+ year <- read4+ _ <- char ' '+ assertGregorianDateIsGood year month day
+ Data/Time/RFC733.hs view
@@ -0,0 +1,88 @@+-- |This module provides functions to parse and format RFC 733 date+-- and time formats.+--+-- The syntax is as follows:+--+-- > date-time ::= [ day-of-week ", " ] date SP time ("-" | SP) zone+-- > day-of-week ::= "Monday" | "Mon" | "Tuesday" | "Tue"+-- > | "Wednesday" | "Wed" | "Thursday" | "Thu"+-- > | "Friday" | "Fri" | "Saturday" | "Sat"+-- > | "Sunday" | "Sun"+-- > date ::= day ("-" | SP) month ("-" | SP) year+-- > day ::= 2DIGIT+-- > year ::= 2DIGIT | 4DIGIT+-- > 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 [ ":" ] minute [ [ ":" ] second ]+-- > hour ::= 2DIGIT+-- > minute ::= 2DIGIT+-- > second ::= 2DIGIT+-- > zone ::= "GMT" ; Universal Time+-- > | "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+-- > | "Z" ; GMT+-- > | "A" ; -1+-- > | "M" ; -12+-- > | "N" ; +1+-- > | "Y" ; +12+-- > | ("+" | "-") 4DIGIT ; Local diff: HHMM+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++-- |Format a 'ZonedTime' in RFC 733.+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))+ , "-"+ , show4digitsTZ timeZone+ ]++-- |Parse an RFC 733 date and time string. When the string can't be+-- parsed, it returns 'Nothing'.+parse :: String -> Maybe ZonedTime+parse src = case P.parse p "" src of+ Right zt -> Just zt+ Left _ -> Nothing+ where+ p = do zt <- rfc733DateAndTime+ _ <- P.eof+ return zt
+ Data/Time/RFC733/Parsec.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE FlexibleContexts #-}+module Data.Time.RFC733.Parsec+ ( rfc733DateAndTime+ )+ where++import Control.Monad+import Data.Fixed+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.HTTP.Common+import Text.Parsec++-- |This is a parsec parser for RFC 733 date and time strings.+rfc733DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime+rfc733DateAndTime = dateTime++dateTime :: Stream s m Char => ParsecT s u m ZonedTime+dateTime = do weekDay <- optionMaybe $+ do w <- try longWeekDayNameP+ <|>+ shortWeekDayNameP+ _ <- string ", "+ return w+ gregDay <- date+ case weekDay of+ Nothing+ -> return ()+ Just givenWD+ -> assertWeekDayIsGood givenWD gregDay+ (tod, timeZone) <- time+ let lt = LocalTime gregDay tod+ zt = ZonedTime lt timeZone+ return zt++date :: Stream s m Char => ParsecT s u m Day+date = do day <- read2+ _ <- char '-' <|> char ' '+ month <- try longMonthNameP+ <|>+ shortMonthNameP+ _ <- char '-' <|> char ' '+ year <- try read4+ <|>+ liftM (+ 1900) read2+ _ <- char ' '+ assertGregorianDateIsGood year month day++time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)+time = do tod <- hour+ _ <- char '-' <|> char ' '+ tz <- zone+ return (tod, tz)++hour :: Stream s m Char => ParsecT s u m TimeOfDay+hour = do hour <- read2+ _ <- optional (char ':')+ minute <- read2+ second <- option 0 $+ do _ <- optional (char ':')+ read2+ assertTimeOfDayIsGood hour minute second++zone :: Stream s m Char => ParsecT s u m TimeZone+zone = choice [ string "GMT" >> return (TimeZone 0 False "GMT")+ , char 'N'+ >> choice [ string "ST" >> return (TimeZone ((-3) * 60 - 30) False "NST")+ , return (TimeZone (1 * 60) False "N")+ ]+ , char 'A'+ >> choice [ string "ST" >> return (TimeZone ((-4) * 60) False "AST")+ , string "DT" >> return (TimeZone ((-3) * 60) False "AST")+ , return (TimeZone ((-1) * 60) False "A")+ ]+ , char 'E'+ >> choice [ string "ST" >> return (TimeZone ((-5) * 60) False "EST")+ , string "DT" >> return (TimeZone ((-4) * 60) True "EDT")+ ]+ , char 'C'+ >> choice [ string "ST" >> return (TimeZone ((-6) * 60) False "CST")+ , string "DT" >> return (TimeZone ((-5) * 60) True "CDT")+ ]+ , char 'M'+ >> choice [ string "ST" >> return (TimeZone ((-7) * 60) False "MST")+ , string "DT" >> return (TimeZone ((-6) * 60) True "MDT")+ , return (TimeZone ((-12) * 60) False "M")+ ]+ , char 'P'+ >> choice [ string "ST" >> return (TimeZone ((-8) * 60) False "PST")+ , string "DT" >> return (TimeZone ((-7) * 60) True "PDT")+ ]+ , char 'Y'+ >> choice [ string "ST" >> return (TimeZone ((-9) * 60) False "YST")+ , string "DT" >> return (TimeZone ((-8) * 60) True "YDT")+ , return (TimeZone ( 12 * 60) False "Y")+ ]+ , char 'H'+ >> choice [ string "ST" >> return (TimeZone ((-10) * 60) False "HST")+ , string "DT" >> return (TimeZone (( -9) * 60) True "HDT")+ ]+ , char 'B'+ >> choice [ string "ST" >> return (TimeZone ((-11) * 60) False "BST")+ , string "DT" >> return (TimeZone ((-10) * 60) True "BDT")+ ]+ , char 'Z' >> return (TimeZone 0 False "Z")+ , read4digitsTZ+ ]
+ Data/Time/RFC822.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_HADDOCK prune #-}++-- |This module provides functions to parse and format RFC 822 date+-- and time formats.+--+-- The syntax is as follows:+--+-- > date-time ::= [ day-of-week ", " ] date SP time SP zone+-- > day-of-week ::= "Mon" | "Tue" | "Wed" | "Thu"+-- > | "Fri" | "Sat" | "Sun"+-- > date ::= day SP month SP year+-- > day ::= 2DIGIT+-- > year ::= 2DIGIT ; Yes, only 2 digits.+-- > month ::= "Jan" | "Feb" | "Mar" | "Apr"+-- > | "May" | "Jun" | "Jul" | "Aug"+-- > | "Sep" | "Oct" | "Nov" | "Dec"+-- > time ::= hour ":" minute [ ":" second ]+-- > hour ::= 2DIGIT+-- > minute ::= 2DIGIT+-- > second ::= 2DIGIT+-- > zone ::= "UT" | "GMT" ; Universal Time+-- > | "EST" | "EDT" ; Eastern : -5 / -4+-- > | "CST" | "CDT" ; Central : -6 / -5+-- > | "MST" | "MDT" ; Mountain: -7 / -6+-- > | "PST" | "PDT" ; Pacific : -8 / -7+-- > | "Z" ; UT+-- > | "A" ; -1+-- > | "M" ; -12+-- > | "N" ; +1+-- > | "Y" ; +12+-- > | ("+" | "-") 4DIGIT ; Local diff: HHMM+module Data.Time.RFC822+ ( format+ , parse++ -- private+ , showRFC822TimeZone+ )+ where++import qualified Text.Parsec as P++import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.HTTP.Common+import Data.Time.RFC822.Parsec++-- |Format a 'ZonedTime' in RFC 822.+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 [ shortWeekDayName week+ , ", "+ , show2 day+ , " "+ , shortMonthName month+ , " "+ , show2 (year `mod` 100)+ , " "+ , show2 (todHour timeOfDay)+ , ":"+ , show2 (todMin timeOfDay)+ , ":"+ , show2 (floor (todSec timeOfDay))+ , " "+ , showRFC822TimeZone timeZone+ ]++showRFC822TimeZone :: TimeZone -> String+showRFC822TimeZone tz+ | timeZoneMinutes tz == 0 = "GMT"+ | otherwise = show4digitsTZ tz++-- |Parse an RFC 822 date and time string. When the string can't be+-- parsed, it returns 'Nothing'.+parse :: String -> Maybe ZonedTime+parse src = case P.parse p "" src of+ Right zt -> Just zt+ Left _ -> Nothing+ where+ p = do zt <- rfc822DateAndTime+ _ <- P.eof+ return zt
+ Data/Time/RFC822/Parsec.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_HADDOCK prune #-}++module Data.Time.RFC822.Parsec+ ( rfc822DateAndTime++ -- private+ , rfc822time+ )+ where++import Control.Monad+import Data.Fixed+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.HTTP.Common+import Text.Parsec++-- |This is a parsec parser for RFC 822 date and time strings.+rfc822DateAndTime :: Stream s m Char => ParsecT s u m ZonedTime+rfc822DateAndTime = dateTime++dateTime :: Stream s m Char => ParsecT s u m ZonedTime+dateTime = do weekDay <- optionMaybe $+ do w <- shortWeekDayNameP+ _ <- string ", "+ return w+ gregDay <- date+ case weekDay of+ Nothing+ -> return () -- No day in week exists.+ Just givenWD+ -> assertWeekDayIsGood givenWD gregDay+ (tod, timeZone) <- rfc822time+ let lt = LocalTime gregDay tod+ zt = ZonedTime lt timeZone+ return zt++date :: Stream s m Char => ParsecT s u m Day+date = do day <- read2+ _ <- char ' '+ month <- shortMonthNameP+ _ <- char ' '+ year <- liftM (+ 1900) read2+ _ <- char ' '+ assertGregorianDateIsGood year month day++rfc822time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)+rfc822time = do tod <- hour+ _ <- char ' '+ tz <- zone+ return (tod, tz)++hour :: Stream s m Char => ParsecT s u m TimeOfDay+hour = do hour <- read2+ minute <- char ':' >> read2+ second <- option 0 (char ':' >> read2)+ assertTimeOfDayIsGood hour minute second++zone :: Stream s m Char => ParsecT s u m TimeZone+zone = choice [ string "UT" >> return (TimeZone 0 False "UT" )+ , string "GMT" >> return (TimeZone 0 False "GMT")+ , char 'E'+ >> choice [ string "ST" >> return (TimeZone ((-5) * 60) False "EST")+ , string "DT" >> return (TimeZone ((-4) * 60) True "EDT")+ ]+ , char 'C'+ >> choice [ string "ST" >> return (TimeZone ((-6) * 60) False "CST")+ , string "DT" >> return (TimeZone ((-5) * 60) True "CDT")+ ]+ , char 'M'+ >> choice [ string "ST" >> return (TimeZone ((-7) * 60) False "MST")+ , string "DT" >> return (TimeZone ((-6) * 60) True "MDT")+ , return (TimeZone ((-12) * 60) False "M")+ ]+ , char 'P'+ >> choice [ string "ST" >> return (TimeZone ((-8) * 60) False "PST")+ , string "DT" >> return (TimeZone ((-7) * 60) True "PDT")+ ]+ , char 'Z' >> return (TimeZone 0 False "Z")+ , char 'A' >> return (TimeZone ((-1) * 60) False "A")+ , char 'N' >> return (TimeZone ( 1 * 60) False "N")+ , char 'Y' >> return (TimeZone ( 12 * 60) False "Y")+ , read4digitsTZ+ ]
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ time-http.cabal view
@@ -0,0 +1,44 @@+Name: time-http+Version: 0.1+Synopsis: Parse and format HTTP/1.1 Date and Time string+Description:+ This package provides functionalities to parse and format+ various Date and Time formats allowed in HTTP\/1.1 (RFC 2616).++Homepage: http://cielonegro.org/HTTPDateTime.html+License: PublicDomain+License-file: COPYING+Author: PHO <pho AT cielonegro DOT org>+Maintainer: PHO <pho AT cielonegro DOT org>+Stability: Experimental+Category: Web+Build-type: Simple+Cabal-version: >= 1.6++Source-Repository head+ Type: git+ Location: git://git.cielonegro.org/time-http.git++Library+ Exposed-modules:+ Data.Time.RFC733+ Data.Time.RFC733.Parsec+ Data.Time.RFC822+ Data.Time.RFC822.Parsec+ Data.Time.RFC1123+ Data.Time.RFC1123.Parsec+ Data.Time.Asctime+ Data.Time.Asctime.Parsec+ Data.Time.HTTP+ Data.Time.HTTP.Parsec++ Other-modules:+ Data.Time.HTTP.Common++ Build-depends:+ base == 4.2.*,+ parsec == 3.0.*,+ time == 1.1.*++ Extensions:+ FlexibleContexts