From: PHO Date: Thu, 15 Dec 2011 12:49:22 +0000 (+0900) Subject: Merge branch 'convertible' X-Git-Tag: RELEASE-0.3~1 X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=commitdiff_plain;h=2064aacf48e193924b6ffe18a50853d233c16b98;hp=901a3635d37e25a2d4c2e1562c32c68c410fbdd3 Merge branch 'convertible' --- diff --git a/Data/Time/Asctime.hs b/Data/Time/Asctime.hs deleted file mode 100644 index 0814e45..0000000 --- a/Data/Time/Asctime.hs +++ /dev/null @@ -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 diff --git a/Data/Time/Asctime/Internal.hs b/Data/Time/Asctime/Internal.hs deleted file mode 100644 index 1681fc0..0000000 --- a/Data/Time/Asctime/Internal.hs +++ /dev/null @@ -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 - diff --git a/Data/Time/Format/C.hs b/Data/Time/Format/C.hs new file mode 100644 index 0000000..0c204d5 --- /dev/null +++ b/Data/Time/Format/C.hs @@ -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 |]) + ] diff --git a/Data/Time/Format/HTTP.hs b/Data/Time/Format/HTTP.hs new file mode 100644 index 0000000..2c44147 --- /dev/null +++ b/Data/Time/Format/HTTP.hs @@ -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 +-- (). +-- +-- 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 |]) + ] diff --git a/Data/Time/HTTP/Common.hs b/Data/Time/Format/HTTP/Common.hs similarity index 91% rename from Data/Time/HTTP/Common.hs rename to Data/Time/Format/HTTP/Common.hs index f7c74c9..b7e3b9e 100644 --- a/Data/Time/HTTP/Common.hs +++ b/Data/Time/Format/HTTP/Common.hs @@ -2,7 +2,7 @@ OverloadedStrings , UnicodeSyntax #-} -module Data.Time.HTTP.Common +module Data.Time.Format.HTTP.Common ( shortWeekDayName , shortWeekDayNameP @@ -31,15 +31,23 @@ module Data.Time.HTTP.Common , 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 Data.Ascii (AsciiBuilder) +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 @@ -250,6 +258,7 @@ digit' = fromIntegral <$> fromC <$> P.digit 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) @@ -262,6 +271,7 @@ show4digitsTZ tz show2 h ⊕ show2 m read4digitsTZ ∷ Parser TimeZone +{-# INLINEABLE read4digitsTZ #-} read4digitsTZ = do sign ← (char '+' *> return 1) <|> @@ -282,7 +292,7 @@ assertWeekDayIsGood givenWD gregDay (year, month, day) = toGregorian gregDay in unless (givenWD ≡ correctWD) - $ fail + ∘ fail $ concat [ "Gregorian day " , show year , "-" @@ -332,3 +342,22 @@ 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 diff --git a/Data/Time/RFC1123/Internal.hs b/Data/Time/Format/RFC1123.hs similarity index 51% rename from Data/Time/RFC1123/Internal.hs rename to Data/Time/Format/RFC1123.hs index 4ae25b7..1d4f28e 100644 --- a/Data/Time/RFC1123/Internal.hs +++ b/Data/Time/Format/RFC1123.hs @@ -1,21 +1,65 @@ {-# LANGUAGE - OverloadedStrings + FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings + , TemplateHaskell , UnicodeSyntax #-} --- |Internal functions for "Data.Time.RFC1123". -module Data.Time.RFC1123.Internal - ( rfc1123DateAndTime - , toAsciiBuilder +-- |This module provides functions to parse and format RFC 1123 date +-- and time strings (). +-- +-- 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 Data.Ascii (AsciiBuilder) +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.HTTP.Common -import Data.Time.RFC822.Internal hiding (toAsciiBuilder) +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 @@ -32,7 +76,7 @@ dateTime = do weekDay ← optionMaybe $ → return () Just givenWD → assertWeekDayIsGood givenWD gregDay - (tod, timeZone) ← rfc822time + (tod, timeZone) ← rfc822Time let lt = LocalTime gregDay tod zt = ZonedTime lt timeZone return zt @@ -46,7 +90,6 @@ date = do day ← read2 _ ← char ' ' assertGregorianDateIsGood year month day --- |Convert a 'ZonedTime' to RFC 1123 date and time string. toAsciiBuilder ∷ ZonedTime → AsciiBuilder toAsciiBuilder zonedTime = let localTime = zonedTimeToLocalTime zonedTime @@ -69,4 +112,8 @@ toAsciiBuilder zonedTime ⊕ A.toAsciiBuilder ":" ⊕ show2 (floor (todSec timeOfDay) ∷ Int) ⊕ A.toAsciiBuilder " " - ⊕ showRFC822TimeZone timeZone + ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder) + +deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC1123 Ascii |]) + , ([t| ZonedTime |], [t| Tagged RFC1123 AsciiBuilder |]) + ] diff --git a/Data/Time/RFC733/Internal.hs b/Data/Time/Format/RFC733.hs similarity index 58% rename from Data/Time/RFC733/Internal.hs rename to Data/Time/Format/RFC733.hs index 4037918..58dec8d 100644 --- a/Data/Time/RFC733/Internal.hs +++ b/Data/Time/Format/RFC733.hs @@ -1,24 +1,95 @@ {-# LANGUAGE - OverloadedStrings + FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings + , TemplateHaskell , UnicodeSyntax #-} --- |Internal functions for "Data.Time.RFC733". -module Data.Time.RFC733.Internal - ( rfc733DateAndTime - , toAsciiBuilder +-- |This module provides functions to parse and format RFC 733 date +-- and time strings (). +-- +-- 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 Data.Ascii (AsciiBuilder) -import qualified Data.Ascii as A 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.HTTP.Common -import Data.Time.RFC822.Internal hiding (toAsciiBuilder) +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 --- |Parse RFC 733 date and time strings. +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 @@ -113,7 +184,6 @@ zone = choice [ string "GMT" *> return (TimeZone 0 False "GMT") , read4digitsTZ ] --- |Convert a 'ZonedTime' to RFC 733 date and time string. toAsciiBuilder ∷ ZonedTime → AsciiBuilder toAsciiBuilder zonedTime = let localTime = zonedTimeToLocalTime zonedTime @@ -136,4 +206,8 @@ toAsciiBuilder zonedTime ⊕ A.toAsciiBuilder ":" ⊕ show2 (floor (todSec timeOfDay) ∷ Int) ⊕ A.toAsciiBuilder " " - ⊕ showRFC822TimeZone timeZone + ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder) + +deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC733 Ascii |]) + , ([t| ZonedTime |], [t| Tagged RFC733 AsciiBuilder |]) + ] diff --git a/Data/Time/RFC822.hs b/Data/Time/Format/RFC822.hs similarity index 64% rename from Data/Time/RFC822.hs rename to Data/Time/Format/RFC822.hs index 152d992..0d8fcac 100644 --- a/Data/Time/RFC822.hs +++ b/Data/Time/Format/RFC822.hs @@ -2,7 +2,7 @@ UnicodeSyntax #-} -- |This module provides functions to parse and format RFC 822 date --- and time formats. +-- and time strings (). -- -- The syntax is as follows: -- @@ -30,32 +30,17 @@ -- > | "N" ; +1 -- > | "Y" ; +12 -- > | ("+" | "-") 4DIGIT ; Local diff: HHMM -module Data.Time.RFC822 - ( -- * Formatting - toAscii - , toAsciiBuilder - - -- * Parsing - , fromAscii +module Data.Time.Format.RFC822 + ( RFC822 + , rfc822 , 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 +import Data.Proxy +import Data.Time.Format.RFC822.Internal --- |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 +-- |The proxy for conversions between RFC 822 date and time strings +-- and 'ZonedTime'. +rfc822 ∷ Proxy RFC822 +{-# INLINE CONLIKE rfc822 #-} +rfc822 = Proxy diff --git a/Data/Time/RFC822/Internal.hs b/Data/Time/Format/RFC822/Internal.hs similarity index 66% rename from Data/Time/RFC822/Internal.hs rename to Data/Time/Format/RFC822/Internal.hs index 607cf88..d1f62d2 100644 --- a/Data/Time/RFC822/Internal.hs +++ b/Data/Time/Format/RFC822/Internal.hs @@ -1,25 +1,57 @@ {-# LANGUAGE - OverloadedStrings + FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings + , TemplateHaskell , UnicodeSyntax #-} --- |Internal functions for "Data.Time.RFC822". -module Data.Time.RFC822.Internal - ( rfc822DateAndTime - , rfc822time - , showRFC822TimeZone - , toAsciiBuilder +module Data.Time.Format.RFC822.Internal + ( RFC822 + , rfc822DateAndTime + , rfc822Time ) where import Control.Applicative -import Data.Ascii (AsciiBuilder) +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.HTTP.Common +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 @@ -35,7 +67,7 @@ dateTime = do weekDay ← optionMaybe $ -> return () Just givenWD -> assertWeekDayIsGood givenWD gregDay - (tod, timeZone) ← rfc822time + (tod, timeZone) ← rfc822Time let lt = LocalTime gregDay tod zt = ZonedTime lt timeZone return zt @@ -49,9 +81,8 @@ date = do day ← 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 +rfc822Time ∷ Parser (TimeOfDay, TimeZone) +rfc822Time = do tod ← hms _ ← char ' ' tz ← zone return (tod, tz) @@ -89,13 +120,6 @@ zone = choice [ string "UT" *> return (TimeZone 0 False "UT" ) , 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 @@ -118,4 +142,10 @@ toAsciiBuilder zonedTime ⊕ A.toAsciiBuilder ":" ⊕ show2 (floor (todSec timeOfDay) ∷ Int) ⊕ A.toAsciiBuilder " " - ⊕ showRFC822TimeZone timeZone + ⊕ 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 |]) + ] diff --git a/Data/Time/HTTP.hs b/Data/Time/HTTP.hs deleted file mode 100644 index f106fc4..0000000 --- a/Data/Time/HTTP.hs +++ /dev/null @@ -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 diff --git a/Data/Time/HTTP/Internal.hs b/Data/Time/HTTP/Internal.hs deleted file mode 100644 index e945670..0000000 --- a/Data/Time/HTTP/Internal.hs +++ /dev/null @@ -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" diff --git a/Data/Time/RFC1123.hs b/Data/Time/RFC1123.hs deleted file mode 100644 index fb7839d..0000000 --- a/Data/Time/RFC1123.hs +++ /dev/null @@ -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 diff --git a/Data/Time/RFC733.hs b/Data/Time/RFC733.hs deleted file mode 100644 index 6234c1b..0000000 --- a/Data/Time/RFC733.hs +++ /dev/null @@ -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 diff --git a/Test/Time/Format/HTTP.hs b/Test/Time/Format/HTTP.hs new file mode 100644 index 0000000..b443e86 --- /dev/null +++ b/Test/Time/Format/HTTP.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE + FlexibleInstances + , OverloadedStrings + , UnicodeSyntax + #-} +module Main (main) where +import Control.Applicative +import Control.Applicative.Unicode +import Data.Ascii (Ascii) +import Data.Attempt hiding (Failure, Success) +import Data.Convertible.Base +import Data.Proxy +import Data.Tagged +import Data.Time +import Data.Time.Format.C +import Data.Time.Format.HTTP +import Data.Time.Format.RFC733 +import Data.Time.Format.RFC822 +import Data.Time.Format.RFC1123 +import System.Exit +import Prelude.Unicode +import Test.QuickCheck + +main ∷ IO () +main = mapM_ runTest tests + +runTest ∷ Property → IO () +runTest prop + = do r ← quickCheckResult prop + case r of + Success {} → return () + GaveUp {} → exitFailure + Failure {} → exitFailure + NoExpectedFailure {} → exitFailure + +data Cent20 + +cent20 ∷ Proxy Cent20 +cent20 = Proxy + +instance Arbitrary Day where + arbitrary = ModifiedJulianDay <$> arbitrary + +instance Arbitrary (Tagged Cent20 Day) where + arbitrary = ((Tagged ∘) ∘) ∘ fromGregorian + <$> choose (1900, 1999) + ⊛ arbitrary + ⊛ arbitrary + +instance Arbitrary TimeOfDay where + arbitrary + = do h ← choose (0, 23) + m ← choose (0, 59) + s ← choose (0, 60) + return $ TimeOfDay h m (fromIntegral (s ∷ Int)) + +instance Arbitrary LocalTime where + arbitrary = LocalTime <$> arbitrary ⊛ arbitrary + +instance Arbitrary (Tagged Cent20 LocalTime) where + arbitrary = (Tagged ∘) ∘ LocalTime <$> + (flip proxy cent20 <$> arbitrary) + ⊛ arbitrary + +instance Eq ZonedTime where + a == b = zonedTimeToUTC a ≡ zonedTimeToUTC b + +instance Arbitrary TimeZone where + arbitrary + = do m ← choose (-1439, 1439) + s ← arbitrary + n ← arbitrary + return $ TimeZone m s n + +instance Arbitrary ZonedTime where + arbitrary = ZonedTime <$> arbitrary ⊛ arbitrary + +instance Arbitrary (Tagged Cent20 ZonedTime) where + arbitrary = (Tagged ∘) ∘ ZonedTime <$> (flip proxy cent20 <$> arbitrary) ⊛ arbitrary + +instance Arbitrary DiffTime where + arbitrary = secondsToDiffTime <$> choose (0, 86400) + +instance Arbitrary UTCTime where + arbitrary = UTCTime <$> arbitrary ⊛ arbitrary + +instance Arbitrary (Tagged Cent20 UTCTime) where + arbitrary = (Tagged ∘) ∘ UTCTime <$> (flip proxy cent20 <$> arbitrary) ⊛ arbitrary + +tests ∷ [Property] +tests = [ -- Asctime + property ( fromAttempt (ca (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged C Ascii)) + ≡ Just referenceLocalTime + ) + + , property ( (Tagged "Sun Nov 6 08:49:37 1994" ∷ Tagged C Ascii) + ≡ cs referenceLocalTime + ) + + , property $ \lt → Just lt ≡ fromAttempt (ca (cs (lt ∷ LocalTime) ∷ Tagged C Ascii)) + + -- RFC733 + , property ( fromAttempt (ca (Tagged "Sunday, 06-Nov-94 08:49:37 GMT" ∷ Tagged RFC733 Ascii)) + ≡ Just referenceZonedTime + ) + + , property ( (Tagged "Sunday, 06-Nov-1994 08:49:37 GMT" ∷ Tagged RFC733 Ascii) + ≡ cs referenceZonedTime + ) + + , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime) ∷ Tagged RFC733 Ascii)) + + -- RFC822 + , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii)) + ≡ Just referenceZonedTime + ) + + , property ( (Tagged "Sun, 06 Nov 94 08:49:37 GMT" ∷ Tagged RFC822 Ascii) + ≡ cs referenceZonedTime + ) + , property $ \zt → Just (untag zt) ≡ fromAttempt (ca (cs (untag (zt ∷ Tagged Cent20 ZonedTime)) + ∷ Tagged RFC822 Ascii)) + + -- RFC1123 + , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii)) + ≡ Just referenceZonedTime + ) + + , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii) + ≡ cs referenceZonedTime + ) + + , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime) ∷ Tagged RFC1123 Ascii)) + + -- HTTP + , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged HTTP Ascii) + ≡ cs referenceUTCTime + ) + , property $ \ut → Just ut ≡ fromAttempt (ca (cs ut ∷ Tagged HTTP Ascii) ∷ Attempt UTCTime) + , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2lt ut) ∷ Tagged C Ascii))) + , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC733 Ascii))) + , property $ \ut → Just (untag ut) ≡ fromAttempt (ca (retagHTTP (cs (ut2zt (untag (ut ∷ Tagged Cent20 UTCTime))) + ∷ Tagged RFC822 Ascii))) + , property $ \ut → Just ut ≡ fromAttempt (ca (retagHTTP (cs (ut2zt ut) ∷ Tagged RFC1123 Ascii))) + ] + where + referenceLocalTime ∷ LocalTime + referenceLocalTime + = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37) + + referenceZonedTime ∷ ZonedTime + referenceZonedTime + = ZonedTime referenceLocalTime utc + + referenceUTCTime ∷ UTCTime + referenceUTCTime + = zonedTimeToUTC referenceZonedTime + + ut2lt ∷ UTCTime → LocalTime + ut2lt = utcToLocalTime utc + + ut2zt ∷ UTCTime → ZonedTime + ut2zt = utcToZonedTime utc + + retagHTTP ∷ Tagged s b → Tagged HTTP b + retagHTTP = retag diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs deleted file mode 100644 index 0cf15d8..0000000 --- a/Test/Time/HTTP.hs +++ /dev/null @@ -1,104 +0,0 @@ -{-# LANGUAGE - OverloadedStrings - , UnicodeSyntax - #-} -module Main (main) where -import Control.Applicative -import Control.Applicative.Unicode -import Data.Time -import qualified Data.Time.Asctime as Asctime -import qualified Data.Time.HTTP as HTTP -import qualified Data.Time.RFC733 as RFC733 -import qualified Data.Time.RFC1123 as RFC1123 -import System.Exit -import Prelude.Unicode -import Test.QuickCheck - -main ∷ IO () -main = mapM_ runTest tests - -runTest ∷ Property → IO () -runTest prop - = do r ← quickCheckResult prop - case r of - Success {} → return () - GaveUp {} → exitFailure - Failure {} → exitFailure - NoExpectedFailure {} → exitFailure - -instance Arbitrary Day where - arbitrary = ModifiedJulianDay <$> arbitrary - -instance Arbitrary TimeOfDay where - arbitrary - = do h ← choose (0, 23) - m ← choose (0, 59) - s ← choose (0, 60) - return $ TimeOfDay h m (fromIntegral (s ∷ Int)) - -instance Arbitrary LocalTime where - arbitrary = LocalTime <$> arbitrary ⊛ arbitrary - -instance Eq ZonedTime where - a == b = zonedTimeToUTC a ≡ zonedTimeToUTC b - -instance Arbitrary TimeZone where - arbitrary - = do m ← choose (-1439, 1439) - s ← arbitrary - n ← arbitrary - return $ TimeZone m s n - -instance Arbitrary ZonedTime where - arbitrary = ZonedTime <$> arbitrary ⊛ arbitrary - -instance Arbitrary DiffTime where - arbitrary = secondsToDiffTime <$> choose (0, 86400) - -instance Arbitrary UTCTime where - arbitrary = UTCTime <$> arbitrary ⊛ arbitrary - -tests ∷ [Property] -tests = [ -- Asctime - property ( Asctime.fromAscii "Sun Nov 6 08:49:37 1994" - ≡ Right referenceLocalTime ) - - , property ( "Sun Nov 6 08:49:37 1994" - ≡ Asctime.toAscii referenceLocalTime ) - - , property $ \lt → Right lt ≡ Asctime.fromAscii (Asctime.toAscii lt) - - -- RFC733 - , property ( RFC733.fromAscii "Sunday, 06-Nov-94 08:49:37 GMT" - ≡ Right referenceZonedTime ) - - , property ( "Sunday, 06-Nov-1994 08:49:37 GMT" - ≡ RFC733.toAscii referenceZonedTime ) - - , property $ \zt → Right zt ≡ RFC733.fromAscii (RFC733.toAscii zt) - - -- RFC1123 - , property ( RFC1123.fromAscii "Sun, 06 Nov 1994 08:49:37 GMT" - ≡ Right referenceZonedTime ) - - , property ( "Sun, 06 Nov 1994 08:49:37 GMT" - ≡ RFC1123.toAscii referenceZonedTime ) - - , property $ \zt → Right zt ≡ RFC1123.fromAscii (RFC1123.toAscii zt) - - -- HTTP - , property $ \ut → Right ut ≡ HTTP.fromAscii (HTTP.toAscii ut ) - , property $ \ut → Right ut ≡ HTTP.fromAscii (Asctime.toAscii (ut2lt ut)) - , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC733.toAscii (ut2zt ut)) - , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC1123.toAscii (ut2zt ut)) - ] - where - referenceLocalTime - = LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37) - - referenceZonedTime - = ZonedTime referenceLocalTime utc - - ut2lt = utcToLocalTime utc - - ut2zt = utcToZonedTime utc diff --git a/bugs/issue-0a3272772c73cf31486eb2b6691fa38232d3c4c5.yaml b/bugs/issue-0a3272772c73cf31486eb2b6691fa38232d3c4c5.yaml index 8792f58..ae51272 100644 --- a/bugs/issue-0a3272772c73cf31486eb2b6691fa38232d3c4c5.yaml +++ b/bugs/issue-0a3272772c73cf31486eb2b6691fa38232d3c4c5.yaml @@ -5,8 +5,8 @@ type: :task component: time-http release: time-http-0.3 reporter: PHO -status: :unstarted -disposition: +status: :closed +disposition: :fixed creation_time: 2011-12-01 01:58:17.790699 Z references: [] @@ -16,4 +16,12 @@ log_events: - PHO - created - "" +- - 2011-12-01 23:15:25.041203 Z + - PHO + - changed status from unstarted to in_progress + - "" +- - 2011-12-14 13:57:46.566967 Z + - PHO + - closed with disposition fixed + - Done. git_branch: diff --git a/bugs/issue-85eb4c20935bf29db052a35d75039c638817227b.yaml b/bugs/issue-85eb4c20935bf29db052a35d75039c638817227b.yaml index ed50f36..df522a8 100644 --- a/bugs/issue-85eb4c20935bf29db052a35d75039c638817227b.yaml +++ b/bugs/issue-85eb4c20935bf29db052a35d75039c638817227b.yaml @@ -20,4 +20,3 @@ log_events: - PHO - closed with disposition fixed - Done. -git_branch: attoparsec diff --git a/bugs/issue-c8c594f249504e28212f18a8a5c6b8a708b99f79.yaml b/bugs/issue-c8c594f249504e28212f18a8a5c6b8a708b99f79.yaml index 797e5f4..1fd7762 100644 --- a/bugs/issue-c8c594f249504e28212f18a8a5c6b8a708b99f79.yaml +++ b/bugs/issue-c8c594f249504e28212f18a8a5c6b8a708b99f79.yaml @@ -20,4 +20,3 @@ log_events: - PHO - closed with disposition fixed - Done. -git_branch: attoparsec diff --git a/time-http.cabal b/time-http.cabal index d8c1c2a..d30a68a 100644 --- a/time-http.cabal +++ b/time-http.cabal @@ -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 + (). Homepage: http://cielonegro.org/HTTPDateTime.html Bug-Reports: http://static.cielonegro.org/ditz/time-http/ @@ -26,27 +27,27 @@ Source-Repository head 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 @@ Library 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