time-http 0.1.0.1 → 0.5
raw patch · 19 files changed
Files
- ChangeLog +9/−0
- Data/Time/Asctime.hs +0/−65
- Data/Time/Asctime/Parsec.hs +0/−34
- Data/Time/Format/C.hs +106/−0
- Data/Time/Format/HTTP.hs +121/−0
- Data/Time/Format/HTTP/Common.hs +363/−0
- Data/Time/Format/RFC1123.hs +116/−0
- Data/Time/Format/RFC733.hs +205/−0
- Data/Time/Format/RFC822.hs +187/−0
- Data/Time/HTTP.hs +0/−75
- Data/Time/HTTP/Common.hs +0/−276
- Data/Time/HTTP/Parsec.hs +0/−21
- Data/Time/RFC1123.hs +0/−61
- Data/Time/RFC1123/Parsec.hs +0/−42
- Data/Time/RFC733.hs +0/−88
- Data/Time/RFC733/Parsec.hs +0/−107
- Data/Time/RFC822.hs +0/−88
- Data/Time/RFC822/Parsec.hs +0/−85
- time-http.cabal +56/−20
+ ChangeLog view
@@ -0,0 +1,9 @@+== time-http-0.5 / 2012-01-03+* Use data-default to provide default parsers.+== time-http-0.4 / 2011-12-16+* bugfix: Don't forget that conversion from ZonedTime to RFC-822 date and time can fail, due to its Y2K problem.+== 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,65 +0,0 @@--- |This module provides functions for ANSI C's asctime() format.------ ANSI C's asctime() format looks like:------ @Wdy Mon DD HH:MM:SS YYYY@------ The exact syntax is as follows:------ > date-time ::= wday SP month SP day SP time SP year--- > wday ::= "Mon" | "Tue" | "Wed" | "Thu"--- > | "Fri" | "Sat" | "Sun"--- > month ::= "Jan" | "Feb" | "Mar" | "Apr"--- > | "May" | "Jun" | "Jul" | "Aug"--- > | "Sep" | "Oct" | "Nov" | "Dec"--- > day ::= 2DIGIT--- > time ::= 2DIGIT ':' 2DIGIT [':' 2DIGIT]--- > year ::= 4DIGIT------ As you can see, it has no time zone info. "Data.Time.HTTP" will--- treat it as UTC.-module Data.Time.Asctime- ( format- , parse- )- where--import qualified Text.Parsec as P--import Data.Time-import Data.Time.Calendar.WeekDate-import Data.Time.HTTP.Common-import Data.Time.Asctime.Parsec---- |Format a 'LocalTime' in the ANSI C's asctime() way.-format :: LocalTime -> String-format localTime- = let (year, month, day) = toGregorian (localDay localTime)- (_, _, week) = toWeekDate (localDay localTime)- timeOfDay = localTimeOfDay localTime- in- concat [ shortWeekDayName week- , ", "- , shortMonthName month- , " "- , show2 day- , " "- , show2 (todHour timeOfDay)- , ":"- , show2 (todMin timeOfDay)- , ":"- , show2 (floor (todSec timeOfDay))- , " "- , show4 year- ]---- |Parse an ANSI C's asctime() format to 'LocalTime'. When the string--- can't be parsed, it returns 'Nothing'.-parse :: String -> Maybe LocalTime-parse src = case P.parse p "" src of- Right zt -> Just zt- Left _ -> Nothing- where- p = do zt <- asctime- _ <- P.eof- return zt
− Data/Time/Asctime/Parsec.hs
@@ -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/Format/C.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , TypeSynonymInstances+ , 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+ )+ where+import Data.Ascii (Ascii, AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Convertible.Base+import Data.Default+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 ANSI C's date and time+-- strings and 'LocalTime'.+--+-- >>> convertSuccess (Tagged (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) :: Tagged C LocalTime)+-- "Sun Nov 6 08:49:37 1994"+data C++instance ConvertSuccess (Tagged C LocalTime) Ascii where+ {-# INLINE convertSuccess #-}+ convertSuccess = A.fromAsciiBuilder ∘ cs++instance ConvertSuccess (Tagged C LocalTime) AsciiBuilder where+ {-# INLINE convertSuccess #-}+ convertSuccess = toAsciiBuilder ∘ untag++instance ConvertAttempt Ascii (Tagged C LocalTime) where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' def++-- |Parse an ANSI C's date and time string.+instance Default (Parser (Tagged C LocalTime)) where+ {-# INLINEABLE def #-}+ def = 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 ∘ Tagged $ 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| Tagged C LocalTime |], [t| Ascii |])+ , ([t| Tagged C LocalTime |], [t| AsciiBuilder |])+ ]
+ Data/Time/Format/HTTP.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , TypeSynonymInstances+ , 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+ )+ 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.Default+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 (Tagged (UTCTime (ModifiedJulianDay 49662) 31777) :: Tagged HTTP UTCTime)+-- "Sun, 06 Nov 1994 08:49:37 GMT"+data HTTP++instance ConvertSuccess (Tagged HTTP UTCTime) Ascii where+ {-# INLINE convertSuccess #-}+ convertSuccess = A.fromAsciiBuilder ∘ cs++instance ConvertSuccess (Tagged HTTP UTCTime) AsciiBuilder where+ {-# INLINE convertSuccess #-}+ convertSuccess = toAsciiBuilder++instance ConvertAttempt Ascii (Tagged HTTP UTCTime) where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' def++-- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850+-- and ANSI C's asctime() formats.+--+-- This parser 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.+instance Default (Parser (Tagged HTTP UTCTime)) where+ {-# INLINEABLE def #-}+ def = Tagged+ <$>+ choice [ (zonedTimeToUTC ∘ untag) <$> try (def ∷ Parser (Tagged RFC1123 ZonedTime))+ , (zonedTimeToUTC ∘ untag) <$> try (def ∷ Parser (Tagged RFC733 ZonedTime))+ , (zonedTimeToUTC ∘ untag) <$> try (def ∷ Parser (Tagged RFC822 ZonedTime))+ , (localTimeToUTC utc ∘ untag) <$> (def ∷ Parser (Tagged C LocalTime))+ ]++toAsciiBuilder ∷ Tagged HTTP UTCTime → AsciiBuilder+{-# INLINEABLE toAsciiBuilder #-}+toAsciiBuilder = cs ∘ (ut2zt <$>) ∘ retag'+ where+ ut2zt ∷ UTCTime → ZonedTime+ {-# INLINE ut2zt #-}+ ut2zt = utcToZonedTime gmt++ gmt ∷ TimeZone+ {-# INLINE CONLIKE gmt #-}+ gmt = TimeZone 0 False "GMT"++ retag' ∷ Tagged τ α → Tagged RFC1123 α+ {-# INLINE retag' #-}+ retag' = retag++deriveAttempts [ ([t| Tagged HTTP UTCTime |], [t| Ascii |])+ , ([t| Tagged HTTP UTCTime |], [t| 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,116 @@+{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , TypeSynonymInstances+ , 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+ )+ where+import Control.Applicative+import Control.Applicative.Unicode+import Data.Ascii (Ascii, AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Convertible.Base+import Data.Default+import Data.Monoid.Unicode+import Data.Tagged+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.Format.HTTP.Common+import Data.Time.Format.RFC822+import Prelude.Unicode++-- |The phantom type for conversions between RFC 1123 date and time+-- strings and 'ZonedTime'.+--+-- >>> convertSuccess (Tagged (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc) :: Tagged RFC1123 ZonedTime)+-- "Sun, 06 Nov 1994 08:49:37 GMT"+data RFC1123++instance ConvertSuccess (Tagged RFC1123 ZonedTime) Ascii where+ {-# INLINE convertSuccess #-}+ convertSuccess = A.fromAsciiBuilder ∘ cs++instance ConvertSuccess (Tagged RFC1123 ZonedTime) AsciiBuilder where+ {-# INLINE convertSuccess #-}+ convertSuccess = toAsciiBuilder++instance ConvertAttempt Ascii (Tagged RFC1123 ZonedTime) where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' def++-- |Parse an RFC 1123 date and time string.+instance Default (Parser (Tagged RFC1123 ZonedTime)) where+ def = do weekDay ← optionMaybe $+ do w ← shortWeekDayNameP+ string ", " *> pure w+ gregDay ← date+ case weekDay of+ Nothing+ → return ()+ Just givenWD+ → assertWeekDayIsGood givenWD gregDay+ tod ← def+ tz ← char ' ' *> def+ let lt = LocalTime gregDay <$> tod+ zt = ZonedTime <$> lt ⊛ tz+ pure $ retag' zt+ where+ retag' ∷ Tagged RFC822 α → Tagged τ α+ retag' = retag++date ∷ Parser Day+date = do day ← read2+ _ ← char ' '+ month ← shortMonthNameP+ _ ← char ' '+ year ← read4+ _ ← char ' '+ assertGregorianDateIsGood year month day++toAsciiBuilder ∷ Tagged RFC1123 ZonedTime → AsciiBuilder+toAsciiBuilder zonedTime+ = let localTime = zonedTimeToLocalTime $ untag zonedTime+ timeZone = zonedTimeZone <$> retag' 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 " "+ ⊕ cs timeZone+ where+ retag' ∷ Tagged τ α → Tagged RFC822 α+ retag' = retag++deriveAttempts [ ([t| Tagged RFC1123 ZonedTime |], [t| Ascii |])+ , ([t| Tagged RFC1123 ZonedTime |], [t| AsciiBuilder |])+ ]
+ Data/Time/Format/RFC733.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , TypeSynonymInstances+ , 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+ )+ 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.Default+import Data.Monoid.Unicode+import Data.Tagged+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.Format.HTTP.Common+import Data.Time.Format.RFC822+import Prelude.Unicode++-- |The phantom type for conversions between RFC 733 date and time+-- strings and 'ZonedTime'.+--+-- >>> convertSuccess (Tagged (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc) :: Tagged RFC733 ZonedTime)+-- "Sunday, 06-Nov-1994 08:49:37 GMT"+data RFC733++instance ConvertSuccess (Tagged RFC733 ZonedTime) Ascii where+ {-# INLINE convertSuccess #-}+ convertSuccess = A.fromAsciiBuilder ∘ cs++instance ConvertSuccess (Tagged RFC733 ZonedTime) AsciiBuilder where+ {-# INLINE convertSuccess #-}+ convertSuccess = toAsciiBuilder++instance ConvertAttempt Ascii (Tagged RFC733 ZonedTime) where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' def++-- |Parse an RFC 733 date and time string.+instance Default (Parser (Tagged RFC733 ZonedTime)) where+ def = do weekDay ← optionMaybe $+ do w ← longWeekDayNameP+ <|>+ shortWeekDayNameP+ string ", " *> pure 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+ pure $ Tagged 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 ∷ Tagged RFC733 ZonedTime → AsciiBuilder+toAsciiBuilder zonedTime+ = let localTime = zonedTimeToLocalTime $ untag zonedTime+ timeZone = zonedTimeZone <$> retag' 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 " "+ ⊕ cs timeZone+ where+ retag' ∷ Tagged τ α → Tagged RFC822 α+ retag' = retag++deriveAttempts [ ([t| Tagged RFC733 ZonedTime |], [t| Ascii |])+ , ([t| Tagged RFC733 ZonedTime |], [t| AsciiBuilder |])+ ]
+ Data/Time/Format/RFC822.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE+ DeriveDataTypeable+ , FlexibleContexts+ , FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , TemplateHaskell+ , TypeSynonymInstances+ , 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+ )+ where+import Control.Applicative+import Control.Applicative.Unicode+import Control.Failure+import Data.Ascii (Ascii, AsciiBuilder)+import qualified Data.Ascii as A+import Data.Attoparsec.Char8+import Data.Convertible.Base+import Data.Convertible.Utils+import Data.Default+import Data.Monoid.Unicode+import Data.Tagged+import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.Format.HTTP.Common+import Data.Typeable+import Prelude.Unicode++-- |The phantom type for conversions between RFC 822 date and time+-- strings and 'ZonedTime'.+--+-- >>> convertAttempt (Tagged (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc) :: Tagged RFC822 ZonedTime)+-- Success "Sun, 06 Nov 94 08:49:37 GMT"+--+-- Note that RFC 822 has a Y2K problem so converting 'ZonedTime' whose+-- gregorian year is earlier than 1900 or from 2000 onward results in+-- @'ConvertBoundsException' 'Day' ('Tagged' RFC822 'ZonedTime')@.+data RFC822+ deriving Typeable++instance ConvertAttempt (Tagged RFC822 ZonedTime) Ascii where+ {-# INLINE convertAttempt #-}+ convertAttempt = (A.fromAsciiBuilder <$>) ∘ ca++instance ConvertAttempt (Tagged RFC822 ZonedTime) AsciiBuilder where+ {-# INLINE convertAttempt #-}+ convertAttempt = toAsciiBuilder++instance ConvertSuccess (Tagged RFC822 TimeZone) Ascii where+ {-# INLINE convertSuccess #-}+ convertSuccess = A.fromAsciiBuilder ∘ cs++instance ConvertSuccess (Tagged RFC822 TimeZone) AsciiBuilder where+ {-# INLINE convertSuccess #-}+ convertSuccess (Tagged tz)+ | timeZoneMinutes tz ≡ 0 = A.toAsciiBuilder "GMT"+ | otherwise = show4digitsTZ tz++instance ConvertAttempt Ascii (Tagged RFC822 ZonedTime) where+ {-# INLINE convertAttempt #-}+ convertAttempt = parseAttempt' def++-- |Parse an RFC 822 date and time string.+instance Default (Parser (Tagged RFC822 ZonedTime)) where+ def = do weekDay ← optionMaybe $+ do w ← shortWeekDayNameP+ string ", " *> pure w+ gregDay ← date+ case weekDay of+ Nothing+ → return ()+ Just givenWD+ → assertWeekDayIsGood givenWD gregDay+ tod ← def+ timeZone ← char ' ' *> def+ let lt = LocalTime gregDay <$> tod+ zt = ZonedTime <$> lt ⊛ timeZone+ return zt++date ∷ Parser Day+date = do day ← read2+ month ← char ' ' *> shortMonthNameP+ year ← char ' ' *> ((+ 1900) <$> read2)+ char ' ' *> assertGregorianDateIsGood year month day++instance Default (Parser (Tagged RFC822 TimeOfDay)) where+ {-# INLINEABLE def #-}+ def = do hour ← read2+ minute ← char ':' *> read2+ second ← option 0 (char ':' *> read2)+ Tagged <$> assertTimeOfDayIsGood hour minute second++instance Default (Parser (Tagged RFC822 TimeZone)) where+ def = choice [ string "UT" *> pure (Tagged (TimeZone 0 False "UT" ))+ , string "GMT" *> pure (Tagged (TimeZone 0 False "GMT"))+ , char 'E'+ *> choice [ string "ST" *> pure (Tagged (TimeZone ((-5) * 60) False "EST"))+ , string "DT" *> pure (Tagged (TimeZone ((-4) * 60) True "EDT"))+ ]+ , char 'C'+ *> choice [ string "ST" *> pure (Tagged (TimeZone ((-6) * 60) False "CST"))+ , string "DT" *> pure (Tagged (TimeZone ((-5) * 60) True "CDT"))+ ]+ , char 'M'+ *> choice [ string "ST" *> pure (Tagged (TimeZone ((-7) * 60) False "MST"))+ , string "DT" *> pure (Tagged (TimeZone ((-6) * 60) True "MDT"))+ , pure (Tagged (TimeZone ((-12) * 60) False "M"))+ ]+ , char 'P'+ *> choice [ string "ST" *> pure (Tagged (TimeZone ((-8) * 60) False "PST"))+ , string "DT" *> pure (Tagged (TimeZone ((-7) * 60) True "PDT"))+ ]+ , char 'Z' *> pure (Tagged (TimeZone 0 False "Z"))+ , char 'A' *> pure (Tagged (TimeZone ((-1) * 60) False "A"))+ , char 'N' *> pure (Tagged (TimeZone ( 1 * 60) False "N"))+ , char 'Y' *> pure (Tagged (TimeZone ( 12 * 60) False "Y"))+ , Tagged <$> read4digitsTZ+ ]++toAsciiBuilder ∷ Failure (ConvertBoundsException Day (Tagged RFC822 ZonedTime)) f+ ⇒ Tagged RFC822 ZonedTime+ → f AsciiBuilder+toAsciiBuilder zonedTime+ = let localTime = zonedTimeToLocalTime $ untag zonedTime+ timeZone = zonedTimeZone <$> zonedTime+ (year, month, day) = toGregorian (localDay localTime)+ (_, _, week) = toWeekDate (localDay localTime)+ timeOfDay = localTimeOfDay localTime+ in+ if year < 1900 ∨ year ≥ 2000 then+ let minDay = fromGregorian 1900 1 1+ maxDay = fromGregorian 1999 12 31+ in+ failure $ ConvertBoundsException minDay maxDay zonedTime+ else+ return $+ 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 " "+ ⊕ cs timeZone++deriveAttempts [ ([t| Tagged RFC822 TimeZone |], [t| Ascii |])+ , ([t| Tagged RFC822 TimeZone |], [t| AsciiBuilder |])+ ]
− Data/Time/HTTP.hs
@@ -1,75 +0,0 @@--- |This module provides functions to parse and format HTTP\/1.1 date--- and time formats.------ The HTTP\/1.1 specification (RFC 2616) says that HTTP\/1.1 clients--- and servers which parse the date value MUST accept all the--- following formats, though they MUST only generate the RFC 1123--- format for representing HTTP-date values in header fields:------ > Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123--- > Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036--- > Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() format------ It also says that all HTTP date\/time stamps MUST be represented in--- Greenwich Mean Time (GMT), without exception. For the purposes of--- HTTP, GMT is exactly equal to UTC (Coordinated Universal--- Time). This is indicated in the first two formats by the inclusion--- of @\"GMT\"@ as the three-letter abbreviation for time zone, and--- MUST be assumed when reading the asctime format.------ > HTTP-date = rfc1123-date | rfc850-date | asctime-date--- > rfc1123-date = wkday "," SP date1 SP time SP "GMT"--- > rfc850-date = weekday "," SP date2 SP time SP "GMT"--- > asctime-date = wkday SP date3 SP time SP 4DIGIT--- > date1 = 2DIGIT SP month SP 4DIGIT--- > ; day month year (e.g., 02 Jun 1982)--- > date2 = 2DIGIT "-" month "-" 2DIGIT--- > ; day-month-year (e.g., 02-Jun-82)--- > date3 = month SP ( 2DIGIT | ( SP 1DIGIT ))--- > ; month day (e.g., Jun 2)--- > time = 2DIGIT ":" 2DIGIT ":" 2DIGIT--- > ; 00:00:00 - 23:59:59--- > wkday = "Mon" | "Tue" | "Wed"--- > | "Thu" | "Fri" | "Sat" | "Sun"--- > weekday = "Monday" | "Tuesday" | "Wednesday"--- > | "Thursday" | "Friday" | "Saturday" | "Sunday"--- > month = "Jan" | "Feb" | "Mar" | "Apr"--- > | "May" | "Jun" | "Jul" | "Aug"--- > | "Sep" | "Oct" | "Nov" | "Dec"-module Data.Time.HTTP- ( format- , parse- )- where--import qualified Data.Time.RFC1123 as RFC1123-import qualified Text.Parsec as P--import Data.Time-import Data.Time.HTTP.Parsec---- |Format an 'UTCTime' in RFC 1123 date and time.-format :: UTCTime -> String-format utcTime- = let timeZone = TimeZone 0 False "GMT"- zonedTime = utcToZonedTime timeZone utcTime- in- RFC1123.format zonedTime---- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850--- and ANSI C's asctime() formats. When the string can't be parsed, it--- returns 'Nothing'.------ This function is even more permissive than what HTTP\/1.1--- specifies. That is, it accepts 2-digit years in RFC 822, omitted--- separator symbols in RFC 850, omitted sec fields, and non-GMT time--- zones. I believe this behavior will not cause a problem but you--- should know this.-parse :: String -> Maybe UTCTime-parse src = case P.parse p "" src of- Right ut -> Just ut- Left _ -> Nothing- where- p = do zt <- rfc2616DateAndTime- _ <- P.eof- return zt
− Data/Time/HTTP/Common.hs
@@ -1,276 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-module Data.Time.HTTP.Common- ( shortWeekDayName- , shortWeekDayNameP-- , longWeekDayName- , longWeekDayNameP-- , shortMonthName- , shortMonthNameP-- , longMonthName- , longMonthNameP-- , show2- , show4-- , read2- , read4-- , show4digitsTZ- , read4digitsTZ-- , assertWeekDayIsGood- , assertGregorianDateIsGood- , assertTimeOfDayIsGood- )- where--import Control.Monad-import Data.Fixed-import Data.Time-import Data.Time.Calendar.WeekDate-import Text.Parsec--shortWeekDayName :: Int -> String-shortWeekDayName 1 = "Mon"-shortWeekDayName 2 = "Tue"-shortWeekDayName 3 = "Wed"-shortWeekDayName 4 = "Thu"-shortWeekDayName 5 = "Fri"-shortWeekDayName 6 = "Sat"-shortWeekDayName 7 = "Sun"-shortWeekDayName n = error ("shortWeekDayName: unknown day number: " ++ show n)--shortWeekDayNameP :: Stream s m Char => ParsecT s u m Int-shortWeekDayNameP- = choice [ string "Mon" >> return 1- , char 'T'- >> choice [ string "ue" >> return 2- , string "hu" >> return 4- ]- , string "Wed" >> return 3- , string "Fri" >> return 5- , char 'S'- >> choice [ string "at" >> return 6- , string "un" >> return 7- ]- ]--longWeekDayName :: Int -> String-longWeekDayName 1 = "Monday"-longWeekDayName 2 = "Tuesday"-longWeekDayName 3 = "Wednesday"-longWeekDayName 4 = "Thursday"-longWeekDayName 5 = "Friday"-longWeekDayName 6 = "Saturday"-longWeekDayName 7 = "Sunday"--longWeekDayNameP :: Stream s m Char => ParsecT s u m Int-longWeekDayNameP- = choice [ string "Monday" >> return 1- , char 'T'- >> choice [ string "uesday" >> return 2- , string "hursday" >> return 4- ]- , string "Wednesday" >> return 3- , string "Friday" >> return 5- , char 'S'- >> choice [ string "aturday" >> return 6- , string "unday" >> return 7- ]- ]--shortMonthName :: Int -> String-shortMonthName 1 = "Jan"-shortMonthName 2 = "Feb"-shortMonthName 3 = "Mar"-shortMonthName 4 = "Apr"-shortMonthName 5 = "May"-shortMonthName 6 = "Jun"-shortMonthName 7 = "Jul"-shortMonthName 8 = "Aug"-shortMonthName 9 = "Sep"-shortMonthName 10 = "Oct"-shortMonthName 11 = "Nov"-shortMonthName 12 = "Dec"-shortMonthName n = error ("shortMonthName: unknown month number: " ++ show n)--shortMonthNameP :: Stream s m Char => ParsecT s u m Int-shortMonthNameP- = choice [ char 'J'- >> choice [ string "an" >> return 1- , char 'u'- >> choice [ char 'n' >> return 6- , char 'l' >> return 7- ]- ]- , string "Feb" >> return 2- , string "Ma"- >> choice [ char 'r' >> return 3- , char 'y' >> return 5- ]- , char 'A'- >> choice [ string "pr" >> return 4- , string "ug" >> return 8- ]- , string "Sep" >> return 9- , string "Oct" >> return 10- , string "Nov" >> return 11- , string "Dec" >> return 12- ]--longMonthName :: Int -> String-longMonthName 1 = "January"-longMonthName 2 = "February"-longMonthName 3 = "March"-longMonthName 4 = "April"-longMonthName 5 = "May"-longMonthName 6 = "June"-longMonthName 7 = "July"-longMonthName 8 = "August"-longMonthName 9 = "September"-longMonthName 10 = "October"-longMonthName 11 = "November"-longMonthName 12 = "December"-longMonthName n = error ("longMonthName: unknown month number: " ++ show n)--longMonthNameP :: Stream s m Char => ParsecT s u m Int-longMonthNameP- = choice [ char 'J'- >> choice [ string "anuary" >> return 1- , char 'u'- >> choice [ string "ne" >> return 6- , string "ly" >> return 7- ]- ]- , string "February" >> return 2- , string "Ma"- >> choice [ string "rch" >> return 3- , char 'y' >> return 5- ]- , char 'A'- >> choice [ string "pril" >> return 4- , string "ugust" >> return 8- ]- , string "September" >> return 9- , string "October" >> return 10- , string "November" >> return 11- , string "December" >> return 12- ]--show4 :: Integral i => i -> String-show4 i- | i >= 0 && i < 10 = "000" ++ show i- | i >= 0 && i < 100 = "00" ++ show i- | i >= 0 && i < 1000 = '0' : show i- | i >= 0 && i < 10000 = show i- | otherwise = error ("show4: the integer i must satisfy 0 <= i < 10000: " ++ show i)--show2 :: Integral i => i -> String-show2 i- | i >= 0 && i < 10 = '0' : show i- | i >= 0 && i < 100 = show i- | otherwise = error ("show2: the integer i must satisfy 0 <= i < 100: " ++ show i)--read4 :: (Stream s m Char, Num n) => ParsecT s u m n-read4 = do n1 <- digit'- n2 <- digit'- n3 <- digit'- n4 <- digit'- return (n1 * 1000 + n2 * 100 + n3 * 10 + n4)--read2 :: (Stream s m Char, Num n) => ParsecT s u m n-read2 = do n1 <- digit'- n2 <- digit'- return (n1 * 10 + n2)--digit' :: (Stream s m Char, Num n) => ParsecT s u m n-digit' = liftM fromC digit--fromC :: Num n => Char -> n-fromC '0' = 0-fromC '1' = 1-fromC '2' = 2-fromC '3' = 3-fromC '4' = 4-fromC '5' = 5-fromC '6' = 6-fromC '7' = 7-fromC '8' = 8-fromC '9' = 9-fromC _ = undefined--show4digitsTZ :: TimeZone -> String-show4digitsTZ tz- = case timeZoneMinutes tz of- offset | offset < 0 -> '-' : showTZ' (negate offset)- | otherwise -> '+' : showTZ' offset- where- showTZ' offset- = let h = offset `div` 60- m = offset - h * 60- in- show2 h ++ show2 m--read4digitsTZ :: Stream s m Char => ParsecT s u m TimeZone-read4digitsTZ- = do sign <- (char '+' >> return 1)- <|>- (char '-' >> return (-1))- hour <- read2- minute <- read2- let tz = TimeZone {- timeZoneMinutes = sign * (hour * 60 + minute)- , timeZoneSummerOnly = False- , timeZoneName = timeZoneOffsetString tz- }- return tz--assertWeekDayIsGood :: Stream s m t => Int -> Day -> ParsecT s u m ()-assertWeekDayIsGood givenWD gregDay- = let (_, _, correctWD ) = toWeekDate gregDay- (year, month, day) = toGregorian gregDay- in- unless (givenWD == correctWD)- $ fail- $ concat [ "Gregorian day "- , show year- , "-"- , show month- , "-"- , show day- , " is "- , longWeekDayName correctWD- , ", not "- , longWeekDayName givenWD- ]--assertGregorianDateIsGood :: Stream s m t => Integer -> Int -> Int -> ParsecT s u m Day-assertGregorianDateIsGood year month day- = case fromGregorianValid year month day of- Nothing- -> fail $ concat [ "Invalid gregorian day: "- , show year- , "-"- , show month- , "-"- , show day- ]- Just gregDay- -> return gregDay--assertTimeOfDayIsGood :: Stream s m t => Int -> Int -> Pico -> ParsecT s u m TimeOfDay-assertTimeOfDayIsGood hour minute second- = case makeTimeOfDayValid hour minute second of- Nothing- -> fail $ concat [ "Invalid time of day: "- , show hour- , ":"- , show minute- , ":"- , showFixed True second- ]- Just tod- -> return tod
− Data/Time/HTTP/Parsec.hs
@@ -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
@@ -1,61 +0,0 @@--- |This module provides functions to parse and format RFC 1123 date--- and time formats.------ The format is basically same as RFC 822, but the syntax for @date@--- is changed from:------ > year ::= 2DIGIT------ to:------ > year ::= 4DIGIT-module Data.Time.RFC1123- ( format- , parse- )- where--import qualified Text.Parsec as P--import Data.Time-import Data.Time.Calendar.WeekDate-import Data.Time.HTTP.Common-import Data.Time.RFC822 (showRFC822TimeZone)-import Data.Time.RFC1123.Parsec---- |Format a 'ZonedTime' in RFC 1123.-format :: ZonedTime -> String-format zonedTime- = let localTime = zonedTimeToLocalTime zonedTime- timeZone = zonedTimeZone zonedTime- (year, month, day) = toGregorian (localDay localTime)- (_, _, week) = toWeekDate (localDay localTime)- timeOfDay = localTimeOfDay localTime- in- concat [ shortWeekDayName week- , ", "- , show2 day- , " "- , shortMonthName month- , " "- , show4 year- , " "- , show2 (todHour timeOfDay)- , ":"- , show2 (todMin timeOfDay)- , ":"- , show2 (floor (todSec timeOfDay))- , " "- , showRFC822TimeZone timeZone- ]---- |Parse an RFC 1123 date and time string. When the string can't be--- parsed, it returns 'Nothing'.-parse :: String -> Maybe ZonedTime-parse src = case P.parse p "" src of- Right zt -> Just zt- Left _ -> Nothing- where- p = do zt <- rfc1123DateAndTime- _ <- P.eof- return zt
− Data/Time/RFC1123/Parsec.hs
@@ -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
@@ -1,88 +0,0 @@--- |This module provides functions to parse and format RFC 733 date--- and time formats.------ The syntax is as follows:------ > date-time ::= [ day-of-week ", " ] date SP time ("-" | SP) zone--- > day-of-week ::= "Monday" | "Mon" | "Tuesday" | "Tue"--- > | "Wednesday" | "Wed" | "Thursday" | "Thu"--- > | "Friday" | "Fri" | "Saturday" | "Sat"--- > | "Sunday" | "Sun"--- > date ::= day ("-" | SP) month ("-" | SP) year--- > day ::= 2DIGIT--- > year ::= 2DIGIT | 4DIGIT--- > month ::= "January" | "Jan" | "February" | "Feb"--- > | "March" | "Mar" | "April" | "Apr"--- > | "May" | "June" | "Jun"--- > | "July" | "Jul" | "August" | "Aug"--- > | "September" | "Sep" | "October" | "Oct"--- > | "November" | "Nov" | "December" | "Dec"--- > time ::= hour [ ":" ] minute [ [ ":" ] second ]--- > hour ::= 2DIGIT--- > minute ::= 2DIGIT--- > second ::= 2DIGIT--- > zone ::= "GMT" ; Universal Time--- > | "NST" ; Newfoundland: -3:30--- > | "AST" | "ADT" ; Atlantic : -4 / -3--- > | "EST" | "EDT" ; Eastern : -5 / -4--- > | "CST" | "CDT" ; Central : -6 / -5--- > | "MST" | "MDT" ; Mountain : -7 / -6--- > | "PST" | "PDT" ; Pacific : -8 / -7--- > | "YST" | "YDT" ; Yukon : -9 / -8--- > | "HST" | "HDT" ; Haw/Ala : -10 / -9--- > | "BST" | "BDT" ; Bering : -11 / -10--- > | "Z" ; GMT--- > | "A" ; -1--- > | "M" ; -12--- > | "N" ; +1--- > | "Y" ; +12--- > | ("+" | "-") 4DIGIT ; Local diff: HHMM-module Data.Time.RFC733- ( format- , parse- )- where--import qualified Text.Parsec as P--import Data.Time-import Data.Time.Calendar.WeekDate-import Data.Time.HTTP.Common-import Data.Time.RFC733.Parsec---- |Format a 'ZonedTime' in RFC 733.-format :: ZonedTime -> String-format zonedTime- = let localTime = zonedTimeToLocalTime zonedTime- timeZone = zonedTimeZone zonedTime- (year, month, day) = toGregorian (localDay localTime)- (_, _, week) = toWeekDate (localDay localTime)- timeOfDay = localTimeOfDay localTime- in- concat [ longWeekDayName week- , ", "- , show2 day- , "-"- , shortMonthName month- , "-"- , show4 year- , " "- , show2 (todHour timeOfDay)- , ":"- , show2 (todMin timeOfDay)- , ":"- , show2 (floor (todSec timeOfDay))- , "-"- , show4digitsTZ timeZone- ]---- |Parse an RFC 733 date and time string. When the string can't be--- parsed, it returns 'Nothing'.-parse :: String -> Maybe ZonedTime-parse src = case P.parse p "" src of- Right zt -> Just zt- Left _ -> Nothing- where- p = do zt <- rfc733DateAndTime- _ <- P.eof- return zt
− Data/Time/RFC733/Parsec.hs
@@ -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
@@ -1,88 +0,0 @@-{-# OPTIONS_HADDOCK prune #-}---- |This module provides functions to parse and format RFC 822 date--- and time formats.------ The syntax is as follows:------ > date-time ::= [ day-of-week ", " ] date SP time SP zone--- > day-of-week ::= "Mon" | "Tue" | "Wed" | "Thu"--- > | "Fri" | "Sat" | "Sun"--- > date ::= day SP month SP year--- > day ::= 2DIGIT--- > year ::= 2DIGIT ; Yes, only 2 digits.--- > month ::= "Jan" | "Feb" | "Mar" | "Apr"--- > | "May" | "Jun" | "Jul" | "Aug"--- > | "Sep" | "Oct" | "Nov" | "Dec"--- > time ::= hour ":" minute [ ":" second ]--- > hour ::= 2DIGIT--- > minute ::= 2DIGIT--- > second ::= 2DIGIT--- > zone ::= "UT" | "GMT" ; Universal Time--- > | "EST" | "EDT" ; Eastern : -5 / -4--- > | "CST" | "CDT" ; Central : -6 / -5--- > | "MST" | "MDT" ; Mountain: -7 / -6--- > | "PST" | "PDT" ; Pacific : -8 / -7--- > | "Z" ; UT--- > | "A" ; -1--- > | "M" ; -12--- > | "N" ; +1--- > | "Y" ; +12--- > | ("+" | "-") 4DIGIT ; Local diff: HHMM-module Data.Time.RFC822- ( format- , parse-- -- private- , showRFC822TimeZone- )- where--import qualified Text.Parsec as P--import Data.Time-import Data.Time.Calendar.WeekDate-import Data.Time.HTTP.Common-import Data.Time.RFC822.Parsec---- |Format a 'ZonedTime' in RFC 822.-format :: ZonedTime -> String-format zonedTime- = let localTime = zonedTimeToLocalTime zonedTime- timeZone = zonedTimeZone zonedTime- (year, month, day) = toGregorian (localDay localTime)- (_, _, week) = toWeekDate (localDay localTime)- timeOfDay = localTimeOfDay localTime- in- concat [ shortWeekDayName week- , ", "- , show2 day- , " "- , shortMonthName month- , " "- , show2 (year `mod` 100)- , " "- , show2 (todHour timeOfDay)- , ":"- , show2 (todMin timeOfDay)- , ":"- , show2 (floor (todSec timeOfDay))- , " "- , showRFC822TimeZone timeZone- ]--showRFC822TimeZone :: TimeZone -> String-showRFC822TimeZone tz- | timeZoneMinutes tz == 0 = "GMT"- | otherwise = show4digitsTZ tz---- |Parse an RFC 822 date and time string. When the string can't be--- parsed, it returns 'Nothing'.-parse :: String -> Maybe ZonedTime-parse src = case P.parse p "" src of- Right zt -> Just zt- Left _ -> Nothing- where- p = do zt <- rfc822DateAndTime- _ <- P.eof- return zt
− Data/Time/RFC822/Parsec.hs
@@ -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,19 +1,25 @@ Name: time-http-Version: 0.1.0.1+Version: 0.5 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/ License: PublicDomain License-file: COPYING Author: PHO <pho AT cielonegro DOT org> Maintainer: PHO <pho AT cielonegro DOT org> Stability: Experimental-Category: Web+Category: Time, 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 +27,54 @@ 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.Format.C+ Data.Time.Format.RFC733+ Data.Time.Format.RFC822+ Data.Time.Format.RFC1123+ Data.Time.Format.HTTP Other-modules:- Data.Time.HTTP.Common+ Data.Time.Format.HTTP.Common Build-depends:- base == 4.3.*,- parsec == 3.1.*,- time == 1.2.*+ ascii == 0.0.*,+ attempt == 0.3.*,+ attoparsec == 0.10.*,+ base == 4.*,+ base-unicode-symbols == 0.2.*,+ blaze-builder == 0.3.*,+ blaze-textual == 0.2.*,+ bytestring == 0.9.*,+ convertible-text == 0.4.*,+ data-default == 0.3.*,+ failure == 0.1.*,+ tagged == 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/Format/HTTP.hs+ Default-Language: Haskell2010+ Build-depends:+ QuickCheck == 2.4.*,+ ascii == 0.0.*,+ attempt == 0.3.*,+ attoparsec == 0.10.*,+ base == 4.*,+ base-unicode-symbols == 0.2.*,+ blaze-builder == 0.3.*,+ blaze-textual == 0.2.*,+ bytestring == 0.9.*,+ convertible-text == 0.4.*,+ data-default == 0.3.*,+ failure == 0.1.*,+ tagged == 0.2.*,+ time == 1.2.*+ GHC-Options:+ -Wall -fno-warn-orphans