From: PHO Date: Sun, 4 Dec 2011 09:45:15 +0000 (+0900) Subject: Data.Ascii now uses convertible X-Git-Tag: RELEASE-0.3~1^2~12 X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=127b8db10ba98b77b5549902f4759f09a19604b1;p=time-http.git Data.Ascii now uses convertible Ditz-issue: 0a3272772c73cf31486eb2b6691fa38232d3c4c5 --- diff --git a/Data/Time/Asctime.hs b/Data/Time/Asctime.hs index 39d9961..f7d7bdd 100644 --- a/Data/Time/Asctime.hs +++ b/Data/Time/Asctime.hs @@ -1,5 +1,7 @@ {-# LANGUAGE - OverloadedStrings + FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings , UnicodeSyntax #-} -- |This module provides functions for ANSI C's asctime() format. @@ -23,36 +25,45 @@ -- 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 , asctime ) where +import Control.Applicative import Data.Ascii (Ascii, AsciiBuilder) import qualified Data.Ascii as A import Data.Attoparsec.Char8 +import Data.Convertible.Base import Data.Monoid.Unicode +import Data.Tagged import Data.Time import Data.Time.Calendar.WeekDate import Data.Time.HTTP.Common import Prelude.Unicode --- |Convert a 'LocalTime' to ANSI C's @asctime()@ string. -toAscii ∷ LocalTime → Ascii -toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder +-- |The phantom type for conversion between ANSI C's @asctime()@ +-- string and 'LocalTime'. +data Asctime --- |Parse an ANSI C's @asctime()@ string. When the string can't be --- parsed, it returns @'Left' err@. -fromAscii ∷ Ascii → Either String LocalTime -fromAscii = parseOnly p ∘ A.toByteString - where - p = do zt ← asctime - endOfInput - return zt +instance ConvertSuccess LocalTime (Tagged Asctime Ascii) where + {-# INLINE convertSuccess #-} + convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs + +instance ConvertAttempt LocalTime (Tagged Asctime Ascii) where + {-# INLINE convertAttempt #-} + convertAttempt = return ∘ cs + +instance ConvertSuccess LocalTime (Tagged Asctime AsciiBuilder) where + {-# INLINE convertSuccess #-} + convertSuccess = Tagged ∘ toAsciiBuilder + +instance ConvertAttempt LocalTime (Tagged Asctime AsciiBuilder) where + {-# INLINE convertAttempt #-} + convertAttempt = return ∘ cs + +instance ConvertAttempt (Tagged Asctime Ascii) LocalTime where + {-# INLINE convertAttempt #-} + convertAttempt = parseAttempt' asctime ∘ untag -- |Parse an ANSI C's @asctime()@ string. asctime ∷ Parser LocalTime @@ -76,7 +87,6 @@ asctime = do weekDay ← shortWeekDayNameP 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) diff --git a/Data/Time/HTTP/Common.hs b/Data/Time/HTTP/Common.hs index f7c74c9..84beeb3 100644 --- a/Data/Time/HTTP/Common.hs +++ b/Data/Time/HTTP/Common.hs @@ -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 @@ -282,7 +290,7 @@ assertWeekDayIsGood givenWD gregDay (year, month, day) = toGregorian gregDay in unless (givenWD ≡ correctWD) - $ fail + ∘ fail $ concat [ "Gregorian day " , show year , "-" @@ -332,3 +340,28 @@ 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' p a = parseAttempt h p bs + where + h ∷ String → StringException + h _ = StringException $ A.toString a + + bs ∷ ByteString + bs = A.toByteString a diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs index 0cf15d8..2f7225e 100644 --- a/Test/Time/HTTP.hs +++ b/Test/Time/HTTP.hs @@ -5,8 +5,11 @@ module Main (main) where import Control.Applicative import Control.Applicative.Unicode +import Data.Ascii (Ascii) +import Data.Convertible.Base +import Data.Tagged import Data.Time -import qualified Data.Time.Asctime as Asctime +import Data.Time.Asctime import qualified Data.Time.HTTP as HTTP import qualified Data.Time.RFC733 as RFC733 import qualified Data.Time.RFC1123 as RFC1123 @@ -60,13 +63,21 @@ instance Arbitrary UTCTime where 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) + property ( convertUnsafe ( Tagged "Sun Nov 6 08:49:37 1994" + ∷ Tagged Asctime Ascii + ) + ≡ referenceLocalTime + ) + + , property ( ( Tagged "Sun Nov 6 08:49:37 1994" + ∷ Tagged Asctime Ascii + ) + ≡ cs referenceLocalTime + ) + + , property $ \lt → lt ≡ convertUnsafe ( cs (lt ∷ LocalTime) + ∷ Tagged Asctime Ascii + ) -- RFC733 , property ( RFC733.fromAscii "Sunday, 06-Nov-94 08:49:37 GMT" @@ -88,7 +99,7 @@ tests = [ -- Asctime -- 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 (untag (cs (ut2lt ut) ∷ Tagged Asctime Ascii)) , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC733.toAscii (ut2zt ut)) , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC1123.toAscii (ut2zt ut)) ] diff --git a/time-http.cabal b/time-http.cabal index eae4ffa..b6bc9aa 100644 --- a/time-http.cabal +++ b/time-http.cabal @@ -41,11 +41,13 @@ Library 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.3.*, tagged == 0.2.*, time == 1.2.* @@ -63,11 +65,13 @@ Test-Suite test-time-http 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.3.*, tagged == 0.2.*, time == 1.2.*