Merge branch 'convertible'

[time-http.git] / Data / Time / Format / HTTP / Common.hs

diff --git a/Data/Time/HTTP/Common.hs b/Data/Time/Format/HTTP/Common.hs
similarity index 91%
rename from Data/Time/HTTP/Common.hs
rename to Data/Time/Format/HTTP/Common.hs
index f7c74c91e1326b5944ea06d5082c0415ac2f0044..b7e3b9ed5a310e35f82ae2174ce1af49058cfac4 100644 (file)
--- a/Data/Time/HTTP/Common.hs
+++ b/Data/Time/Format/HTTP/Common.hs
@@ -2,7 +2,7 @@
     OverloadedStrings
   , UnicodeSyntax
   #-}
-module Data.Time.HTTP.Common
+module Data.Time.Format.HTTP.Common
     ( shortWeekDayName
     , shortWeekDayNameP
 
@@ -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
@@ -250,6 +258,7 @@ digit' = fromIntegral <$> fromC <$> P.digit
       fromC c = ord c - ord '0'
 
 show4digitsTZ ∷ TimeZone → AsciiBuilder
+{-# INLINEABLE show4digitsTZ #-}
 show4digitsTZ tz
     = case timeZoneMinutes tz of
         offset | offset <  0 → A.toAsciiBuilder "-" ⊕ showTZ' (negate offset)
@@ -262,6 +271,7 @@ show4digitsTZ tz
               show2 h ⊕ show2 m
 
 read4digitsTZ ∷ Parser TimeZone
+{-# INLINEABLE read4digitsTZ #-}
 read4digitsTZ
     = do sign   ← (char '+' *> return 1)
                   <|>
@@ -282,7 +292,7 @@ assertWeekDayIsGood givenWD gregDay
           (year, month, day) = toGregorian gregDay
       in
         unless (givenWD ≡ correctWD)
-            $ fail
+            ∘ fail
             $ concat [ "Gregorian day "
                      , show year
                      , "-"
@@ -332,3 +342,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