time-http 0.2 → 0.3
raw patch · 20 files changed
+1156/−1086 lines, 20 filesdep +attemptdep +bytestringdep +convertible-text
Dependencies added: attempt, bytestring, convertible-text, tagged
Files
- ChangeLog +4/−1
- Data/Time/Asctime.hs +0/−52
- Data/Time/Asctime/Internal.hs +0/−61
- Data/Time/Format/C.hs +114/−0
- Data/Time/Format/HTTP.hs +123/−0
- Data/Time/Format/HTTP/Common.hs +363/−0
- Data/Time/Format/RFC1123.hs +119/−0
- Data/Time/Format/RFC733.hs +213/−0
- Data/Time/Format/RFC822.hs +46/−0
- Data/Time/Format/RFC822/Internal.hs +151/−0
- Data/Time/HTTP.hs +0/−77
- Data/Time/HTTP/Common.hs +0/−334
- Data/Time/HTTP/Internal.hs +0/−36
- Data/Time/RFC1123.hs +0/−43
- Data/Time/RFC1123/Internal.hs +0/−72
- Data/Time/RFC733.hs +0/−71
- Data/Time/RFC733/Internal.hs +0/−139
- Data/Time/RFC822.hs +0/−61
- Data/Time/RFC822/Internal.hs +0/−121
- time-http.cabal +23/−18
ChangeLog view
@@ -1,2 +1,5 @@-== time-http-0.2 / unreleased+== time-http-0.3 / 2011-12-15+* Use tagged and convertible+== time-http-0.2 / 2011-10-03 * Use attoparsec, ascii and blaze-builder+* Create a test suite using QuickCheck
− Data/Time/Asctime.hs
@@ -1,52 +0,0 @@-{-# LANGUAGE- UnicodeSyntax- #-}--- |This module provides functions for ANSI C's asctime() format.------ ANSI C's asctime() format looks like:------ @Wdy Mon [D]D 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 | 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- ( -- * Formatting- toAscii- , toAsciiBuilder-- -- * Parsing- , fromAscii- , asctime- )- where-import Data.Ascii (Ascii)-import qualified Data.Ascii as A-import qualified Data.Attoparsec.Char8 as P-import Data.Time-import Data.Time.Asctime.Internal-import Prelude.Unicode---- |Convert a 'LocalTime' to ANSI C's @asctime()@ string.-toAscii ∷ LocalTime → Ascii-toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder---- |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.endOfInput- return zt
− Data/Time/Asctime/Internal.hs
@@ -1,61 +0,0 @@-{-# 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/Format/C.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , UnicodeSyntax+ #-}+-- |This module provides functions for ANSI C's date and time strings.+--+-- ANSI C's @ctime(3)@/@asctime(3)@ format looks like:+--+-- @Wdy Mon [D]D 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 | SP 1DIGIT+-- > time ::= 2DIGIT ':' 2DIGIT [':' 2DIGIT]+-- > year ::= 4DIGIT+module Data.Time.Format.C+ ( C+ , c+ , cDateAndTime+ )+ where+import Control.Applicative+import Data.Ascii (Ascii, AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Convertible.Base+import Data.Monoid.Unicode+import Data.Proxy+import Data.Tagged+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.Format.HTTP.Common+import Prelude.Unicode++-- |The phantom type for conversions between ANSI C's date and time+-- strings and 'LocalTime'.+--+-- >>> convertSuccess (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37))+-- Tagged "Sun Nov 6 08:49:37 1994"+data C++-- |The proxy for conversions between ANSI C's date and time strings+-- and 'LocalTime'.+c ∷ Proxy C+{-# INLINE CONLIKE c #-}+c = Proxy++instance ConvertSuccess LocalTime (Tagged C Ascii) where+ {-# INLINE convertSuccess #-}+ convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs++instance ConvertSuccess LocalTime (Tagged C AsciiBuilder) where+ {-# INLINE convertSuccess #-}+ convertSuccess = Tagged ∘ toAsciiBuilder++instance ConvertAttempt (Tagged C Ascii) LocalTime where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' cDateAndTime ∘ untag++-- |Parse an ANSI C's date and time string.+cDateAndTime ∷ Parser LocalTime+cDateAndTime+ = 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)++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++deriveAttempts [ ([t| LocalTime |], [t| Tagged C Ascii |])+ , ([t| LocalTime |], [t| Tagged C AsciiBuilder |])+ ]
+ Data/Time/Format/HTTP.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , UnicodeSyntax+ #-}+-- |This module provides functions to parse and format HTTP\/1.1 date+-- and time strings+-- (<http://tools.ietf.org/html/rfc2616#section-3.3>).+--+-- 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.Format.HTTP+ ( HTTP+ , http+ , httpDateAndTime+ )+ where+import Control.Applicative+import Data.Ascii (Ascii, AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Convertible.Base+import Data.Proxy+import Data.Tagged+import Data.Time+import Data.Time.Format.C+import Data.Time.Format.HTTP.Common+import Data.Time.Format.RFC733+import Data.Time.Format.RFC822+import Data.Time.Format.RFC1123+import Prelude.Unicode++-- |The phantom type for conversions between HTTP/1.1 date and time+-- strings and 'UTCTime'.+--+-- >>> convertSuccess (UTCTime (ModifiedJulianDay 49662) 31777)+-- Tagged "Sun, 06 Nov 1994 08:49:37 GMT"+data HTTP++-- |The proxy for conversions between ANSI HTTP/1.1 date and time+-- strings and 'UTCTime'.+http ∷ Proxy HTTP+{-# INLINE CONLIKE http #-}+http = Proxy++instance ConvertSuccess UTCTime (Tagged HTTP Ascii) where+ {-# INLINE convertSuccess #-}+ convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs++instance ConvertSuccess UTCTime (Tagged HTTP AsciiBuilder) where+ {-# INLINE convertSuccess #-}+ convertSuccess = Tagged ∘ toAsciiBuilder++instance ConvertAttempt (Tagged HTTP Ascii) UTCTime where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' httpDateAndTime ∘ untag++-- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850+-- and ANSI C's asctime() formats.+--+-- This function is even more permissive than what HTTP\/1.1 (RFC+-- 2616) 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 though.+httpDateAndTime ∷ Parser UTCTime+httpDateAndTime+ = choice [ zonedTimeToUTC <$> try rfc1123DateAndTime+ , zonedTimeToUTC <$> try rfc733DateAndTime+ , zonedTimeToUTC <$> try rfc822DateAndTime+ , localTimeToUTC utc <$> cDateAndTime+ ]++toAsciiBuilder ∷ UTCTime → AsciiBuilder+{-# INLINE toAsciiBuilder #-}+toAsciiBuilder = flip proxy rfc1123 ∘ cs ∘ ut2zt+ where+ ut2zt ∷ UTCTime → ZonedTime+ {-# INLINE ut2zt #-}+ ut2zt = utcToZonedTime gmt++ gmt ∷ TimeZone+ {-# INLINE CONLIKE gmt #-}+ gmt = TimeZone 0 False "GMT"++deriveAttempts [ ([t| UTCTime |], [t| Tagged HTTP Ascii |])+ , ([t| UTCTime |], [t| Tagged HTTP AsciiBuilder |])+ ]
+ Data/Time/Format/HTTP/Common.hs view
@@ -0,0 +1,363 @@+{-# LANGUAGE+ OverloadedStrings+ , UnicodeSyntax+ #-}+module Data.Time.Format.HTTP.Common+ ( shortWeekDayName+ , shortWeekDayNameP++ , longWeekDayName+ , longWeekDayNameP++ , shortMonthName+ , shortMonthNameP++ , longMonthName+ , longMonthNameP++ , show4+ , show2+ , show2'++ , read4+ , read2+ , read2'++ , show4digitsTZ+ , read4digitsTZ++ , assertWeekDayIsGood+ , assertGregorianDateIsGood+ , assertTimeOfDayIsGood++ , optionMaybe+ , finishOff++ , parseAttempt+ , parseAttempt'+ )+ where+import Blaze.ByteString.Builder.ByteString as B+import Blaze.Text.Int as BT+import Control.Applicative+import Control.Exception.Base+import Control.Monad+import Control.Monad.Unicode+import Data.Ascii (Ascii, AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attempt+import Data.Attoparsec.Char8 as P+import Data.ByteString (ByteString)+import Data.Char+import Data.Monoid.Unicode+import Data.Fixed+import Data.Time+import Data.Time.Calendar.WeekDate+import Prelude.Unicode++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 ∷ Num n ⇒ Parser n+{-# INLINEABLE shortWeekDayNameP #-}+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 ∷ 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 ∷ Num n ⇒ Parser n+{-# INLINEABLE longWeekDayNameP #-}+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 ∷ 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 ∷ Num n ⇒ Parser n+{-# INLINEABLE shortMonthNameP #-}+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 ∷ 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 ∷ Num n ⇒ Parser n+{-# INLINEABLE longMonthNameP #-}+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 → 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 → 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)++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 ∷ Num n ⇒ Parser n+{-# INLINEABLE read2 #-}+read2 = do n1 ← digit'+ n2 ← digit'+ return (n1 * 10 + n2)++read2' ∷ Num n ⇒ Parser n+{-# INLINEABLE read2' #-}+read2' = do n1 ← (char ' ' *> pure 0) <|> digit'+ n2 ← digit'+ return (n1 * 10 + n2)++digit' ∷ Num n ⇒ Parser n+{-# INLINE digit' #-}+digit' = fromIntegral <$> fromC <$> P.digit+ where+ {-# INLINE fromC #-}+ fromC c = ord c - ord '0'++show4digitsTZ ∷ TimeZone → AsciiBuilder+{-# INLINEABLE show4digitsTZ #-}+show4digitsTZ tz+ = case timeZoneMinutes tz of+ 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++read4digitsTZ ∷ Parser TimeZone+{-# INLINEABLE read4digitsTZ #-}+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 ∷ 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 "+ , 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+ ]+ Just gregDay+ → return gregDay++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+ ]+ Just tod+ → return tod++optionMaybe ∷ Alternative f ⇒ f a → f (Maybe a)+{-# INLINE optionMaybe #-}+optionMaybe p+ = option Nothing (Just <$> p)++finishOff ∷ Parser α → Parser α+{-# INLINE finishOff #-}+finishOff = ((endOfInput *>) ∘ return =≪)++parseAttempt ∷ Exception e+ ⇒ (String → e)+ → Parser α+ → ByteString+ → Attempt α+{-# INLINEABLE parseAttempt #-}+parseAttempt f p bs+ = case parseOnly (finishOff p) bs of+ Right α → Success α+ Left e → Failure $ f e++parseAttempt' ∷ Parser α → Ascii → Attempt α+{-# INLINE parseAttempt' #-}+parseAttempt' = (∘ A.toByteString) ∘ parseAttempt StringException
+ Data/Time/Format/RFC1123.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , UnicodeSyntax+ #-}+-- |This module provides functions to parse and format RFC 1123 date+-- and time strings (<http://tools.ietf.org/html/rfc1123#page-55>).+--+-- The format is basically the same as RFC 822, but the syntax for+-- @date@ is changed from:+--+-- > year ::= 2DIGIT+--+-- to:+--+-- > year ::= 4DIGIT+module Data.Time.Format.RFC1123+ ( RFC1123+ , rfc1123+ , rfc1123DateAndTime+ )+ where+import Control.Applicative+import Data.Ascii (Ascii, AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Convertible.Base+import Data.Monoid.Unicode+import Data.Proxy+import Data.Tagged+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.Format.HTTP.Common+import Data.Time.Format.RFC822.Internal+import Prelude.Unicode++-- |The phantom type for conversions between RFC 1123 date and time+-- strings and 'ZonedTime'.+--+-- >>> convertSuccess (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc)+-- Tagged "Sun, 06 Nov 1994 08:49:37 GMT"+data RFC1123++-- |The proxy for conversions between RFC 1123 date and time strings+-- and 'ZonedTime'.+rfc1123 ∷ Proxy RFC1123+{-# INLINE CONLIKE rfc1123 #-}+rfc1123 = Proxy++instance ConvertSuccess ZonedTime (Tagged RFC1123 Ascii) where+ {-# INLINE convertSuccess #-}+ convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs++instance ConvertSuccess ZonedTime (Tagged RFC1123 AsciiBuilder) where+ {-# INLINE convertSuccess #-}+ convertSuccess = Tagged ∘ toAsciiBuilder++instance ConvertAttempt (Tagged RFC1123 Ascii) ZonedTime where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' rfc1123DateAndTime ∘ untag++-- |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++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 " "+ ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)++deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC1123 Ascii |])+ , ([t| ZonedTime |], [t| Tagged RFC1123 AsciiBuilder |])+ ]
+ Data/Time/Format/RFC733.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , UnicodeSyntax+ #-}+-- |This module provides functions to parse and format RFC 733 date+-- and time strings (<http://tools.ietf.org/html/rfc733#appendix-E>).+--+-- 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.Format.RFC733+ ( RFC733+ , rfc733+ , rfc733DateAndTime+ )+ where+import Control.Applicative+import Data.Ascii (Ascii, AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Convertible.Base+import Data.Monoid.Unicode+import Data.Proxy+import Data.Tagged+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.Format.HTTP.Common+import Data.Time.Format.RFC822.Internal+import Prelude.Unicode++-- |The phantom type for conversions between RFC 733 date and time+-- strings and 'ZonedTime'.+--+-- >>> convertSuccess (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc)+-- Tagged "Sunday, 06-Nov-1994 08:49:37 GMT"+data RFC733++-- |The proxy for conversions between RFC 733 date and time strings+-- and 'ZonedTime'.+rfc733 ∷ Proxy RFC733+{-# INLINE CONLIKE rfc733 #-}+rfc733 = Proxy++instance ConvertSuccess ZonedTime (Tagged RFC733 Ascii) where+ {-# INLINE convertSuccess #-}+ convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs++instance ConvertSuccess ZonedTime (Tagged RFC733 AsciiBuilder) where+ {-# INLINE convertSuccess #-}+ convertSuccess = Tagged ∘ toAsciiBuilder++instance ConvertAttempt (Tagged RFC733 Ascii) ZonedTime where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' rfc733DateAndTime ∘ untag++-- |Parse an RFC 733 date and time string.+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+ ]++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 " "+ ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)++deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC733 Ascii |])+ , ([t| ZonedTime |], [t| Tagged RFC733 AsciiBuilder |])+ ]
+ Data/Time/Format/RFC822.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE+ UnicodeSyntax+ #-}+-- |This module provides functions to parse and format RFC 822 date+-- and time strings (<http://tools.ietf.org/html/rfc822#section-5>).+--+-- 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.Format.RFC822+ ( RFC822+ , rfc822+ , rfc822DateAndTime+ )+ where+import Data.Proxy+import Data.Time.Format.RFC822.Internal++-- |The proxy for conversions between RFC 822 date and time strings+-- and 'ZonedTime'.+rfc822 ∷ Proxy RFC822+{-# INLINE CONLIKE rfc822 #-}+rfc822 = Proxy
+ Data/Time/Format/RFC822/Internal.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , UnicodeSyntax+ #-}+module Data.Time.Format.RFC822.Internal+ ( RFC822+ , rfc822DateAndTime+ , rfc822Time+ )+ where+import Control.Applicative+import Data.Ascii (Ascii, AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Convertible.Base+import Data.Monoid.Unicode+import Data.Tagged+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.Format.HTTP.Common+import Prelude.Unicode++-- |The phantom type for conversions between RFC 822 date and time+-- strings and 'ZonedTime'.+--+-- >>> convertSuccess (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc)+-- Tagged "Sun, 06 Nov 94 08:49:37 GMT"+data RFC822++instance ConvertSuccess ZonedTime (Tagged RFC822 Ascii) where+ {-# INLINE convertSuccess #-}+ convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs++instance ConvertSuccess ZonedTime (Tagged RFC822 AsciiBuilder) where+ {-# INLINE convertSuccess #-}+ convertSuccess = Tagged ∘ toAsciiBuilder++instance ConvertSuccess TimeZone (Tagged RFC822 Ascii) where+ {-# INLINE convertSuccess #-}+ convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs++instance ConvertSuccess TimeZone (Tagged RFC822 AsciiBuilder) where+ {-# INLINE convertSuccess #-}+ convertSuccess tz+ | timeZoneMinutes tz ≡ 0 = Tagged $ A.toAsciiBuilder "GMT"+ | otherwise = Tagged $ show4digitsTZ tz++instance ConvertAttempt (Tagged RFC822 Ascii) ZonedTime where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' rfc822DateAndTime ∘ untag++-- |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++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+ ]++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 " "+ ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)++deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC822 Ascii |])+ , ([t| ZonedTime |], [t| Tagged RFC822 AsciiBuilder |])+ , ([t| TimeZone |], [t| Tagged RFC822 Ascii |])+ , ([t| TimeZone |], [t| Tagged RFC822 AsciiBuilder |])+ ]
− Data/Time/HTTP.hs
@@ -1,77 +0,0 @@-{-# LANGUAGE- UnicodeSyntax- #-}--- |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- ( -- * Formatting- toAscii- , toAsciiBuilder-- -- * Parsing- , fromAscii- , httpDateAndTime- )- where-import Data.Ascii (Ascii)-import qualified Data.Ascii as A-import qualified Data.Attoparsec.Char8 as P-import Data.Time-import Data.Time.HTTP.Internal-import Prelude.Unicode---- |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 @'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.-fromAscii ∷ Ascii → Either String UTCTime-fromAscii = P.parseOnly p ∘ A.toByteString- where- p = do zt ← httpDateAndTime- P.endOfInput- return zt
− Data/Time/HTTP/Common.hs
@@ -1,334 +0,0 @@-{-# LANGUAGE- OverloadedStrings- , UnicodeSyntax- #-}-module Data.Time.HTTP.Common- ( shortWeekDayName- , shortWeekDayNameP-- , longWeekDayName- , longWeekDayNameP-- , shortMonthName- , shortMonthNameP-- , longMonthName- , longMonthNameP-- , show4- , show2- , show2'-- , read4- , read2- , read2'-- , show4digitsTZ- , read4digitsTZ-- , 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 Prelude.Unicode--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 ∷ Num n ⇒ Parser n-{-# INLINEABLE shortWeekDayNameP #-}-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 ∷ 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 ∷ Num n ⇒ Parser n-{-# INLINEABLE longWeekDayNameP #-}-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 ∷ 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 ∷ Num n ⇒ Parser n-{-# INLINEABLE shortMonthNameP #-}-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 ∷ 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 ∷ Num n ⇒ Parser n-{-# INLINEABLE longMonthNameP #-}-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 → 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 → 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)--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 ∷ Num n ⇒ Parser n-{-# INLINEABLE read2 #-}-read2 = do n1 ← digit'- n2 ← digit'- return (n1 * 10 + n2)--read2' ∷ Num n ⇒ Parser n-{-# INLINEABLE read2' #-}-read2' = do n1 ← (char ' ' *> pure 0) <|> digit'- n2 ← digit'- return (n1 * 10 + n2)--digit' ∷ Num n ⇒ Parser n-{-# INLINE digit' #-}-digit' = fromIntegral <$> fromC <$> P.digit- where- {-# INLINE fromC #-}- fromC c = ord c - ord '0'--show4digitsTZ ∷ TimeZone → AsciiBuilder-show4digitsTZ tz- = case timeZoneMinutes tz of- 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--read4digitsTZ ∷ Parser 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 ∷ 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 "- , 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- ]- Just gregDay- → return gregDay--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- ]- Just tod- → return tod--optionMaybe ∷ Alternative f ⇒ f a → f (Maybe a)-{-# INLINE optionMaybe #-}-optionMaybe p- = option Nothing (Just <$> p)
− Data/Time/HTTP/Internal.hs
@@ -1,36 +0,0 @@-{-# 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/RFC1123.hs
@@ -1,43 +0,0 @@-{-# LANGUAGE- UnicodeSyntax- #-}--- |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- ( -- * Formatting- toAscii- , toAsciiBuilder-- -- * Parsing- , fromAscii- , rfc1123DateAndTime- )- where-import Data.Ascii (Ascii)-import qualified Data.Ascii as A-import qualified Data.Attoparsec.Char8 as P-import Data.Time-import Data.Time.RFC1123.Internal-import Prelude.Unicode---- |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 @'Left' err@.-fromAscii ∷ Ascii → Either String ZonedTime-fromAscii = P.parseOnly p ∘ A.toByteString- where- p = do zt ← rfc1123DateAndTime- P.endOfInput- return zt
− Data/Time/RFC1123/Internal.hs
@@ -1,72 +0,0 @@-{-# 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/RFC733.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE- UnicodeSyntax- #-}--- |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- ( -- * Formatting- toAscii- , toAsciiBuilder-- -- * Parsing- , fromAscii- , rfc733DateAndTime- )- where-import Data.Ascii (Ascii)-import qualified Data.Ascii as A-import qualified Data.Attoparsec.Char8 as P-import Data.Time-import Data.Time.RFC733.Internal-import Prelude.Unicode---- |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 @'Left' err@.-fromAscii ∷ Ascii → Either String ZonedTime-fromAscii = P.parseOnly p ∘ A.toByteString- where- p = do zt ← rfc733DateAndTime- P.endOfInput- return zt
− Data/Time/RFC733/Internal.hs
@@ -1,139 +0,0 @@-{-# 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/RFC822.hs
@@ -1,61 +0,0 @@-{-# LANGUAGE- UnicodeSyntax- #-}--- |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- ( -- * Formatting- toAscii- , toAsciiBuilder-- -- * Parsing- , fromAscii- , rfc822DateAndTime- )- where-import Data.Ascii (Ascii)-import qualified Data.Ascii as A-import qualified Data.Attoparsec.Char8 as P-import Data.Time-import Data.Time.RFC822.Internal-import Prelude.Unicode---- |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 @'Left' err@.-fromAscii ∷ Ascii → Either String ZonedTime-fromAscii = P.parseOnly p ∘ A.toByteString- where- p = do zt ← rfc822DateAndTime- P.endOfInput- return zt
− Data/Time/RFC822/Internal.hs
@@ -1,121 +0,0 @@-{-# 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
time-http.cabal view
@@ -1,9 +1,10 @@ Name: time-http-Version: 0.2+Version: 0.3 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).+ various Date and Time formats allowed in HTTP\/1.1+ (<http://tools.ietf.org/html/rfc2616#section-3.3>). Homepage: http://cielonegro.org/HTTPDateTime.html Bug-Reports: http://static.cielonegro.org/ditz/time-http/@@ -26,27 +27,27 @@ Library Exposed-modules:- Data.Time.Asctime- Data.Time.HTTP- Data.Time.RFC1123- Data.Time.RFC733- Data.Time.RFC822+ Data.Time.Format.C+ Data.Time.Format.RFC733+ Data.Time.Format.RFC822+ Data.Time.Format.RFC1123+ Data.Time.Format.HTTP 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+ Data.Time.Format.HTTP.Common+ Data.Time.Format.RFC822.Internal Build-depends: ascii == 0.0.*,+ attempt == 0.3.*, attoparsec == 0.9.*,- blaze-builder == 0.3.*,- blaze-textual == 0.2.*, base == 4.*, base-unicode-symbols == 0.2.*,+ blaze-builder == 0.3.*,+ blaze-textual == 0.2.*,+ bytestring == 0.9.*,+ convertible-text == 0.4.*,+ tagged == 0.2.*, time == 1.2.* Default-Language:@@ -57,16 +58,20 @@ Test-Suite test-time-http Type: exitcode-stdio-1.0- Main-Is: Test/Time/HTTP.hs+ Main-Is: Test/Time/Format/HTTP.hs Default-Language: Haskell2010 Build-depends: QuickCheck == 2.4.*, ascii == 0.0.*,+ attempt == 0.3.*, attoparsec == 0.9.*,- blaze-builder == 0.3.*,- blaze-textual == 0.2.*, base == 4.*, base-unicode-symbols == 0.2.*,+ blaze-builder == 0.3.*,+ blaze-textual == 0.2.*,+ bytestring == 0.9.*,+ convertible-text == 0.4.*,+ tagged == 0.2.*, time == 1.2.* GHC-Options: -Wall -fno-warn-orphans