From d82d61b7f6627c026d0a61209a6cceda5e572214 Mon Sep 17 00:00:00 2001 From: PHO Date: Wed, 28 Sep 2011 22:22:28 +0900 Subject: [PATCH] Data.Time.RFC822 now compiles. Ditz-issue: 85eb4c20935bf29db052a35d75039c638817227b --- Data/Time/HTTP/Common.hs | 119 ++++++++++++++++++++--------------- Data/Time/RFC822.hs | 65 +++++++------------ Data/Time/RFC822/Internal.hs | 39 ++++++++++++ 3 files changed, 127 insertions(+), 96 deletions(-) diff --git a/Data/Time/HTTP/Common.hs b/Data/Time/HTTP/Common.hs index bb4ac16..cf5412c 100644 --- a/Data/Time/HTTP/Common.hs +++ b/Data/Time/HTTP/Common.hs @@ -44,16 +44,19 @@ import Data.Time import Data.Time.Calendar.WeekDate import Prelude.Unicode -shortWeekDayName ∷ Num n ⇒ n → String -{-# INLINEABLE shortWeekDayName #-} -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: invalid week day: " ⧺ show n) +shortWeekDayName ∷ Num n ⇒ n → AsciiBuilder +{-# INLINE shortWeekDayName #-} +shortWeekDayName = A.toAsciiBuilder ∘ go + where + {-# INLINEABLE go #-} + go 1 = "Mon" + go 2 = "Tue" + go 3 = "Wed" + go 4 = "Thu" + go 5 = "Fri" + go 6 = "Sat" + go 7 = "Sun" + go n = error ("shortWeekDayName: invalid week day: " ⧺ show n) shortWeekDayNameP ∷ Num n ⇒ Parser n {-# INLINEABLE shortWeekDayNameP #-} @@ -71,16 +74,19 @@ shortWeekDayNameP ] ] -longWeekDayName ∷ Num n ⇒ n → String -{-# INLINEABLE longWeekDayName #-} -longWeekDayName 1 = "Monday" -longWeekDayName 2 = "Tuesday" -longWeekDayName 3 = "Wednesday" -longWeekDayName 4 = "Thursday" -longWeekDayName 5 = "Friday" -longWeekDayName 6 = "Saturday" -longWeekDayName 7 = "Sunday" -longWeekDayName n = error ("longWeekDayName: invalid week day: " ⧺ show n) +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 #-} @@ -98,21 +104,24 @@ longWeekDayNameP ] ] -shortMonthName ∷ Num n ⇒ n → String -{-# INLINEABLE shortMonthName #-} -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: invalid month: " ⧺ show n) +shortMonthName ∷ Num n ⇒ n → AsciiBuilder +{-# INLINE shortMonthName #-} +shortMonthName = A.toAsciiBuilder ∘ go + where + {-# INLINEABLE go #-} + go 1 = "Jan" + go 2 = "Feb" + go 3 = "Mar" + go 4 = "Apr" + go 5 = "May" + go 6 = "Jun" + go 7 = "Jul" + go 8 = "Aug" + go 9 = "Sep" + go 10 = "Oct" + go 11 = "Nov" + go 12 = "Dec" + go n = error ("shortMonthName: invalid month: " ⧺ show n) shortMonthNameP ∷ Num n ⇒ Parser n {-# INLINEABLE shortMonthNameP #-} @@ -139,21 +148,24 @@ shortMonthNameP , string "Dec" *> return 12 ] -longMonthName ∷ Num n ⇒ n → String -{-# INLINEABLE longMonthName #-} -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: invalid month: " ⧺ show n) +longMonthName ∷ Num n ⇒ n → AsciiBuilder +{-# INLINE longMonthName #-} +longMonthName = A.toAsciiBuilder ∘ go + where + {-# INLINEABLE go #-} + go 1 = "January" + go 2 = "February" + go 3 = "March" + go 4 = "April" + go 5 = "May" + go 6 = "June" + go 7 = "July" + go 8 = "August" + go 9 = "September" + go 10 = "October" + go 11 = "November" + go 12 = "December" + go n = error ("longMonthName: invalid month: " ⧺ show n) longMonthNameP ∷ Num n ⇒ Parser n {-# INLINEABLE longMonthNameP #-} @@ -270,10 +282,13 @@ assertWeekDayIsGood givenWD gregDay , "-" , show day , " is " - , longWeekDayName correctWD + , toStr $ longWeekDayName correctWD , ", not " - , longWeekDayName givenWD + , toStr $ longWeekDayName givenWD ] + where + toStr ∷ AsciiBuilder → String + toStr = A.toString ∘ A.fromAsciiBuilder assertGregorianDateIsGood ∷ Monad m ⇒ Integer → Int → Int → m Day {-# INLINEABLE assertGregorianDateIsGood #-} diff --git a/Data/Time/RFC822.hs b/Data/Time/RFC822.hs index 5d4b862..152d992 100644 --- a/Data/Time/RFC822.hs +++ b/Data/Time/RFC822.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE + UnicodeSyntax + #-} -- |This module provides functions to parse and format RFC 822 date -- and time formats. -- @@ -28,57 +31,31 @@ -- > | "Y" ; +12 -- > | ("+" | "-") 4DIGIT ; Local diff: HHMM module Data.Time.RFC822 - ( format - , parse + ( -- * Formatting + toAscii + , toAsciiBuilder - -- private - , showRFC822TimeZone + -- * Parsing + , fromAscii + , rfc822DateAndTime ) where +import Data.Ascii (Ascii) +import qualified Data.Ascii as A +import qualified Data.Attoparsec.Char8 as P import Data.Time -import Data.Time.Calendar.WeekDate -import Data.Time.HTTP.Common import Data.Time.RFC822.Internal +import Prelude.Unicode --- |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 - ] - --- private -showRFC822TimeZone :: TimeZone -> String -showRFC822TimeZone tz - | timeZoneMinutes tz == 0 = "GMT" - | otherwise = show4digitsTZ tz +-- |Convert a 'ZonedTime' to RFC 822 date and time string. +toAscii ∷ ZonedTime → Ascii +toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder -- |Parse an RFC 822 date and time string. When the string can't be --- parsed, it returns 'Nothing'. -parse :: String -> Maybe ZonedTime -parse src = case P.parse p "" src of - Right zt -> Just zt - Left _ -> Nothing +-- parsed, it returns @'Left' err@. +fromAscii ∷ Ascii → Either String ZonedTime +fromAscii = P.parseOnly p ∘ A.toByteString where - p = do zt <- rfc822DateAndTime - _ <- P.eof + p = do zt ← rfc822DateAndTime + P.endOfInput return zt diff --git a/Data/Time/RFC822/Internal.hs b/Data/Time/RFC822/Internal.hs index 297120a..607cf88 100644 --- a/Data/Time/RFC822/Internal.hs +++ b/Data/Time/RFC822/Internal.hs @@ -2,15 +2,23 @@ OverloadedStrings , UnicodeSyntax #-} +-- |Internal functions for "Data.Time.RFC822". module Data.Time.RFC822.Internal ( rfc822DateAndTime , rfc822time + , showRFC822TimeZone + , toAsciiBuilder ) where import Control.Applicative +import Data.Ascii (AsciiBuilder) +import qualified Data.Ascii as A import Data.Attoparsec.Char8 +import Data.Monoid.Unicode import Data.Time +import Data.Time.Calendar.WeekDate import Data.Time.HTTP.Common +import Prelude.Unicode -- |Parse an RFC 822 date and time string. rfc822DateAndTime ∷ Parser ZonedTime @@ -80,3 +88,34 @@ zone = choice [ string "UT" *> return (TimeZone 0 False "UT" ) , char 'Y' *> return (TimeZone ( 12 * 60) False "Y") , read4digitsTZ ] + +-- |No need to explain. +showRFC822TimeZone ∷ TimeZone → AsciiBuilder +showRFC822TimeZone tz + | timeZoneMinutes tz ≡ 0 = A.toAsciiBuilder "GMT" + | otherwise = show4digitsTZ tz + +-- |Convert a 'ZonedTime' to RFC 822 date and time string. +toAsciiBuilder ∷ ZonedTime → AsciiBuilder +toAsciiBuilder zonedTime + = let localTime = zonedTimeToLocalTime zonedTime + timeZone = zonedTimeZone zonedTime + (year, month, day) = toGregorian (localDay localTime) + (_, _, week) = toWeekDate (localDay localTime) + timeOfDay = localTimeOfDay localTime + in + shortWeekDayName week + ⊕ A.toAsciiBuilder ", " + ⊕ show2 day + ⊕ A.toAsciiBuilder " " + ⊕ shortMonthName month + ⊕ A.toAsciiBuilder " " + ⊕ show2 (year `mod` 100) + ⊕ A.toAsciiBuilder " " + ⊕ show2 (todHour timeOfDay) + ⊕ A.toAsciiBuilder ":" + ⊕ show2 (todMin timeOfDay) + ⊕ A.toAsciiBuilder ":" + ⊕ show2 (floor (todSec timeOfDay) ∷ Int) + ⊕ A.toAsciiBuilder " " + ⊕ showRFC822TimeZone timeZone -- 2.40.0