X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Data%2FTime%2FHTTP%2FCommon.hs;h=c07065bf6585cb15a8aecaa6e6b597d9b3aa7607;hp=1cfa89e9c63528268d721d309927dc58f981f586;hb=55924ce;hpb=e322e3c65458dd6004ae4d2fbf5e82ce9aaee162

diff --git a/Data/Time/HTTP/Common.hs b/Data/Time/HTTP/Common.hs
index 1cfa89e..c07065b 100644
--- a/Data/Time/HTTP/Common.hs
+++ b/Data/Time/HTTP/Common.hs
@@ -31,15 +31,24 @@ 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
 import Data.Time
@@ -242,20 +251,11 @@ read2' = do n1 ← (char ' ' *> pure 0) <|> digit'
             return (n1 * 10 + n2)
 
 digit' ∷ Num n ⇒ Parser n
-digit' = fromC <$> P.digit
-
-fromC ∷ Num n ⇒ Char → n
-fromC '0' = 0
-fromC '1' = 1
-fromC '2' = 2
-fromC '3' = 3
-fromC '4' = 4
-fromC '5' = 5
-fromC '6' = 6
-fromC '7' = 7
-fromC '8' = 8
-fromC '9' = 9
-fromC _   = undefined
+{-# INLINE digit' #-}
+digit' = fromIntegral <$> fromC <$> P.digit
+    where
+      {-# INLINE fromC #-}
+      fromC c = ord c - ord '0'
 
 show4digitsTZ ∷ TimeZone → AsciiBuilder
 show4digitsTZ tz
@@ -290,7 +290,7 @@ assertWeekDayIsGood givenWD gregDay
           (year, month, day) = toGregorian gregDay
       in
         unless (givenWD ≡ correctWD)
-            $ fail
+            ∘ fail
             $ concat [ "Gregorian day "
                      , show year
                      , "-"
@@ -340,3 +340,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