@@ -1,4 +1,4 @@
1−{-# LANGUAGE Rank2Types, RecordWildCards #-}
1+{-# LANGUAGE BangPatterns, Rank2Types, RecordWildCards #-}
22-- |
33-- Module : Data.Attoparsec.Internal
44-- Copyright : Bryan O'Sullivan 2007-2010
@@ -46,6 +46,7 @@ module Data.Attoparsec.Internal
4646 , string
4747 , stringTransform
4848 , take
49+ , scan
4950 , takeWhile
5051 , takeWhile1
5152 , takeTill
@@ -66,8 +67,9 @@ import Data.Monoid (Monoid(..))
6667import Data.Word (Word8)
6768import Foreign.ForeignPtr (withForeignPtr)
6869import Foreign.Ptr (castPtr, plusPtr)
69−import Foreign.Storable (Storable(peek, sizeOf))
70+import Foreign.Storable (Storable(peek, sizeOf), peekByteOff)
7071import Prelude hiding (getChar, take, takeWhile)
72+import System.IO.Unsafe (unsafePerformIO)
7173import qualified Data.ByteString as B8
7274import qualified Data.ByteString.Char8 as B
7375import qualified Data.ByteString.Internal as B
@@ -148,6 +150,7 @@ plus a b = Parser $ \st0 kf ks ->
148150
149151instance MonadPlus Parser where
150152 mzero = failDesc "mzero"
153+ {-# INLINE mzero #-}
151154 mplus = plus
152155
153156fmapP :: (a -> b) -> Parser a -> Parser b
@@ -174,8 +177,14 @@ instance Applicative Parser where
174177 (*>) = (>>)
175178 x <* y = x >>= \a -> y >> return a
176179
180+instance Monoid (Parser a) where
181+ mempty = failDesc "mempty"
182+ {-# INLINE mempty #-}
183+ mappend = plus
184+
177185instance Alternative Parser where
178186 empty = failDesc "empty"
187+ {-# INLINE empty #-}
179188 (<|>) = plus
180189
181190failDesc :: String -> Parser a
@@ -335,6 +344,7 @@ skipWhile p = go
335344 t <- B8.dropWhile p <$> get
336345 put t
337346 when (B.null t) go
347+{-# INLINE skipWhile #-}
338348
339349-- | Consume input as long as the predicate returns 'False'
340350-- (i.e. until it returns 'True'), and return the consumed input.
@@ -372,6 +382,42 @@ takeWhile p = go
372382 else return h
373383 else return B.empty
374384
385+-- | A stateful scanner. The predicate consumes and transforms a
386+-- state argument, and each transformed state is passed to successive
387+-- invocations of the predicate on each byte of the input until one
388+-- returns 'Nothing' or the input ends.
389+--
390+-- This parser does not fail. It will return an empty string if the
391+-- predicate returns 'Nothing' on the first byte of input.
392+--
393+-- /Note/: Because this parser does not fail, do not use it with
394+-- combinators such as 'many', because such parsers loop until a
395+-- failure occurs. Careless use will thus result in an infinite loop.
396+scan :: Show s => s -> (s -> Word8 -> Maybe s) -> Parser B.ByteString
397+scan s0 p = go s0
398+ where
399+ go s1 = do
400+ input <- wantInput
401+ if input
402+ then do
403+ let scanner (B.PS fp off len) =
404+ withForeignPtr fp $ \ptr -> do
405+ let inner !i !s | i == off+len = return (i-off,s)
406+ | otherwise = do
407+ w <- peekByteOff ptr i
408+ case p s w of
409+ Just s' -> inner (i+1) s'
410+ Nothing -> return (i-off,s)
411+ (i,s') <- inner off s1
412+ return (B.PS fp off i, B.PS fp (off+i) (len-i),s')
413+ (h,t,s') <- (unsafePerformIO . scanner) <$> get
414+ put t
415+ if B.null t
416+ then (h+++) `fmapP` go s'
417+ else return h
418+ else return B.empty
419+{-# INLINE scan #-}
420+
375421-- | Consume input as long as the predicate returns 'True', and return
376422-- the consumed input.
377423--