time-http 0.1.0.1 → 0.2
raw patch · 18 files changed
+815/−660 lines, 18 filesdep +QuickCheckdep +asciidep +attoparsecdep −parsecdep ~base
Dependencies added: QuickCheck, ascii, attoparsec, base-unicode-symbols, blaze-builder, blaze-textual
Dependencies removed: parsec
Dependency ranges changed: base
Files
- ChangeLog +2/−0
- Data/Time/Asctime.hs +26/−39
- Data/Time/Asctime/Internal.hs +61/−0
- Data/Time/Asctime/Parsec.hs +0/−34
- Data/Time/HTTP.hs +23/−21
- Data/Time/HTTP/Common.hs +224/−166
- Data/Time/HTTP/Internal.hs +36/−0
- Data/Time/HTTP/Parsec.hs +0/−21
- Data/Time/RFC1123.hs +23/−41
- Data/Time/RFC1123/Internal.hs +72/−0
- Data/Time/RFC1123/Parsec.hs +0/−42
- Data/Time/RFC733.hs +23/−40
- Data/Time/RFC733/Internal.hs +139/−0
- Data/Time/RFC733/Parsec.hs +0/−107
- Data/Time/RFC822.hs +22/−49
- Data/Time/RFC822/Internal.hs +121/−0
- Data/Time/RFC822/Parsec.hs +0/−85
- time-http.cabal +43/−15
+ ChangeLog view
@@ -0,0 +1,2 @@+== time-http-0.2 / unreleased+* Use attoparsec, ascii and blaze-builder
Data/Time/Asctime.hs view
@@ -1,8 +1,11 @@+{-# LANGUAGE+ UnicodeSyntax+ #-} -- |This module provides functions for ANSI C's asctime() format. -- -- ANSI C's asctime() format looks like: ----- @Wdy Mon DD HH:MM:SS YYYY@+-- @Wdy Mon [D]D HH:MM:SS YYYY@ -- -- The exact syntax is as follows: --@@ -12,54 +15,38 @@ -- > month ::= "Jan" | "Feb" | "Mar" | "Apr" -- > | "May" | "Jun" | "Jul" | "Aug" -- > | "Sep" | "Oct" | "Nov" | "Dec"--- > day ::= 2DIGIT+-- > day ::= 2DIGIT | SP 1DIGIT -- > 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+ ( -- * Formatting+ toAscii+ , toAsciiBuilder++ -- * Parsing+ , fromAscii+ , asctime ) where--import qualified Text.Parsec as P-+import Data.Ascii (Ascii)+import qualified Data.Ascii as A+import qualified Data.Attoparsec.Char8 as P import Data.Time-import Data.Time.Calendar.WeekDate-import Data.Time.HTTP.Common-import Data.Time.Asctime.Parsec+import Data.Time.Asctime.Internal+import Prelude.Unicode --- |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- ]+-- |Convert a 'LocalTime' to ANSI C's @asctime()@ string.+toAscii ∷ LocalTime → Ascii+toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder --- |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+-- |Parse an ANSI C's @asctime()@ string. When the string can't be+-- parsed, it returns @'Left' err@.+fromAscii ∷ Ascii → Either String LocalTime+fromAscii = P.parseOnly p ∘ A.toByteString where- p = do zt <- asctime- _ <- P.eof+ p = do zt ← asctime+ P.endOfInput return zt
+ Data/Time/Asctime/Internal.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE+ OverloadedStrings+ , UnicodeSyntax+ #-}+-- |Internal functions for "Data.Time.Asctime".+module Data.Time.Asctime.Internal+ ( asctime+ , toAsciiBuilder+ )+ where+import Data.Ascii (AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Monoid.Unicode+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.HTTP.Common++-- |Parse an ANSI C's @asctime()@ string.+asctime ∷ Parser LocalTime+asctime = do weekDay ← shortWeekDayNameP+ _ ← char ' '+ 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)++-- |Convert a 'LocalTime' to ANSI C's @asctime()@ string.+toAsciiBuilder ∷ LocalTime → AsciiBuilder+toAsciiBuilder localTime+ = let (year, month, day) = toGregorian (localDay localTime)+ (_, _, week) = toWeekDate (localDay localTime)+ timeOfDay = localTimeOfDay localTime+ in+ shortWeekDayName week+ ⊕ A.toAsciiBuilder " "+ ⊕ shortMonthName month+ ⊕ A.toAsciiBuilder " "+ ⊕ show2' day+ ⊕ A.toAsciiBuilder " "+ ⊕ show2 (todHour timeOfDay)+ ⊕ A.toAsciiBuilder ":"+ ⊕ show2 (todMin timeOfDay)+ ⊕ A.toAsciiBuilder ":"+ ⊕ show2 (floor (todSec timeOfDay) ∷ Int)+ ⊕ A.toAsciiBuilder " "+ ⊕ show4 year+
− Data/Time/Asctime/Parsec.hs
@@ -1,34 +0,0 @@-{-# 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
@@ -1,3 +1,6 @@+{-# LANGUAGE+ UnicodeSyntax+ #-} -- |This module provides functions to parse and format HTTP\/1.1 date -- and time formats. --@@ -37,39 +40,38 @@ -- > | "May" | "Jun" | "Jul" | "Aug" -- > | "Sep" | "Oct" | "Nov" | "Dec" module Data.Time.HTTP- ( format- , parse+ ( -- * Formatting+ toAscii+ , toAsciiBuilder++ -- * Parsing+ , fromAscii+ , httpDateAndTime ) where--import qualified Data.Time.RFC1123 as RFC1123-import qualified Text.Parsec as P-+import Data.Ascii (Ascii)+import qualified Data.Ascii as A+import qualified Data.Attoparsec.Char8 as P import Data.Time-import Data.Time.HTTP.Parsec+import Data.Time.HTTP.Internal+import Prelude.Unicode --- |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+-- |Convert a 'UTCTime' to RFC 1123 date and time string.+toAscii ∷ UTCTime → Ascii+toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder -- |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'.+-- returns @'Left' err@. -- -- 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+fromAscii ∷ Ascii → Either String UTCTime+fromAscii = P.parseOnly p ∘ A.toByteString where- p = do zt <- rfc2616DateAndTime- _ <- P.eof+ p = do zt ← httpDateAndTime+ P.endOfInput return zt
Data/Time/HTTP/Common.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE+ OverloadedStrings+ , UnicodeSyntax+ #-} module Data.Time.HTTP.Common ( shortWeekDayName , shortWeekDayNameP@@ -12,11 +15,13 @@ , longMonthName , longMonthNameP - , show2 , show4+ , show2+ , show2' - , read2 , read4+ , read2+ , read2' , show4digitsTZ , read4digitsTZ@@ -24,203 +29,245 @@ , assertWeekDayIsGood , assertGregorianDateIsGood , assertTimeOfDayIsGood++ , optionMaybe ) where-+import Blaze.ByteString.Builder.ByteString as B+import Blaze.Text.Int as BT+import Control.Applicative import Control.Monad+import Data.Ascii (AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8 as P+import Data.Char+import Data.Monoid.Unicode import Data.Fixed import Data.Time import Data.Time.Calendar.WeekDate-import Text.Parsec+import Prelude.Unicode -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)+shortWeekDayName ∷ Num n ⇒ n → AsciiBuilder+{-# INLINE shortWeekDayName #-}+shortWeekDayName = A.toAsciiBuilder ∘ go+ where+ {-# INLINEABLE go #-}+ go 1 = "Mon"+ go 2 = "Tue"+ go 3 = "Wed"+ go 4 = "Thu"+ go 5 = "Fri"+ go 6 = "Sat"+ go 7 = "Sun"+ go n = error ("shortWeekDayName: invalid week day: " ⧺ show n) -shortWeekDayNameP :: Stream s m Char => ParsecT s u m Int+shortWeekDayNameP ∷ Num n ⇒ Parser n+{-# INLINEABLE shortWeekDayNameP #-} shortWeekDayNameP- = choice [ string "Mon" >> return 1+ = choice [ string "Mon" *> return 1 , char 'T'- >> choice [ string "ue" >> return 2- , string "hu" >> return 4+ *> choice [ string "ue" *> return 2+ , string "hu" *> return 4 ]- , string "Wed" >> return 3- , string "Fri" >> return 5+ , string "Wed" *> return 3+ , string "Fri" *> return 5 , char 'S'- >> choice [ string "at" >> return 6- , string "un" >> return 7+ *> 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"+longWeekDayName ∷ Num n ⇒ n → AsciiBuilder+{-# INLINE longWeekDayName #-}+longWeekDayName = A.toAsciiBuilder ∘ go+ where+ {-# INLINEABLE go #-}+ go 1 = "Monday"+ go 2 = "Tuesday"+ go 3 = "Wednesday"+ go 4 = "Thursday"+ go 5 = "Friday"+ go 6 = "Saturday"+ go 7 = "Sunday"+ go n = error ("longWeekDayName: invalid week day: " ⧺ show n) -longWeekDayNameP :: Stream s m Char => ParsecT s u m Int+longWeekDayNameP ∷ Num n ⇒ Parser n+{-# INLINEABLE longWeekDayNameP #-} longWeekDayNameP- = choice [ string "Monday" >> return 1+ = choice [ string "Monday" *> return 1 , char 'T'- >> choice [ string "uesday" >> return 2- , string "hursday" >> return 4+ *> choice [ string "uesday" *> return 2+ , string "hursday" *> return 4 ]- , string "Wednesday" >> return 3- , string "Friday" >> return 5+ , string "Wednesday" *> return 3+ , string "Friday" *> return 5 , char 'S'- >> choice [ string "aturday" >> return 6- , string "unday" >> return 7+ *> 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)+shortMonthName ∷ Num n ⇒ n → AsciiBuilder+{-# INLINE shortMonthName #-}+shortMonthName = A.toAsciiBuilder ∘ go+ where+ {-# INLINEABLE go #-}+ go 1 = "Jan"+ go 2 = "Feb"+ go 3 = "Mar"+ go 4 = "Apr"+ go 5 = "May"+ go 6 = "Jun"+ go 7 = "Jul"+ go 8 = "Aug"+ go 9 = "Sep"+ go 10 = "Oct"+ go 11 = "Nov"+ go 12 = "Dec"+ go n = error ("shortMonthName: invalid month: " ⧺ show n) -shortMonthNameP :: Stream s m Char => ParsecT s u m Int+shortMonthNameP ∷ Num n ⇒ Parser n+{-# INLINEABLE shortMonthNameP #-} shortMonthNameP = choice [ char 'J'- >> choice [ string "an" >> return 1+ *> choice [ string "an" *> return 1 , char 'u'- >> choice [ char 'n' >> return 6- , char 'l' >> return 7+ *> choice [ char 'n' *> return 6+ , char 'l' *> return 7 ] ]- , string "Feb" >> return 2+ , string "Feb" *> return 2 , string "Ma"- >> choice [ char 'r' >> return 3- , char 'y' >> return 5+ *> choice [ char 'r' *> return 3+ , char 'y' *> return 5 ] , char 'A'- >> choice [ string "pr" >> return 4- , string "ug" >> return 8+ *> 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+ , 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)+longMonthName ∷ Num n ⇒ n → AsciiBuilder+{-# INLINE longMonthName #-}+longMonthName = A.toAsciiBuilder ∘ go+ where+ {-# INLINEABLE go #-}+ go 1 = "January"+ go 2 = "February"+ go 3 = "March"+ go 4 = "April"+ go 5 = "May"+ go 6 = "June"+ go 7 = "July"+ go 8 = "August"+ go 9 = "September"+ go 10 = "October"+ go 11 = "November"+ go 12 = "December"+ go n = error ("longMonthName: invalid month: " ⧺ show n) -longMonthNameP :: Stream s m Char => ParsecT s u m Int+longMonthNameP ∷ Num n ⇒ Parser n+{-# INLINEABLE longMonthNameP #-} longMonthNameP = choice [ char 'J'- >> choice [ string "anuary" >> return 1+ *> choice [ string "anuary" *> return 1 , char 'u'- >> choice [ string "ne" >> return 6- , string "ly" >> return 7+ *> choice [ string "ne" *> return 6+ , string "ly" *> return 7 ] ]- , string "February" >> return 2+ , string "February" *> return 2 , string "Ma"- >> choice [ string "rch" >> return 3- , char 'y' >> return 5+ *> choice [ string "rch" *> return 3+ , char 'y' *> return 5 ] , char 'A'- >> choice [ string "pril" >> return 4- , string "ugust" >> return 8+ *> 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+ , 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)+show4 ∷ Integral i ⇒ i → AsciiBuilder+{-# INLINE show4 #-}+show4 = A.unsafeFromBuilder ∘ go+ where+ {-# INLINEABLE go #-}+ go i | i ≥ 0 ∧ i < 10 = B.fromByteString "000" ⊕ BT.digit i+ | i ≥ 0 ∧ i < 100 = B.fromByteString "00" ⊕ BT.integral i+ | i ≥ 0 ∧ i < 1000 = B.fromByteString "0" ⊕ BT.integral i+ | i ≥ 0 ∧ i < 10000 = BT.integral 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)+show2 ∷ Integral i ⇒ i → AsciiBuilder+{-# INLINE show2 #-}+show2 = A.unsafeFromBuilder ∘ go+ where+ go i | i ≥ 0 ∧ i < 10 = B.fromByteString "0" ⊕ BT.digit i+ | i ≥ 0 ∧ i < 100 = BT.integral 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'+show2' ∷ Integral i ⇒ i → AsciiBuilder+{-# INLINE show2' #-}+show2' = A.unsafeFromBuilder ∘ go+ where+ go i | i ≥ 0 ∧ i < 10 = B.fromByteString " " ⊕ BT.digit i+ | i ≥ 0 ∧ i < 100 = BT.integral i+ | otherwise = error ("show2': the integer i must satisfy 0 <= i < 100: " ⧺ show i)++read4 ∷ Num n ⇒ Parser n+{-# INLINEABLE read4 #-}+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'+read2 ∷ Num n ⇒ Parser n+{-# INLINEABLE read2 #-}+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+read2' ∷ Num n ⇒ Parser n+{-# INLINEABLE read2' #-}+read2' = do n1 ← (char ' ' *> pure 0) <|> digit'+ n2 ← digit'+ return (n1 * 10 + n2) -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+digit' ∷ Num n ⇒ Parser n+{-# INLINE digit' #-}+digit' = fromIntegral <$> fromC <$> P.digit+ where+ {-# INLINE fromC #-}+ fromC c = ord c - ord '0' -show4digitsTZ :: TimeZone -> String+show4digitsTZ ∷ TimeZone → AsciiBuilder show4digitsTZ tz = case timeZoneMinutes tz of- offset | offset < 0 -> '-' : showTZ' (negate offset)- | otherwise -> '+' : showTZ' offset+ offset | offset < 0 → A.toAsciiBuilder "-" ⊕ showTZ' (negate offset)+ | otherwise → A.toAsciiBuilder "+" ⊕ showTZ' offset where showTZ' offset = let h = offset `div` 60 m = offset - h * 60 in- show2 h ++ show2 m+ show2 h ⊕ show2 m -read4digitsTZ :: Stream s m Char => ParsecT s u m TimeZone+read4digitsTZ ∷ Parser TimeZone read4digitsTZ- = do sign <- (char '+' >> return 1)- <|>- (char '-' >> return (-1))- hour <- read2- minute <- read2+ = do sign ← (char '+' *> return 1)+ <|>+ (char '-' *> return (-1))+ hour ← read2+ minute ← read2 let tz = TimeZone { timeZoneMinutes = sign * (hour * 60 + minute) , timeZoneSummerOnly = False@@ -228,49 +275,60 @@ } return tz -assertWeekDayIsGood :: Stream s m t => Int -> Day -> ParsecT s u m ()+assertWeekDayIsGood ∷ Monad m ⇒ Int → Day → m ()+{-# INLINEABLE assertWeekDayIsGood #-} assertWeekDayIsGood givenWD gregDay = let (_, _, correctWD ) = toWeekDate gregDay (year, month, day) = toGregorian gregDay in- unless (givenWD == correctWD)- $ fail- $ concat [ "Gregorian day "+ unless (givenWD ≡ correctWD)+ $ fail+ $ concat [ "Gregorian day "+ , show year+ , "-"+ , show month+ , "-"+ , show day+ , " is "+ , toStr $ longWeekDayName correctWD+ , ", not "+ , toStr $ longWeekDayName givenWD+ ]+ where+ toStr ∷ AsciiBuilder → String+ toStr = A.toString ∘ A.fromAsciiBuilder++assertGregorianDateIsGood ∷ Monad m ⇒ Integer → Int → Int → m Day+{-# INLINEABLE assertGregorianDateIsGood #-}+assertGregorianDateIsGood year month day+ = case fromGregorianValid year month day of+ Nothing+ → fail $ concat [ "Invalid 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+ → return gregDay -assertTimeOfDayIsGood :: Stream s m t => Int -> Int -> Pico -> ParsecT s u m TimeOfDay+assertTimeOfDayIsGood ∷ Monad m ⇒ Int → Int → Pico → m TimeOfDay+{-# INLINEABLE assertTimeOfDayIsGood #-} assertTimeOfDayIsGood hour minute second = case makeTimeOfDayValid hour minute second of Nothing- -> fail $ concat [ "Invalid time of day: "- , show hour- , ":"- , show minute- , ":"- , showFixed True second- ]+ → fail $ concat [ "Invalid time of day: "+ , show hour+ , ":"+ , show minute+ , ":"+ , showFixed True second+ ] Just tod- -> return tod+ → return tod++optionMaybe ∷ Alternative f ⇒ f a → f (Maybe a)+{-# INLINE optionMaybe #-}+optionMaybe p+ = option Nothing (Just <$> p)
+ Data/Time/HTTP/Internal.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE+ UnicodeSyntax+ #-}+-- |Internal functions for "Data.Time.HTTP".+module Data.Time.HTTP.Internal+ ( httpDateAndTime+ , toAsciiBuilder+ )+ where+import Control.Applicative+import Data.Ascii (AsciiBuilder)+import Data.Attoparsec.Char8+import Data.Time+import qualified Data.Time.RFC1123.Internal as RFC1123+import qualified Data.Time.RFC733.Internal as RFC733+import qualified Data.Time.Asctime.Internal as Asctime+import Prelude.Unicode++-- |Parse a date and time string in any formats allowed by HTTP\/1.1+-- (RFC 2616).+httpDateAndTime ∷ Parser UTCTime+httpDateAndTime+ = choice [ zonedTimeToUTC <$> try RFC1123.rfc1123DateAndTime+ , zonedTimeToUTC <$> try RFC733.rfc733DateAndTime+ , localTimeToUTC utc <$> Asctime.asctime+ ]++-- |Convert a 'UTCTime' to RFC 1123 date and time string.+toAsciiBuilder ∷ UTCTime → AsciiBuilder+toAsciiBuilder = RFC1123.toAsciiBuilder ∘ ut2zt+ where+ ut2zt ∷ UTCTime → ZonedTime+ ut2zt = utcToZonedTime gmt++ gmt ∷ TimeZone+ gmt = TimeZone 0 False "GMT"
− Data/Time/HTTP/Parsec.hs
@@ -1,21 +0,0 @@-{-# 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
@@ -1,3 +1,6 @@+{-# LANGUAGE+ UnicodeSyntax+ #-} -- |This module provides functions to parse and format RFC 1123 date -- and time formats. --@@ -10,52 +13,31 @@ -- -- > year ::= 4DIGIT module Data.Time.RFC1123- ( format- , parse+ ( -- * Formatting+ toAscii+ , toAsciiBuilder++ -- * Parsing+ , fromAscii+ , rfc1123DateAndTime ) where--import qualified Text.Parsec as P-+import Data.Ascii (Ascii)+import qualified Data.Ascii as A+import qualified Data.Attoparsec.Char8 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+import Data.Time.RFC1123.Internal+import Prelude.Unicode --- |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- ]+-- |Convert a 'ZonedTime' to RFC 1123 date and time string.+toAscii ∷ ZonedTime → Ascii+toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder -- |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+-- parsed, it returns @'Left' err@.+fromAscii ∷ Ascii → Either String ZonedTime+fromAscii = P.parseOnly p ∘ A.toByteString where- p = do zt <- rfc1123DateAndTime- _ <- P.eof+ p = do zt ← rfc1123DateAndTime+ P.endOfInput return zt
+ Data/Time/RFC1123/Internal.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE+ OverloadedStrings+ , UnicodeSyntax+ #-}+-- |Internal functions for "Data.Time.RFC1123".+module Data.Time.RFC1123.Internal+ ( rfc1123DateAndTime+ , toAsciiBuilder+ )+ where+import Data.Ascii (AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Monoid.Unicode+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.HTTP.Common+import Data.Time.RFC822.Internal hiding (toAsciiBuilder)++-- |Parse an RFC 1123 date and time string.+rfc1123DateAndTime ∷ Parser ZonedTime+rfc1123DateAndTime = dateTime++dateTime ∷ Parser ZonedTime+dateTime = do weekDay ← optionMaybe $+ do w ← shortWeekDayNameP+ _ ← string ", "+ return w+ gregDay ← date+ case weekDay of+ Nothing+ → return ()+ Just givenWD+ → assertWeekDayIsGood givenWD gregDay+ (tod, timeZone) ← rfc822time+ let lt = LocalTime gregDay tod+ zt = ZonedTime lt timeZone+ return zt++date ∷ Parser Day+date = do day ← read2+ _ ← char ' '+ month ← shortMonthNameP+ _ ← char ' '+ year ← read4+ _ ← char ' '+ assertGregorianDateIsGood year month day++-- |Convert a 'ZonedTime' to RFC 1123 date and time string.+toAsciiBuilder ∷ ZonedTime → AsciiBuilder+toAsciiBuilder zonedTime+ = let localTime = zonedTimeToLocalTime zonedTime+ timeZone = zonedTimeZone zonedTime+ (year, month, day) = toGregorian (localDay localTime)+ (_, _, week) = toWeekDate (localDay localTime)+ timeOfDay = localTimeOfDay localTime+ in+ shortWeekDayName week+ ⊕ A.toAsciiBuilder ", "+ ⊕ show2 day+ ⊕ A.toAsciiBuilder " "+ ⊕ shortMonthName month+ ⊕ A.toAsciiBuilder " "+ ⊕ show4 year+ ⊕ A.toAsciiBuilder " "+ ⊕ show2 (todHour timeOfDay)+ ⊕ A.toAsciiBuilder ":"+ ⊕ show2 (todMin timeOfDay)+ ⊕ A.toAsciiBuilder ":"+ ⊕ show2 (floor (todSec timeOfDay) ∷ Int)+ ⊕ A.toAsciiBuilder " "+ ⊕ showRFC822TimeZone timeZone
− Data/Time/RFC1123/Parsec.hs
@@ -1,42 +0,0 @@-{-# 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
@@ -1,3 +1,6 @@+{-# LANGUAGE+ UnicodeSyntax+ #-} -- |This module provides functions to parse and format RFC 733 date -- and time formats. --@@ -38,51 +41,31 @@ -- > | "Y" ; +12 -- > | ("+" | "-") 4DIGIT ; Local diff: HHMM module Data.Time.RFC733- ( format- , parse+ ( -- * Formatting+ toAscii+ , toAsciiBuilder++ -- * Parsing+ , fromAscii+ , rfc733DateAndTime ) where--import qualified Text.Parsec as P-+import Data.Ascii (Ascii)+import qualified Data.Ascii as A+import qualified Data.Attoparsec.Char8 as P import Data.Time-import Data.Time.Calendar.WeekDate-import Data.Time.HTTP.Common-import Data.Time.RFC733.Parsec+import Data.Time.RFC733.Internal+import Prelude.Unicode --- |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- ]+-- |Convert a 'ZonedTime' to RFC 733 date and time string.+toAscii ∷ ZonedTime → Ascii+toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder -- |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+-- parsed, it returns @'Left' err@.+fromAscii ∷ Ascii → Either String ZonedTime+fromAscii = P.parseOnly p ∘ A.toByteString where- p = do zt <- rfc733DateAndTime- _ <- P.eof+ p = do zt ← rfc733DateAndTime+ P.endOfInput return zt
+ Data/Time/RFC733/Internal.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE+ OverloadedStrings+ , UnicodeSyntax+ #-}+-- |Internal functions for "Data.Time.RFC733".+module Data.Time.RFC733.Internal+ ( rfc733DateAndTime+ , toAsciiBuilder+ )+ where+import Data.Ascii (AsciiBuilder)+import qualified Data.Ascii as A+import Control.Applicative+import Data.Attoparsec.Char8+import Data.Monoid.Unicode+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.HTTP.Common+import Data.Time.RFC822.Internal hiding (toAsciiBuilder)++-- |Parse RFC 733 date and time strings.+rfc733DateAndTime ∷ Parser ZonedTime+rfc733DateAndTime = dateTime++dateTime ∷ Parser ZonedTime+dateTime = do weekDay ← optionMaybe $+ do w ← 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 ∷ Parser Day+date = do day ← read2+ _ ← char '-' <|> char ' '+ month ← try longMonthNameP+ <|>+ shortMonthNameP+ _ ← char '-' <|> char ' '+ year ← try read4+ <|>+ (+ 1900) <$> read2+ _ ← char ' '+ assertGregorianDateIsGood year month day++time ∷ Parser (TimeOfDay, TimeZone)+time = do tod ← hms+ _ ← char '-' <|> char ' '+ tz ← zone+ return (tod, tz)++hms ∷ Parser TimeOfDay+hms = do hour ← read2+ _ ← optional (char ':')+ minute ← read2+ second ← option 0 $+ do _ ← optional (char ':')+ read2+ assertTimeOfDayIsGood hour minute second++zone ∷ Parser 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+ ]++-- |Convert a 'ZonedTime' to RFC 733 date and time string.+toAsciiBuilder ∷ ZonedTime → AsciiBuilder+toAsciiBuilder zonedTime+ = let localTime = zonedTimeToLocalTime zonedTime+ timeZone = zonedTimeZone zonedTime+ (year, month, day) = toGregorian (localDay localTime)+ (_, _, week) = toWeekDate (localDay localTime)+ timeOfDay = localTimeOfDay localTime+ in+ longWeekDayName week+ ⊕ A.toAsciiBuilder ", "+ ⊕ show2 day+ ⊕ A.toAsciiBuilder "-"+ ⊕ shortMonthName month+ ⊕ A.toAsciiBuilder "-"+ ⊕ show4 year+ ⊕ A.toAsciiBuilder " "+ ⊕ show2 (todHour timeOfDay)+ ⊕ A.toAsciiBuilder ":"+ ⊕ show2 (todMin timeOfDay)+ ⊕ A.toAsciiBuilder ":"+ ⊕ show2 (floor (todSec timeOfDay) ∷ Int)+ ⊕ A.toAsciiBuilder " "+ ⊕ showRFC822TimeZone timeZone
− Data/Time/RFC733/Parsec.hs
@@ -1,107 +0,0 @@-{-# 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
@@ -1,5 +1,6 @@-{-# OPTIONS_HADDOCK prune #-}-+{-# LANGUAGE+ UnicodeSyntax+ #-} -- |This module provides functions to parse and format RFC 822 date -- and time formats. --@@ -30,59 +31,31 @@ -- > | "Y" ; +12 -- > | ("+" | "-") 4DIGIT ; Local diff: HHMM module Data.Time.RFC822- ( format- , parse+ ( -- * Formatting+ toAscii+ , toAsciiBuilder - -- private- , showRFC822TimeZone+ -- * Parsing+ , fromAscii+ , rfc822DateAndTime ) where--import qualified Text.Parsec as P-+import Data.Ascii (Ascii)+import qualified Data.Ascii as A+import qualified Data.Attoparsec.Char8 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- ]+import Data.Time.RFC822.Internal+import Prelude.Unicode -showRFC822TimeZone :: TimeZone -> String-showRFC822TimeZone tz- | timeZoneMinutes tz == 0 = "GMT"- | otherwise = show4digitsTZ tz+-- |Convert a 'ZonedTime' to RFC 822 date and time string.+toAscii ∷ ZonedTime → Ascii+toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder -- |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+-- parsed, it returns @'Left' err@.+fromAscii ∷ Ascii → Either String ZonedTime+fromAscii = P.parseOnly p ∘ A.toByteString where- p = do zt <- rfc822DateAndTime- _ <- P.eof+ p = do zt ← rfc822DateAndTime+ P.endOfInput return zt
+ Data/Time/RFC822/Internal.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE+ OverloadedStrings+ , UnicodeSyntax+ #-}+-- |Internal functions for "Data.Time.RFC822".+module Data.Time.RFC822.Internal+ ( rfc822DateAndTime+ , rfc822time+ , showRFC822TimeZone+ , toAsciiBuilder+ )+ where+import Control.Applicative+import Data.Ascii (AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Monoid.Unicode+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.HTTP.Common+import Prelude.Unicode++-- |Parse an RFC 822 date and time string.+rfc822DateAndTime ∷ Parser ZonedTime+rfc822DateAndTime = dateTime++dateTime ∷ Parser ZonedTime+dateTime = do weekDay ← optionMaybe $+ do w ← shortWeekDayNameP+ _ ← string ", "+ return w+ gregDay ← date+ case weekDay of+ Nothing+ -> return ()+ Just givenWD+ -> assertWeekDayIsGood givenWD gregDay+ (tod, timeZone) ← rfc822time+ let lt = LocalTime gregDay tod+ zt = ZonedTime lt timeZone+ return zt++date ∷ Parser Day+date = do day ← read2+ _ ← char ' '+ month ← shortMonthNameP+ _ ← char ' '+ year ← (+ 1900) <$> read2+ _ ← char ' '+ assertGregorianDateIsGood year month day++-- |Parse the time and time zone of an RFC 822 date and time string.+rfc822time ∷ Parser (TimeOfDay, TimeZone)+rfc822time = do tod ← hms+ _ ← char ' '+ tz ← zone+ return (tod, tz)++hms ∷ Parser TimeOfDay+hms = do hour ← read2+ minute ← char ':' *> read2+ second ← option 0 (char ':' *> read2)+ assertTimeOfDayIsGood hour minute second++zone ∷ Parser 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+ ]++-- |No need to explain.+showRFC822TimeZone ∷ TimeZone → AsciiBuilder+showRFC822TimeZone tz+ | timeZoneMinutes tz ≡ 0 = A.toAsciiBuilder "GMT"+ | otherwise = show4digitsTZ tz++-- |Convert a 'ZonedTime' to RFC 822 date and time string.+toAsciiBuilder ∷ ZonedTime → AsciiBuilder+toAsciiBuilder zonedTime+ = let localTime = zonedTimeToLocalTime zonedTime+ timeZone = zonedTimeZone zonedTime+ (year, month, day) = toGregorian (localDay localTime)+ (_, _, week) = toWeekDate (localDay localTime)+ timeOfDay = localTimeOfDay localTime+ in+ shortWeekDayName week+ ⊕ A.toAsciiBuilder ", "+ ⊕ show2 day+ ⊕ A.toAsciiBuilder " "+ ⊕ shortMonthName month+ ⊕ A.toAsciiBuilder " "+ ⊕ show2 (year `mod` 100)+ ⊕ A.toAsciiBuilder " "+ ⊕ show2 (todHour timeOfDay)+ ⊕ A.toAsciiBuilder ":"+ ⊕ show2 (todMin timeOfDay)+ ⊕ A.toAsciiBuilder ":"+ ⊕ show2 (floor (todSec timeOfDay) ∷ Int)+ ⊕ A.toAsciiBuilder " "+ ⊕ showRFC822TimeZone timeZone
− Data/Time/RFC822/Parsec.hs
@@ -1,85 +0,0 @@-{-# 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- ]
time-http.cabal view
@@ -1,11 +1,12 @@ Name: time-http-Version: 0.1.0.1+Version: 0.2 Synopsis: Parse and format HTTP/1.1 Date and Time strings 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+Bug-Reports: http://static.cielonegro.org/ditz/time-http/ License: PublicDomain License-file: COPYING Author: PHO <pho AT cielonegro DOT org>@@ -13,7 +14,11 @@ Stability: Experimental Category: Web Build-type: Simple-Cabal-version: >= 1.6+Tested-With: GHC == 7.0.3+Cabal-version: >= 1.10+Extra-Source-Files:+ COPYING+ ChangeLog Source-Repository head Type: git@@ -21,24 +26,47 @@ 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+ Data.Time.RFC1123+ Data.Time.RFC733+ Data.Time.RFC822 Other-modules:+ Data.Time.Asctime.Internal Data.Time.HTTP.Common+ Data.Time.HTTP.Internal+ Data.Time.RFC1123.Internal+ Data.Time.RFC733.Internal+ Data.Time.RFC822.Internal Build-depends:- base == 4.3.*,- parsec == 3.1.*,- time == 1.2.*+ ascii == 0.0.*,+ attoparsec == 0.9.*,+ blaze-builder == 0.3.*,+ blaze-textual == 0.2.*,+ base == 4.*,+ base-unicode-symbols == 0.2.*,+ time == 1.2.* - Extensions:- FlexibleContexts+ Default-Language:+ Haskell2010++ GHC-Options:+ -Wall++Test-Suite test-time-http+ Type: exitcode-stdio-1.0+ Main-Is: Test/Time/HTTP.hs+ Default-Language: Haskell2010+ Build-depends:+ QuickCheck == 2.4.*,+ ascii == 0.0.*,+ attoparsec == 0.9.*,+ blaze-builder == 0.3.*,+ blaze-textual == 0.2.*,+ base == 4.*,+ base-unicode-symbols == 0.2.*,+ time == 1.2.*+ GHC-Options:+ -Wall -fno-warn-orphans