X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Data%2FTime%2FHTTP%2FCommon.hs;h=84beeb3665cd9439f66f85bb5bae18197dfbe187;hp=f7c74c91e1326b5944ea06d5082c0415ac2f0044;hb=127b8db;hpb=d62f138e9f756f7e75324d66a45c839ba8ef1334

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