diff options
Diffstat (limited to 'haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs')
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs | 233 |
1 files changed, 233 insertions, 0 deletions
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs new file mode 100644 index 00000000..dde0c27a --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs @@ -0,0 +1,233 @@ +{-# LANGUAGE BangPatterns, CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} -- Imports internal modules +#endif +-- | +-- Module : Data.Attoparsec.Combinator +-- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : portable +-- +-- Useful parser combinators, similar to those provided by Parsec. +module Data.Attoparsec.Combinator + ( + -- * Combinators + try + , (<?>) + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , feed + , satisfyElem + , endOfInput + , atEnd + , lookAhead + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (Applicative(..), (<$>)) +import Data.Monoid (Monoid(mappend)) +#endif +import Control.Applicative (Alternative(..), empty, liftA2, many, (<|>)) +import Control.Monad (MonadPlus(..)) +import Data.Attoparsec.Internal.Types (Parser(..), IResult(..)) +import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem) +import Data.ByteString (ByteString) +import Prelude hiding (succ) + +-- | Attempt a parse, and if it fails, rewind the input so that no +-- input appears to have been consumed. +-- +-- This combinator is provided for compatibility with Parsec. +-- attoparsec parsers always backtrack on failure. +try :: Parser i a -> Parser i a +try p = p +{-# INLINE try #-} + +-- | Name the parser, in case failure occurs. +(<?>) :: Parser i a + -> String -- ^ the name to use if parsing fails + -> Parser i a +p <?> msg0 = Parser $ \t pos more lose succ -> + let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg + in runParser p t pos more lose' succ +{-# INLINE (<?>) #-} +infix 0 <?> + +-- | @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 +{-# SPECIALIZE choice :: [Parser ByteString a] + -> Parser ByteString a #-} + +-- | @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 +{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-} + +-- | 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` (char ',') +sepBy :: Alternative f => f a -> f s -> f [a] +sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] +{-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @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'` (char ',') +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 []) +{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @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` (char ',') +sepBy1 :: Alternative f => f a -> f s -> f [a] +sepBy1 p s = scan + where scan = liftA2 (:) p ((s *> scan) <|> pure []) +{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @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'` (char ',') +sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] +sepBy1' p s = scan + where scan = liftM2' (:) p ((s >> scan) `mplus` return []) +{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @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 "<!--" *> manyTill anyChar (string "-->") +-- +-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. +-- While this will work, it is not very efficient, as it will cause a +-- lot of backtracking.) +manyTill :: Alternative f => f a -> f b -> f [a] +manyTill p end = scan + where scan = (end *> pure []) <|> liftA2 (:) p scan +{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b + -> Parser ByteString [a] #-} + +-- | @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 "<!--" *> manyTill' anyChar (string "-->") +-- +-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. +-- While this will work, it is not very efficient, as it will cause a +-- lot of backtracking.) +-- +-- The value returned by @p@ is forced to WHNF. +manyTill' :: (MonadPlus m) => m a -> m b -> m [a] +manyTill' p end = scan + where scan = (end >> return []) `mplus` liftM2' (:) p scan +{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b + -> Parser ByteString [a] #-} + +-- | Skip zero or more instances of an action. +skipMany :: Alternative f => f a -> f () +skipMany p = scan + where scan = (p *> scan) <|> pure () +{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-} + +-- | Skip one or more instances of an action. +skipMany1 :: Alternative f => f a -> f () +skipMany1 p = p *> skipMany p +{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-} + +-- | Apply the given action repeatedly, returning every result. +count :: Monad m => Int -> m a -> m [a] +count n p = sequence (replicate n p) +{-# INLINE count #-} + +-- | Combine two alternatives. +eitherP :: (Alternative f) => f a -> f b -> f (Either a b) +eitherP a b = (Left <$> a) <|> (Right <$> b) +{-# INLINE eitherP #-} + +-- | If a parser has returned a 'T.Partial' result, supply it with more +-- input. +feed :: Monoid i => IResult i r -> i -> IResult i r +feed (Fail t ctxs msg) d = Fail (mappend t d) ctxs msg +feed (Partial k) d = k d +feed (Done t r) d = Done (mappend t d) r +{-# INLINE feed #-} + +-- | Apply a parser without consuming any input. +lookAhead :: Parser i a -> Parser i a +lookAhead p = Parser $ \t pos more lose succ -> + let succ' t' _pos' more' = succ t' pos more' + in runParser p t pos more lose succ' +{-# INLINE lookAhead #-} |