X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FParser.hs;h=ac1bf02734f0a09485eddf924002f8d4fc27b88e;hb=b1fac0a2cb1cafa008c0efa8ae4e14afbee0927f;hp=6b935c8aed2af35805f257a26f25de44e95b6a4f;hpb=ece223c516e66223ef1d5d8e6bbe4054a235d983;p=Lucu.git diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs index 6b935c8..ac1bf02 100644 --- a/Network/HTTP/Lucu/Parser.hs +++ b/Network/HTTP/Lucu/Parser.hs @@ -1,97 +1,30 @@ {-# LANGUAGE - BangPatterns - , ScopedTypeVariables - , UnicodeSyntax + UnicodeSyntax #-} -- |This is an auxiliary parser utilities. You usually don't have to -- use this module directly. module Network.HTTP.Lucu.Parser ( atMost - , manyOctetsTill + , finishOff ) where -import Blaze.ByteString.Builder (Builder, Write) -import qualified Blaze.ByteString.Builder as BB -import qualified Blaze.ByteString.Builder.Internal as BI import Control.Applicative -import Control.Applicative.Unicode hiding ((∅)) +import Control.Applicative.Unicode import Control.Monad.Unicode -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LS -import Data.Monoid -import Data.Monoid.Unicode -import Data.Word +import Data.Attoparsec import Prelude.Unicode -- |@'atMost' n v@ is like @'P.many' v@ but accumulates @v@ at most -- @n@ times. -atMost ∷ Alternative f ⇒ Int → f a → f [a] +atMost ∷ Alternative f ⇒ Int → f α → f [α] {-# INLINE atMost #-} atMost 0 _ = pure [] atMost n v = ( (:) <$> v ⊛ atMost (n-1) v ) <|> pure [] -data OctetAccumState - = OctetAccumState { - casChunks ∷ !Builder - , casLastChunk ∷ !Write - } - -instance Monoid OctetAccumState where - {-# INLINE mempty #-} - mempty - = OctetAccumState { - casChunks = (∅) - , casLastChunk = (∅) - } - {-# INLINEABLE mappend #-} - mappend !a !b - = b { - casChunks = casChunks a ⊕ lastChunk a ⊕ casChunks b - } - -lastChunk ∷ OctetAccumState → Builder -{-# INLINEABLE lastChunk #-} -lastChunk !s = case toChunk s of - c → BB.insertByteString c - where - toChunk ∷ OctetAccumState → BS.ByteString - {-# INLINE toChunk #-} - toChunk = BB.toByteString ∘ BB.fromWrite ∘ casLastChunk - -snoc ∷ OctetAccumState → Word8 → OctetAccumState -{-# INLINEABLE snoc #-} -snoc !s !o - | BI.getBound (casLastChunk s) ≥ BI.defaultBufferSize - = s { - casChunks = casChunks s ⊕ lastChunk s - , casLastChunk = BB.writeWord8 o - } - | otherwise - = s { - casLastChunk = casLastChunk s ⊕ BB.writeWord8 o - } - -finish ∷ OctetAccumState → LS.ByteString -{-# INLINEABLE finish #-} -finish = BB.toLazyByteString ∘ toChunks - where - toChunks ∷ OctetAccumState → Builder - {-# INLINE toChunks #-} - toChunks !s = casChunks s ⊕ lastChunk s - --- |@'manyOctetsTill' p end@ takes as many octets untill @p@ succeeds. -manyOctetsTill ∷ ∀m b. (Monad m, Alternative m) - ⇒ m Word8 - → m b - → m LS.ByteString -{-# INLINEABLE manyOctetsTill #-} -manyOctetsTill p end = scan (∅) - where - scan ∷ OctetAccumState → m LS.ByteString - {-# INLINE scan #-} - scan !s - = (end *> pure (finish s)) - <|> - (scan =≪ (snoc s <$> p)) +-- |@'finishOff' p@ is equivalent to @p '>>=' \\a -> 'endOfInput' '>>' +-- 'return' a@. +finishOff ∷ Parser α → Parser α +{-# INLINE finishOff #-} +finishOff = ((endOfInput *>) ∘ return =≪)