{-# LANGUAGE BangPatterns #-}
module Data.Attoparsec.Combinator
(
try
, (<?>)
, choice
, count
, option
, many'
, many1
, many1'
, manyTill
, manyTill'
, sepBy
, sepBy'
, sepBy1
, sepBy1'
, skipMany
, skipMany1
, eitherP
, feed
, satisfyElem
, endOfInput
, atEnd
) where
import Control.Applicative (Alternative(..), Applicative(..), 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 Data.Monoid (Monoid(mappend))
import Data.Text (Text)
import qualified Data.Attoparsec.Zepto as Z
import Prelude hiding (succ)
try :: Parser i a -> Parser i a
try p = p
{-# INLINE try #-}
(<?>) :: Parser i a
-> String
-> 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 :: Alternative f => [f a] -> f a
choice = foldr (<|>) empty
{-# SPECIALIZE choice :: [Parser ByteString a]
-> Parser ByteString a #-}
{-# SPECIALIZE choice :: [Parser Text a] -> Parser Text a #-}
{-# SPECIALIZE choice :: [Z.Parser a] -> Z.Parser a #-}
option :: Alternative f => a -> f a -> f a
option x p = p <|> pure x
{-# 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 #-}
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' :: (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 :: Alternative f => f a -> f [a]
many1 p = liftA2 (:) p (many p)
{-# INLINE many1 #-}
many1' :: (MonadPlus m) => m a -> m [a]
many1' p = liftM2' (:) p (many' p)
{-# INLINE many1' #-}
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] #-}
{-# SPECIALIZE sepBy :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
{-# SPECIALIZE sepBy :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
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] #-}
{-# SPECIALIZE sepBy' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
{-# SPECIALIZE sepBy' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
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] #-}
{-# SPECIALIZE sepBy1 :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
{-# SPECIALIZE sepBy1 :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
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] #-}
{-# SPECIALIZE sepBy1' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}
{-# SPECIALIZE sepBy1' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}
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] #-}
{-# SPECIALIZE manyTill :: Parser Text a -> Parser Text b -> Parser Text [a] #-}
{-# SPECIALIZE manyTill :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-}
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] #-}
{-# SPECIALIZE manyTill' :: Parser Text a -> Parser Text b -> Parser Text [a] #-}
{-# SPECIALIZE manyTill' :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-}
skipMany :: Alternative f => f a -> f ()
skipMany p = scan
where scan = (p *> scan) <|> pure ()
{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-}
{-# SPECIALIZE skipMany :: Parser Text a -> Parser Text () #-}
{-# SPECIALIZE skipMany :: Z.Parser a -> Z.Parser () #-}
skipMany1 :: Alternative f => f a -> f ()
skipMany1 p = p *> skipMany p
{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-}
{-# SPECIALIZE skipMany1 :: Parser Text a -> Parser Text () #-}
{-# SPECIALIZE skipMany1 :: Z.Parser a -> Z.Parser () #-}
count :: Monad m => Int -> m a -> m [a]
count n p = sequence (replicate n p)
{-# INLINE count #-}
eitherP :: (Alternative f) => f a -> f b -> f (Either a b)
eitherP a b = (Left <$> a) <|> (Right <$> b)
{-# INLINE eitherP #-}
feed :: Monoid i => IResult i r -> i -> IResult i r
feed f@(Fail _ _ _) _ = f
feed (Partial k) d = k d
feed (Done t r) d = Done (mappend t d) r
{-# INLINE feed #-}