module Darcs.Util.Parser ( Parser , anyChar , char , checkConsumes , choice , endOfInput , int , lexChar , lexString , linesStartingWith , linesStartingWithEndingWith , lexWord , option , optional , parse , skipSpace , skipWhile , string , take , takeTill , takeTillChar ) where import Control.Applicative ( empty, many, optional, (<|>) ) import Darcs.Prelude hiding ( lex, take ) import qualified Data.Attoparsec.ByteString as A import Data.Attoparsec.ByteString.Char8 hiding ( parse, char, string ) import qualified Data.Attoparsec.ByteString.Char8 as AC import qualified Data.ByteString as B parse :: Parser a -> B.ByteString -> Either String (a, B.ByteString) parse :: forall a. Parser a -> ByteString -> Either String (a, ByteString) parse Parser a p ByteString bs = case forall a. Parser a -> ByteString -> Result a AC.parse Parser a p ByteString bs of Fail ByteString _ [String] ss String s -> forall a b. a -> Either a b Left forall a b. (a -> b) -> a -> b $ [String] -> String unlines (String sforall a. a -> [a] -> [a] :[String] ss) Partial ByteString -> IResult ByteString a k -> case ByteString -> IResult ByteString a k ByteString B.empty of Fail ByteString _ [String] ss String s -> forall a b. a -> Either a b Left forall a b. (a -> b) -> a -> b $ [String] -> String unlines (String sforall a. a -> [a] -> [a] :[String] ss) Partial ByteString -> IResult ByteString a _ -> forall a. HasCallStack => String -> a error String "impossible" Done ByteString i a r -> forall a b. b -> Either a b Right (a r, ByteString i) Done ByteString i a r -> forall a b. b -> Either a b Right (a r, ByteString i) {-# INLINE skip #-} skip :: Parser a -> Parser () skip :: forall a. Parser a -> Parser () skip Parser a p = Parser a p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall (m :: * -> *) a. Monad m => a -> m a return () {-# INLINE lex #-} lex :: Parser a -> Parser a lex :: forall a. Parser a -> Parser a lex Parser a p = Parser () skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parser a p {-# INLINE lexWord #-} lexWord :: Parser B.ByteString lexWord :: Parser ByteString lexWord = forall a. Parser a -> Parser a lex ((Word8 -> Bool) -> Parser ByteString A.takeWhile1 (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . Word8 -> Bool isSpace_w8)) {-# INLINE lexChar #-} lexChar :: Char -> Parser () lexChar :: Char -> Parser () lexChar Char c = forall a. Parser a -> Parser a lex (Char -> Parser () char Char c) {-# inline lexString #-} lexString :: B.ByteString -> Parser () lexString :: ByteString -> Parser () lexString ByteString s = forall a. Parser a -> Parser a lex (ByteString -> Parser () string ByteString s) {-# INLINE char #-} char :: Char -> Parser () char :: Char -> Parser () char = forall a. Parser a -> Parser () skip forall b c a. (b -> c) -> (a -> b) -> a -> c . Char -> Parser Char AC.char {-# INLINE string #-} string :: B.ByteString -> Parser () string :: ByteString -> Parser () string = forall a. Parser a -> Parser () skip forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Parser ByteString AC.string {-# INLINE int #-} int :: Parser Int int :: Parser Int int = forall a. Parser a -> Parser a lex (forall a. Num a => Parser a -> Parser a signed forall a. Integral a => Parser a decimal) {-# INLINE takeTillChar #-} takeTillChar :: Char -> Parser B.ByteString takeTillChar :: Char -> Parser ByteString takeTillChar Char c = (Char -> Bool) -> Parser ByteString takeTill (forall a. Eq a => a -> a -> Bool == Char c) {-# INLINE checkConsumes #-} checkConsumes :: Parser a -> Parser a checkConsumes :: forall a. Parser a -> Parser a checkConsumes Parser a parser = do (ByteString consumed, a result) <- forall a. Parser a -> Parser (ByteString, a) match Parser a parser if ByteString -> Bool B.null ByteString consumed then forall (f :: * -> *) a. Alternative f => f a empty else forall (m :: * -> *) a. Monad m => a -> m a return a result {-# INLINE linesStartingWith #-} linesStartingWith :: Char -> Parser [B.ByteString] linesStartingWith :: Char -> Parser [ByteString] linesStartingWith Char c = forall (f :: * -> *) a. Alternative f => f a -> f [a] many forall a b. (a -> b) -> a -> b $ do Char -> Parser () char Char c ByteString r <- Char -> Parser ByteString takeTillChar Char '\n' forall a. Parser a -> Parser () skip (Char -> Parser () char Char '\n') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> forall t. Chunk t => Parser t () endOfInput forall (m :: * -> *) a. Monad m => a -> m a return ByteString r {-# INLINE linesStartingWithEndingWith #-} linesStartingWithEndingWith :: Char -> Char -> Parser [B.ByteString] linesStartingWithEndingWith :: Char -> Char -> Parser [ByteString] linesStartingWithEndingWith Char st Char en = do [ByteString] ls <- Char -> Parser [ByteString] linesStartingWith Char st Char -> Parser () char Char en forall (m :: * -> *) a. Monad m => a -> m a return [ByteString] ls