Data.Ascii now uses convertible

Ditz-issue: 0a3272772c73cf31486eb2b6691fa38232d3c4c5

diff --git a/Data/Time/Asctime.hs b/Data/Time/Asctime.hs
index 39d9961a8f68b0cd2c62641c464e964d13a02d8d..f7d7bddaa64114ad20728428119d6d38b6ae2e49 100644 (file)
--- a/Data/Time/Asctime.hs
+++ b/Data/Time/Asctime.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE
 {-# LANGUAGE

-    OverloadedStrings
+    FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings

   , UnicodeSyntax
   #-}
 -- |This module provides functions for ANSI C's asctime() format.
   , 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
 -- 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
     , asctime
     )
     where

+import Control.Applicative

 import Data.Ascii (Ascii, AsciiBuilder)
 import qualified Data.Ascii as A
 import Data.Attoparsec.Char8
 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.Monoid.Unicode

+import Data.Tagged

 import Data.Time
 import Data.Time.Calendar.WeekDate
 import Data.Time.HTTP.Common
 import Prelude.Unicode
 
 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
 
 -- |Parse an ANSI C's @asctime()@ string.
 asctime ∷ Parser LocalTime


@@ -76,7 +87,6 @@ asctime = do weekDay ← shortWeekDayNameP
 
              return (LocalTime gregDay tod)
 
 
              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)
 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 f7c74c91e1326b5944ea06d5082c0415ac2f0044..84beeb3665cd9439f66f85bb5bae18197dfbe187 100644 (file)
--- a/Data/Time/HTTP/Common.hs
+++ b/Data/Time/HTTP/Common.hs
@@ -31,15 +31,23 @@ module Data.Time.HTTP.Common
     , assertTimeOfDayIsGood
 
     , optionMaybe
     , assertTimeOfDayIsGood
 
     , optionMaybe

+    , finishOff
+
+    , parseAttempt
+    , parseAttempt'

     )
     where
 import Blaze.ByteString.Builder.ByteString as B
 import Blaze.Text.Int as BT
 import Control.Applicative
     )
     where
 import Blaze.ByteString.Builder.ByteString as B
 import Blaze.Text.Int as BT
 import Control.Applicative

+import Control.Exception.Base

 import Control.Monad
 import Control.Monad

-import Data.Ascii (AsciiBuilder)
+import Control.Monad.Unicode
+import Data.Ascii (Ascii, AsciiBuilder)

 import qualified Data.Ascii as A
 import qualified Data.Ascii as A

+import Data.Attempt

 import Data.Attoparsec.Char8 as P
 import Data.Attoparsec.Char8 as P

+import Data.ByteString (ByteString)

 import Data.Char
 import Data.Monoid.Unicode
 import Data.Fixed
 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)
           (year, month, day) = toGregorian gregDay
       in
         unless (givenWD ≡ correctWD)

-            $ fail
+            ∘ fail

             $ concat [ "Gregorian day "
                      , show year
                      , "-"
             $ 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)
 {-# 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 0cf15d83736fa40d5f22620a88b84a0385702660..2f7225e15eaf2fe1e35d8eff196c0579c3917c32 100644 (file)
--- 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
 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 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
 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
 
 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"
 
           -- 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 )
 
           -- 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))
         ]
         , 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 eae4ffaff88b8f460465bf32bac6f20af9659cd1..b6bc9aaec82101340626abda585af90ccecdd6fa 100644 (file)
--- a/time-http.cabal
+++ b/time-http.cabal
@@ -41,11 +41,13 @@ Library
 
     Build-depends:
         ascii                == 0.0.*,
 
     Build-depends:
         ascii                == 0.0.*,

+        attempt              == 0.3.*,

         attoparsec           == 0.9.*,
         attoparsec           == 0.9.*,

-        blaze-builder        == 0.3.*,
-        blaze-textual        == 0.2.*,

         base                 == 4.*,
         base-unicode-symbols == 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.*
         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.*,
     Build-depends:
         QuickCheck           == 2.4.*,
         ascii                == 0.0.*,

+        attempt              == 0.3.*,

         attoparsec           == 0.9.*,
         attoparsec           == 0.9.*,

-        blaze-builder        == 0.3.*,
-        blaze-textual        == 0.2.*,

         base                 == 4.*,
         base-unicode-symbols == 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.*
         convertible-text     == 0.3.*,
         tagged               == 0.2.*,
         time                 == 1.2.*