attoparsec-0.10.4.0/0000755000000000000000000000000012102411216012253 5ustar0000000000000000attoparsec-0.10.4.0/attoparsec.cabal0000644000000000000000000000605212102411216015407 0ustar0000000000000000name: attoparsec version: 0.10.4.0 license: BSD3 license-file: LICENSE category: Text, Parsing author: Bryan O'Sullivan maintainer: Bryan O'Sullivan stability: experimental tested-with: GHC == 6.12.3, GHC == 7.0.3, GHC == 7.2.1, GHC == 7.4.2, GHC == 7.6.1 synopsis: Fast combinator parsing for bytestrings and text cabal-version: >= 1.8 homepage: https://github.com/bos/attoparsec bug-reports: https://github.com/bos/attoparsec/issues build-type: Simple description: A fast parser combinator library, aimed particularly at dealing efficiently with network protocols and complicated text/binary file formats. extra-source-files: README.markdown benchmarks/Benchmarks.hs benchmarks/Makefile benchmarks/Tiny.hs benchmarks/attoparsec-benchmarks.cabal benchmarks/med.txt.bz2 examples/Makefile examples/Parsec_RFC2616.hs examples/RFC2616.hs examples/TestRFC2616.hs examples/rfc2616.c tests/Makefile tests/QC.hs tests/QC/*.hs tests/TestFastSet.hs Flag developer Description: Whether to build the library in development mode Default: False library build-depends: array, base >= 3 && < 5, bytestring, containers, deepseq, text >= 0.11.1.5 exposed-modules: Data.Attoparsec Data.Attoparsec.ByteString Data.Attoparsec.ByteString.Char8 Data.Attoparsec.ByteString.Lazy Data.Attoparsec.Char8 Data.Attoparsec.Combinator Data.Attoparsec.Lazy Data.Attoparsec.Number Data.Attoparsec.Text Data.Attoparsec.Text.Lazy Data.Attoparsec.Types Data.Attoparsec.Zepto other-modules: Data.Attoparsec.ByteString.FastSet Data.Attoparsec.ByteString.Internal Data.Attoparsec.Internal Data.Attoparsec.Internal.Types Data.Attoparsec.Text.FastSet Data.Attoparsec.Text.Internal ghc-options: -O2 -Wall if flag(developer) ghc-prof-options: -auto-all test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: QC.hs other-modules: QC.ByteString QC.Text ghc-options: -Wall -threaded -rtsopts build-depends: attoparsec, base >= 4 && < 5, bytestring, QuickCheck >= 2.4, test-framework >= 0.4, test-framework-quickcheck2 >= 0.2, text benchmark benchmarks type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Benchmarks.hs build-depends: attoparsec, base, bytestring, criterion >= 0.5, deepseq >= 1.1, parsec >= 3.1.2, text source-repository head type: git location: https://github.com/bos/attoparsec source-repository head type: mercurial location: https://bitbucket.org/bos/attoparsec attoparsec-0.10.4.0/LICENSE0000644000000000000000000000266312102411215013266 0ustar0000000000000000Copyright (c) Lennart Kolmodin All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. attoparsec-0.10.4.0/README.markdown0000644000000000000000000000143512102411215014756 0ustar0000000000000000# Welcome to attoparsec attoparsec is a fast Haskell parser combinator library, aimed particularly at dealing efficiently with network protocols and complicated text/binary file formats. # Join in! I'm happy to receive bug reports, fixes, documentation enhancements, and other improvements. Please report bugs via the [github issue tracker](https://github.com/bos/attoparsec/issues). Master [git repository](https://github.com/bos/attoparsec): * `git clone git://github.com/bos/attoparsec.git` There's also a [Mercurial mirror](https://bitbucket.org/bos/attoparsec): * `hg clone https://bitbucket.org/bos/attoparsec` (You can create and contribute changes using either Mercurial or git.) Authors ------- This library is written and maintained by Bryan O'Sullivan, . attoparsec-0.10.4.0/Setup.lhs0000644000000000000000000000011412102411216014057 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain attoparsec-0.10.4.0/benchmarks/0000755000000000000000000000000012102411215014367 5ustar0000000000000000attoparsec-0.10.4.0/benchmarks/attoparsec-benchmarks.cabal0000644000000000000000000000053712102411215021640 0ustar0000000000000000-- These benchmarks are not intended to be installed. -- So don't install 'em. name: attoparsec-benchmarks version: 0 cabal-version: >=1.2 build-type: Simple executable attoparsec-benchmarks main-is: Benchmarks.hs build-depends: attoparsec, base, bytestring, criterion >= 0.5, deepseq == 1.1.*, parsec >= 3.1.2, text attoparsec-0.10.4.0/benchmarks/Benchmarks.hs0000644000000000000000000000762112102411215017006 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP #-} import Control.Applicative import Control.DeepSeq (NFData(rnf)) import Criterion.Main (bench, bgroup, defaultMain, nf, whnf) import Data.Bits (unsafeShiftL) import Data.ByteString.Internal (ByteString(..)) import Data.Char import Data.Word (Word32) import Text.Parsec.Text () import Text.Parsec.Text.Lazy () import qualified Data.Attoparsec.ByteString as AB import qualified Data.Attoparsec.ByteString.Char8 as AC import qualified Data.Attoparsec.ByteString.Lazy as ABL import qualified Data.Attoparsec.Text as AT import qualified Data.Attoparsec.Text.Lazy as ATL import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Word (Word8) import qualified Text.Parsec as P #if !MIN_VERSION_bytestring(0,10,0) instance NFData ByteString where rnf (PS _ _ _) = () #endif instance NFData P.ParseError where rnf = rnf . show chunksOf :: Int -> [a] -> [[a]] chunksOf k = go where go xs = case splitAt k xs of ([],_) -> [] (y, ys) -> y : go ys fromLazy :: BL.ByteString -> B.ByteString fromLazy = B.concat . BL.toChunks main = do let s = take 1024 . cycle $ ['a'..'z'] ++ ['A'..'Z'] !b = BC.pack s !bl = BL.fromChunks . map BC.pack . chunksOf 4 $ s !t = T.pack s !tl = TL.fromChunks . map T.pack . chunksOf 4 $ s defaultMain [ bgroup "many" [ bgroup "attoparsec" [ bench "B" $ nf (AB.parse (many (AC.satisfy AC.isAlpha_ascii))) b , bench "BL" $ nf (ABL.parse (many (AC.satisfy AC.isAlpha_ascii))) bl , bench "T" $ nf (AT.parse (many (AT.satisfy AC.isAlpha_ascii))) t , bench "TL" $ nf (ATL.parse (many (AT.satisfy AC.isAlpha_ascii))) tl ] , bgroup "parsec" [ bench "S" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") s , bench "B" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") b , bench "BL" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") bl , bench "T" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") t , bench "TL" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") tl ] ] , bgroup "comparison" [ bgroup "many-vs-takeWhile" [ bench "many" $ nf (AB.parse (many (AC.satisfy AC.isAlpha_ascii))) b , bench "takeWhile" $ nf (AB.parse (AC.takeWhile AC.isAlpha_ascii)) b ] , bgroup "letter-vs-isAlpha" [ bench "letter" $ nf (AB.parse (many AC.letter_ascii)) b , bench "isAlpha" $ nf (AB.parse (many (AC.satisfy AC.isAlpha_ascii))) b ] ] , bgroup "takeWhile" [ bench "isAlpha" $ nf (ABL.parse (AC.takeWhile isAlpha)) bl , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl , bench "isAlpha_iso8859_15" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl ] , bench "word32LE" $ nf (AB.parse word32LE) b , bgroup "scan" [ bench "short" $ nf (AB.parse quotedString) (BC.pack "abcdefghijk\"") , bench "long" $ nf (AB.parse quotedString) b ] ] -- Benchmarks bind and (potential) bounds-check merging. word32LE :: AB.Parser Word32 word32LE = do w1 <- AB.anyWord8 w2 <- AB.anyWord8 w3 <- AB.anyWord8 w4 <- AB.anyWord8 return $! (fromIntegral w1 :: Word32) + fromIntegral w2 `unsafeShiftL` 8 + fromIntegral w3 `unsafeShiftL` 16 + fromIntegral w4 `unsafeShiftL` 32 doubleQuote, backslash :: Word8 doubleQuote = 34 backslash = 92 {-# INLINE backslash #-} {-# INLINE doubleQuote #-} -- | Parse a string without a leading quote. quotedString :: AB.Parser B.ByteString quotedString = AB.scan False $ \s c -> if s then Just False else if c == doubleQuote then Nothing else Just (c == backslash) attoparsec-0.10.4.0/benchmarks/Makefile0000644000000000000000000000016012102411215016024 0ustar0000000000000000all: med.txt tiny tiny: Tiny.hs ghc -O --make -o $@ $< %: %.bz2 bunzip2 -k $< clean: -rm -f *.o *.hi tiny attoparsec-0.10.4.0/benchmarks/med.txt.bz20000644000000000000000000000100612102411215016366 0ustar0000000000000000BZh91AY&SYOÿ`1Ì! €`2Ž@¼@@@J‰¤ôG©¤¡UD ¸” u„ „ IB„iB’„ ¥Ò„d¡êPêPæ©BIBIBÒ„Ô¡iB„ R„ %J6” rJ9%J0” yJ1J=J;J:J2” |’„„„R„ Ò„‰B„æ(+$Êk:ñÔ e¸á0Œ@1À;€@4@4@4¨šM¤zšJ5TJ ‰BQ(@Ñ(@Ñ(@å(@õ(@ÒP”¡´¡ÒPö” z” t” e(@ÚPû¡t¡)B”¡ B„ %R„„)B B„ R„ ¥J=¥Ò„©BR„’P´¡iB„ ¥)B„æ(+$Êk#õŠÀ)§0Œ@1À3jD@j”#Ôõ R©¦†™UP€Rnª©%åUQ/$¸KeT“ )0“Šª’v%ô–êª%Ø .ªª%Ÿ Z%ø–€IeUD²ª¢Zè–’ÕUD¸%À ,%€$·UQ,ª¨–ÀIz%Ø L¤æª©&€RhK€$ºª¨—°YPR~.äŠp¡!Öã attoparsec-0.10.4.0/benchmarks/Tiny.hs0000644000000000000000000000171612102411215015653 0ustar0000000000000000import Control.Applicative ((<|>), many) import Control.Monad (forM_) import System.Environment (getArgs) import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.ByteString.Char8 as B import qualified Text.Parsec as P import qualified Text.Parsec.ByteString as P attoparsec = do args <- getArgs forM_ args $ \arg -> do input <- B.readFile arg case A.parse p input `A.feed` B.empty of A.Done _ xs -> print (length xs) what -> print what where slow = many (A.many1 A.letter_ascii <|> A.many1 A.digit) fast = many (A.takeWhile1 isLetter <|> A.takeWhile1 isDigit) isDigit c = c >= '0' && c <= '9' isLetter c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') p = fast parsec = do args <- getArgs forM_ args $ \arg -> do input <- readFile arg case P.parse (P.many (P.many1 P.letter P.<|> P.many1 P.digit)) "" input of Left err -> print err Right xs -> print (length xs) main = attoparsec attoparsec-0.10.4.0/Data/0000755000000000000000000000000012102411215013123 5ustar0000000000000000attoparsec-0.10.4.0/Data/Attoparsec.hs0000644000000000000000000000065612102411215015573 0ustar0000000000000000-- | -- Module : Data.Attoparsec -- Copyright : Bryan O'Sullivan 2007-2011 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Simple, efficient combinator parsing for 'ByteString' strings, -- loosely based on the Parsec library. module Data.Attoparsec ( module Data.Attoparsec.ByteString ) where import Data.Attoparsec.ByteString attoparsec-0.10.4.0/Data/Attoparsec/0000755000000000000000000000000012102411215015230 5ustar0000000000000000attoparsec-0.10.4.0/Data/Attoparsec/ByteString.hs0000644000000000000000000001523712102411215017666 0ustar0000000000000000-- | -- Module : Data.Attoparsec.ByteString -- Copyright : Bryan O'Sullivan 2007-2011 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Simple, efficient combinator parsing for 'B.ByteString' strings, -- loosely based on the Parsec library. module Data.Attoparsec.ByteString ( -- * Differences from Parsec -- $parsec -- * Incremental input -- $incremental -- * Performance considerations -- $performance -- * Parser types I.Parser , Result , T.IResult(..) , I.compareResults -- * Running parsers , parse , feed , I.parseOnly , parseWith , parseTest -- ** Result conversion , maybeResult , eitherResult -- * Combinators , (I.) , I.try , module Data.Attoparsec.Combinator -- * Parsing individual bytes , I.word8 , I.anyWord8 , I.notWord8 , I.peekWord8 , I.satisfy , I.satisfyWith , I.skip -- ** Byte classes , I.inClass , I.notInClass -- * Efficient string handling , I.string , I.skipWhile , I.take , I.scan , I.takeWhile , I.takeWhile1 , I.takeTill -- ** Consume all remaining input , I.takeByteString , I.takeLazyByteString -- * State observation and manipulation functions , I.endOfInput , I.atEnd ) where import Data.Attoparsec.Combinator import qualified Data.Attoparsec.ByteString.Internal as I import qualified Data.Attoparsec.Internal as I import qualified Data.ByteString as B import Data.Attoparsec.ByteString.Internal (Result, parse) import qualified Data.Attoparsec.Internal.Types as T -- $parsec -- -- Compared to Parsec 3, Attoparsec makes several tradeoffs. It is -- not intended for, or ideal for, all possible uses. -- -- * While Attoparsec can consume input incrementally, Parsec cannot. -- Incremental input is a huge deal for efficient and secure network -- and system programming, since it gives much more control to users -- of the library over matters such as resource usage and the I/O -- model to use. -- -- * Much of the performance advantage of Attoparsec is gained via -- high-performance parsers such as 'I.takeWhile' and 'I.string'. -- If you use complicated combinators that return lists of bytes or -- characters, there is less performance difference between the two -- libraries. -- -- * Unlike Parsec 3, Attoparsec does not support being used as a -- monad transformer. -- -- * Attoparsec is specialised to deal only with strict 'B.ByteString' -- input. Efficiency concerns rule out both lists and lazy -- bytestrings. The usual use for lazy bytestrings would be to -- allow consumption of very large input without a large footprint. -- For this need, Attoparsec's incremental input provides an -- excellent substitute, with much more control over when input -- takes place. If you must use lazy bytestrings, see the 'Lazy' -- module, which feeds lazy chunks to a regular parser. -- -- * Parsec parsers can produce more helpful error messages than -- Attoparsec parsers. This is a matter of focus: Attoparsec avoids -- the extra book-keeping in favour of higher performance. -- $incremental -- -- Attoparsec supports incremental input, meaning that you can feed it -- a bytestring that represents only part of the expected total amount -- of data to parse. If your parser reaches the end of a fragment of -- input and could consume more input, it will suspend parsing and -- return a 'T.Partial' continuation. -- -- Supplying the 'T.Partial' continuation with another bytestring will -- resume parsing at the point where it was suspended. You must be -- prepared for the result of the resumed parse to be another -- 'T.Partial' continuation. -- -- To indicate that you have no more input, supply the 'T.Partial' -- continuation with an empty bytestring. -- -- Remember that some parsing combinators will not return a result -- until they reach the end of input. They may thus cause 'T.Partial' -- results to be returned. -- -- If you do not need support for incremental input, consider using -- the 'I.parseOnly' function to run your parser. It will never -- prompt for more input. -- $performance -- -- If you write an Attoparsec-based parser carefully, it can be -- realistic to expect it to perform within a factor of 2 of a -- hand-rolled C parser (measuring megabytes parsed per second). -- -- To actually achieve high performance, there are a few guidelines -- that it is useful to follow. -- -- Use the 'B.ByteString'-oriented parsers whenever possible, -- e.g. 'I.takeWhile1' instead of 'many1' 'I.anyWord8'. There is -- about a factor of 100 difference in performance between the two -- kinds of parser. -- -- For very simple byte-testing predicates, write them by hand instead -- of using 'I.inClass' or 'I.notInClass'. For instance, both of -- these predicates test for an end-of-line byte, but the first is -- much faster than the second: -- -- >endOfLine_fast w = w == 13 || w == 10 -- >endOfLine_slow = inClass "\r\n" -- -- Make active use of benchmarking and profiling tools to measure, -- find the problems with, and improve the performance of your parser. -- | If a parser has returned a 'T.Partial' result, supply it with more -- input. feed :: Result r -> B.ByteString -> Result r feed f@(T.Fail _ _ _) _ = f feed (T.Partial k) d = k d feed (T.Done bs r) d = T.Done (B.append bs d) r {-# INLINE feed #-} -- | Run a parser and print its result to standard output. parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO () parseTest p s = print (parse p s) -- | Run a parser with an initial input string, and a monadic action -- that can supply more input if needed. parseWith :: Monad m => (m B.ByteString) -- ^ An action that will be executed to provide the parser -- with more input, if necessary. The action must return an -- 'B.empty' string when there is no more input available. -> I.Parser a -> B.ByteString -- ^ Initial input for the parser. -> m (Result a) parseWith refill p s = step $ parse p s where step (T.Partial k) = (step . k) =<< refill step r = return r {-# INLINE parseWith #-} -- | Convert a 'Result' value to a 'Maybe' value. A 'T.Partial' result -- is treated as failure. maybeResult :: Result r -> Maybe r maybeResult (T.Done _ r) = Just r maybeResult _ = Nothing -- | Convert a 'Result' value to an 'Either' value. A 'T.Partial' -- result is treated as failure. eitherResult :: Result r -> Either String r eitherResult (T.Done _ r) = Right r eitherResult (T.Fail _ _ msg) = Left msg eitherResult _ = Left "Result: incomplete input" attoparsec-0.10.4.0/Data/Attoparsec/Char8.hs0000644000000000000000000000073212102411215016533 0ustar0000000000000000-- | -- Module : Data.Attoparsec.Char8 -- Copyright : Bryan O'Sullivan 2007-2011 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Simple, efficient, character-oriented combinator parsing for -- 'ByteString' strings, loosely based on the Parsec library. module Data.Attoparsec.Char8 ( module Data.Attoparsec.ByteString.Char8 ) where import Data.Attoparsec.ByteString.Char8 attoparsec-0.10.4.0/Data/Attoparsec/Combinator.hs0000644000000000000000000002027412102411215017666 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP #-} -- | -- Module : Data.Attoparsec.Combinator -- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2009-2010 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Useful parser combinators, similar to those provided by Parsec. module Data.Attoparsec.Combinator ( choice , count , option , many' , many1 , many1' , manyTill , manyTill' , sepBy , sepBy' , sepBy1 , sepBy1' , skipMany , skipMany1 , eitherP ) where import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2, (<|>), (*>), (<$>)) import Control.Monad (MonadPlus(..)) #if !MIN_VERSION_base(4,2,0) import Control.Applicative (many) #endif #if __GLASGOW_HASKELL__ >= 700 import Data.Attoparsec.Internal.Types (Parser) import qualified Data.Attoparsec.Zepto as Z import Data.ByteString (ByteString) import Data.Text (Text) #endif -- | @choice ps@ tries to apply the actions in the list @ps@ in order, -- until one of them succeeds. Returns the value of the succeeding -- action. choice :: Alternative f => [f a] -> f a choice = foldr (<|>) empty #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE choice :: [Parser ByteString a] -> Parser ByteString a #-} {-# SPECIALIZE choice :: [Parser Text a] -> Parser Text a #-} {-# SPECIALIZE choice :: [Z.Parser a] -> Z.Parser a #-} #endif -- | @option x p@ tries to apply action @p@. If @p@ fails without -- consuming input, it returns the value @x@, otherwise the value -- returned by @p@. -- -- > priority = option 0 (digitToInt <$> digit) option :: Alternative f => a -> f a -> f a option x p = p <|> pure x #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-} {-# SPECIALIZE option :: a -> Parser Text a -> Parser Text a #-} {-# SPECIALIZE option :: a -> Z.Parser a -> Z.Parser a #-} #endif -- | A version of 'liftM2' that is strict in the result of its first -- action. liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c liftM2' f a b = do !x <- a y <- b return (f x y) {-# INLINE liftM2' #-} -- | @many' p@ applies the action @p@ /zero/ or more times. Returns a -- list of the returned values of @p@. The value returned by @p@ is -- forced to WHNF. -- -- > word = many' letter many' :: (MonadPlus m) => m a -> m [a] many' p = many_p where many_p = some_p `mplus` return [] some_p = liftM2' (:) p many_p {-# INLINE many' #-} -- | @many1 p@ applies the action @p@ /one/ or more times. Returns a -- list of the returned values of @p@. -- -- > word = many1 letter many1 :: Alternative f => f a -> f [a] many1 p = liftA2 (:) p (many p) {-# INLINE many1 #-} -- | @many1' p@ applies the action @p@ /one/ or more times. Returns a -- list of the returned values of @p@. The value returned by @p@ is -- forced to WHNF. -- -- > word = many1' letter many1' :: (MonadPlus m) => m a -> m [a] many1' p = liftM2' (:) p (many' p) {-# INLINE many1' #-} -- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. -- -- > commaSep p = p `sepBy` (symbol ",") sepBy :: Alternative f => f a -> f s -> f [a] sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} {-# SPECIALIZE sepBy :: Parser Text a -> Parser Text s -> Parser Text [a] #-} {-# SPECIALIZE sepBy :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-} #endif -- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. The value -- returned by @p@ is forced to WHNF. -- -- > commaSep p = p `sepBy'` (symbol ",") sepBy' :: (MonadPlus m) => m a -> m s -> m [a] sepBy' p s = scan `mplus` return [] where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return []) #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} {-# SPECIALIZE sepBy' :: Parser Text a -> Parser Text s -> Parser Text [a] #-} {-# SPECIALIZE sepBy' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-} #endif -- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. -- -- > commaSep p = p `sepBy1` (symbol ",") sepBy1 :: Alternative f => f a -> f s -> f [a] sepBy1 p s = scan where scan = liftA2 (:) p ((s *> scan) <|> pure []) #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} {-# SPECIALIZE sepBy1 :: Parser Text a -> Parser Text s -> Parser Text [a] #-} {-# SPECIALIZE sepBy1 :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-} #endif -- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. The value -- returned by @p@ is forced to WHNF. -- -- > commaSep p = p `sepBy1'` (symbol ",") sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] sepBy1' p s = scan where scan = liftM2' (:) p ((s >> scan) `mplus` return []) #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} {-# SPECIALIZE sepBy1' :: Parser Text a -> Parser Text s -> Parser Text [a] #-} {-# SPECIALIZE sepBy1' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-} #endif -- | @manyTill p end@ applies action @p@ /zero/ or more times until -- action @end@ succeeds, and returns the list of values returned by -- @p@. This can be used to scan comments: -- -- > simpleComment = string "")) -- -- Note the overlapping parsers @anyChar@ and @string \"")) -- -- Note the overlapping parsers @anyChar@ and @string \"