X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Data%2FTime%2FFormat%2FHTTP%2FCommon.hs;fp=Data%2FTime%2FHTTP%2FCommon.hs;h=b7e3b9ed5a310e35f82ae2174ce1af49058cfac4;hp=f7c74c91e1326b5944ea06d5082c0415ac2f0044;hb=2064aacf48e193924b6ffe18a50853d233c16b98;hpb=901a3635d37e25a2d4c2e1562c32c68c410fbdd3 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 f7c74c9..b7e3b9e 100644 --- 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