+++ /dev/null
-{-# 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
+++ /dev/null
-{-# 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
-
--- /dev/null
+{-# 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 |])
+ ]
--- /dev/null
+{-# LANGUAGE
+ FlexibleInstances
+ , MultiParamTypeClasses
+ , OverloadedStrings
+ , TemplateHaskell
+ , UnicodeSyntax
+ #-}
+-- |This module provides functions to parse and format HTTP\/1.1 date
+-- and time strings
+-- (<http://tools.ietf.org/html/rfc2616#section-3.3>).
+--
+-- The HTTP\/1.1 specification (RFC 2616) says that HTTP\/1.1 clients
+-- and servers which parse the date value MUST accept all the
+-- following formats, though they MUST only generate the RFC 1123
+-- format for representing HTTP-date values in header fields:
+--
+-- > Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123
+-- > Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036
+-- > Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() format
+--
+-- It also says that all HTTP date\/time stamps MUST be represented in
+-- Greenwich Mean Time (GMT), without exception. For the purposes of
+-- HTTP, GMT is exactly equal to UTC (Coordinated Universal
+-- Time). This is indicated in the first two formats by the inclusion
+-- of @\"GMT\"@ as the three-letter abbreviation for time zone, and
+-- MUST be assumed when reading the asctime format.
+--
+-- > HTTP-date = rfc1123-date | rfc850-date | asctime-date
+-- > rfc1123-date = wkday "," SP date1 SP time SP "GMT"
+-- > rfc850-date = weekday "," SP date2 SP time SP "GMT"
+-- > asctime-date = wkday SP date3 SP time SP 4DIGIT
+-- > date1 = 2DIGIT SP month SP 4DIGIT
+-- > ; day month year (e.g., 02 Jun 1982)
+-- > date2 = 2DIGIT "-" month "-" 2DIGIT
+-- > ; day-month-year (e.g., 02-Jun-82)
+-- > date3 = month SP ( 2DIGIT | ( SP 1DIGIT ))
+-- > ; month day (e.g., Jun 2)
+-- > time = 2DIGIT ":" 2DIGIT ":" 2DIGIT
+-- > ; 00:00:00 - 23:59:59
+-- > wkday = "Mon" | "Tue" | "Wed"
+-- > | "Thu" | "Fri" | "Sat" | "Sun"
+-- > weekday = "Monday" | "Tuesday" | "Wednesday"
+-- > | "Thursday" | "Friday" | "Saturday" | "Sunday"
+-- > month = "Jan" | "Feb" | "Mar" | "Apr"
+-- > | "May" | "Jun" | "Jul" | "Aug"
+-- > | "Sep" | "Oct" | "Nov" | "Dec"
+module Data.Time.Format.HTTP
+ ( HTTP
+ , http
+ , httpDateAndTime
+ )
+ where
+import Control.Applicative
+import Data.Ascii (Ascii, AsciiBuilder)
+import qualified Data.Ascii as A
+import Data.Attoparsec.Char8
+import Data.Convertible.Base
+import Data.Proxy
+import Data.Tagged
+import Data.Time
+import Data.Time.Format.C
+import Data.Time.Format.HTTP.Common
+import Data.Time.Format.RFC733
+import Data.Time.Format.RFC822
+import Data.Time.Format.RFC1123
+import Prelude.Unicode
+
+-- |The phantom type for conversions between HTTP/1.1 date and time
+-- strings and 'UTCTime'.
+--
+-- >>> convertSuccess (UTCTime (ModifiedJulianDay 49662) 31777)
+-- Tagged "Sun, 06 Nov 1994 08:49:37 GMT"
+data HTTP
+
+-- |The proxy for conversions between ANSI HTTP/1.1 date and time
+-- strings and 'UTCTime'.
+http ∷ Proxy HTTP
+{-# INLINE CONLIKE http #-}
+http = Proxy
+
+instance ConvertSuccess UTCTime (Tagged HTTP Ascii) where
+ {-# INLINE convertSuccess #-}
+ convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
+
+instance ConvertSuccess UTCTime (Tagged HTTP AsciiBuilder) where
+ {-# INLINE convertSuccess #-}
+ convertSuccess = Tagged ∘ toAsciiBuilder
+
+instance ConvertAttempt (Tagged HTTP Ascii) UTCTime where
+ {-# INLINE convertAttempt #-}
+ convertAttempt = parseAttempt' httpDateAndTime ∘ untag
+
+-- |Parse a date and time string in any of RFC 822, RFC 1123, RFC 850
+-- and ANSI C's asctime() formats.
+--
+-- This function is even more permissive than what HTTP\/1.1 (RFC
+-- 2616) specifies. That is, it accepts 2-digit years in RFC 822,
+-- omitted separator symbols in RFC 850, omitted sec fields, and
+-- non-GMT time zones. I believe this behavior will not cause a
+-- problem though.
+httpDateAndTime ∷ Parser UTCTime
+httpDateAndTime
+ = choice [ zonedTimeToUTC <$> try rfc1123DateAndTime
+ , zonedTimeToUTC <$> try rfc733DateAndTime
+ , zonedTimeToUTC <$> try rfc822DateAndTime
+ , localTimeToUTC utc <$> cDateAndTime
+ ]
+
+toAsciiBuilder ∷ UTCTime → AsciiBuilder
+{-# INLINE toAsciiBuilder #-}
+toAsciiBuilder = flip proxy rfc1123 ∘ cs ∘ ut2zt
+ where
+ ut2zt ∷ UTCTime → ZonedTime
+ {-# INLINE ut2zt #-}
+ ut2zt = utcToZonedTime gmt
+
+ gmt ∷ TimeZone
+ {-# INLINE CONLIKE gmt #-}
+ gmt = TimeZone 0 False "GMT"
+
+deriveAttempts [ ([t| UTCTime |], [t| Tagged HTTP Ascii |])
+ , ([t| UTCTime |], [t| Tagged HTTP AsciiBuilder |])
+ ]
OverloadedStrings
, UnicodeSyntax
#-}
-module Data.Time.HTTP.Common
+module Data.Time.Format.HTTP.Common
( shortWeekDayName
, shortWeekDayNameP
, 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
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)
show2 h ⊕ show2 m
read4digitsTZ ∷ Parser TimeZone
+{-# INLINEABLE read4digitsTZ #-}
read4digitsTZ
= do sign ← (char '+' *> return 1)
<|>
(year, month, day) = toGregorian gregDay
in
unless (givenWD ≡ correctWD)
- $ fail
+ ∘ fail
$ concat [ "Gregorian day "
, show year
, "-"
{-# 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
{-# 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 (<http://tools.ietf.org/html/rfc1123#page-55>).
+--
+-- The format is basically the same as RFC 822, but the syntax for
+-- @date@ is changed from:
+--
+-- > year ::= 2DIGIT
+--
+-- to:
+--
+-- > year ::= 4DIGIT
+module Data.Time.Format.RFC1123
+ ( RFC1123
+ , rfc1123
+ , rfc1123DateAndTime
)
where
-import 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
→ return ()
Just givenWD
→ assertWeekDayIsGood givenWD gregDay
- (tod, timeZone) ← rfc822time
+ (tod, timeZone) ← rfc822Time
let lt = LocalTime gregDay tod
zt = ZonedTime lt timeZone
return zt
_ ← char ' '
assertGregorianDateIsGood year month day
--- |Convert a 'ZonedTime' to RFC 1123 date and time string.
toAsciiBuilder ∷ ZonedTime → AsciiBuilder
toAsciiBuilder zonedTime
= let localTime = zonedTimeToLocalTime 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 |])
+ ]
{-# 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 (<http://tools.ietf.org/html/rfc733#appendix-E>).
+--
+-- The syntax is as follows:
+--
+-- > date-time ::= [ day-of-week ", " ] date SP time ("-" | SP) zone
+-- > day-of-week ::= "Monday" | "Mon" | "Tuesday" | "Tue"
+-- > | "Wednesday" | "Wed" | "Thursday" | "Thu"
+-- > | "Friday" | "Fri" | "Saturday" | "Sat"
+-- > | "Sunday" | "Sun"
+-- > date ::= day ("-" | SP) month ("-" | SP) year
+-- > day ::= 2DIGIT
+-- > year ::= 2DIGIT | 4DIGIT
+-- > month ::= "January" | "Jan" | "February" | "Feb"
+-- > | "March" | "Mar" | "April" | "Apr"
+-- > | "May" | "June" | "Jun"
+-- > | "July" | "Jul" | "August" | "Aug"
+-- > | "September" | "Sep" | "October" | "Oct"
+-- > | "November" | "Nov" | "December" | "Dec"
+-- > time ::= hour [ ":" ] minute [ [ ":" ] second ]
+-- > hour ::= 2DIGIT
+-- > minute ::= 2DIGIT
+-- > second ::= 2DIGIT
+-- > zone ::= "GMT" ; Universal Time
+-- > | "NST" ; Newfoundland: -3:30
+-- > | "AST" | "ADT" ; Atlantic : -4 / -3
+-- > | "EST" | "EDT" ; Eastern : -5 / -4
+-- > | "CST" | "CDT" ; Central : -6 / -5
+-- > | "MST" | "MDT" ; Mountain : -7 / -6
+-- > | "PST" | "PDT" ; Pacific : -8 / -7
+-- > | "YST" | "YDT" ; Yukon : -9 / -8
+-- > | "HST" | "HDT" ; Haw/Ala : -10 / -9
+-- > | "BST" | "BDT" ; Bering : -11 / -10
+-- > | "Z" ; GMT
+-- > | "A" ; -1
+-- > | "M" ; -12
+-- > | "N" ; +1
+-- > | "Y" ; +12
+-- > | ("+" | "-") 4DIGIT ; Local diff: HHMM
+module Data.Time.Format.RFC733
+ ( RFC733
+ , rfc733
+ , rfc733DateAndTime
)
where
-import 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
, read4digitsTZ
]
--- |Convert a 'ZonedTime' to RFC 733 date and time string.
toAsciiBuilder ∷ ZonedTime → AsciiBuilder
toAsciiBuilder zonedTime
= let localTime = zonedTimeToLocalTime 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 |])
+ ]
UnicodeSyntax
#-}
-- |This module provides functions to parse and format RFC 822 date
--- and time formats.
+-- and time strings (<http://tools.ietf.org/html/rfc822#section-5>).
--
-- The syntax is as follows:
--
-- > | "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
{-# 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
-> return ()
Just givenWD
-> assertWeekDayIsGood givenWD gregDay
- (tod, timeZone) ← rfc822time
+ (tod, timeZone) ← rfc822Time
let lt = LocalTime gregDay tod
zt = ZonedTime lt timeZone
return zt
_ ← 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)
, 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
⊕ 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 |])
+ ]
+++ /dev/null
-{-# 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
+++ /dev/null
-{-# 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"
+++ /dev/null
-{-# 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
+++ /dev/null
-{-# 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
--- /dev/null
+{-# 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
+++ /dev/null
-{-# 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
component: time-http
release: time-http-0.3
reporter: PHO <pho@cielonegro.org>
-status: :unstarted
-disposition:
+status: :closed
+disposition: :fixed
creation_time: 2011-12-01 01:58:17.790699 Z
references: []
- PHO <pho@cielonegro.org>
- created
- ""
+- - 2011-12-01 23:15:25.041203 Z
+ - PHO <pho@cielonegro.org>
+ - changed status from unstarted to in_progress
+ - ""
+- - 2011-12-14 13:57:46.566967 Z
+ - PHO <pho@cielonegro.org>
+ - closed with disposition fixed
+ - Done.
git_branch:
- PHO <pho@cielonegro.org>
- closed with disposition fixed
- Done.
-git_branch: attoparsec
- PHO <pho@cielonegro.org>
- closed with disposition fixed
- Done.
-git_branch: attoparsec
Name: time-http
-Version: 0.2
+Version: 0.3
Synopsis: Parse and format HTTP/1.1 Date and Time strings
Description:
This package provides functionalities to parse and format
- various Date and Time formats allowed in HTTP\/1.1 (RFC 2616).
+ various Date and Time formats allowed in HTTP\/1.1
+ (<http://tools.ietf.org/html/rfc2616#section-3.3>).
Homepage: http://cielonegro.org/HTTPDateTime.html
Bug-Reports: http://static.cielonegro.org/ditz/time-http/
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:
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
projects / time-http.git / commitdiff