darcs-2.14.1: a distributed, interactive, smart revision control system

Safe HaskellNone
LanguageHaskell2010

Darcs.Patch.ReadMonads

Description

This module defines our parsing monad. In the past there have been lazy and strict parsers in this module. Currently we have only the strict variant and it is used for parsing patch files.

Synopsis

Documentation

class (Functor m, Applicative m, Alternative m, Monad m, MonadPlus m) => ParserM m where Source #

Minimal complete definition

work, peekInput, parse

Methods

parse :: m a -> ByteString -> Maybe (a, ByteString) Source #

Run the parser

take :: ParserM m => Int -> m ByteString Source #

Takes exactly n bytes, or fails.

parse :: ParserM m => m a -> ByteString -> Maybe (a, ByteString) Source #

Run the parser

parseStrictly :: SM a -> ByteString -> Maybe (a, ByteString) Source #

parseStrictly applies the parser functions to a string and checks that each parser produced a result as it goes. The strictness is in the ParserM instance for SM.

char :: ParserM m => Char -> m () Source #

Accepts only the specified character. Consumes a character, if available.

int :: ParserM m => m Int Source #

Parse an integer and return it. Skips leading whitespaces and | uses the efficient ByteString readInt.

option :: Alternative f => a -> f a -> f a Source #

If p fails it returns x, otherwise it returns the result of p.

choice :: Alternative f => [f a] -> f a Source #

Attempts each option until one succeeds.

skipSpace :: ParserM m => m () Source #

Discards spaces until a non-space character is encountered. Always succeeds.

skipWhile :: ParserM m => (Char -> Bool) -> m () Source #

Discards any characters as long as p returns True. Always | succeeds.

string :: ParserM m => ByteString -> m () Source #

Only succeeds if the characters in the input exactly match str.

lexChar :: ParserM m => Char -> m () Source #

lexChar checks if the next space delimited token from the input stream matches a specific Char. Uses Maybe inside ParserM to handle failed matches, so that it always returns () on success.

lexString :: ParserM m => ByteString -> m () Source #

lexString fetches the next whitespace delimited token from from the input and checks if it matches the ByteString input. Uses Maybe inside ParserM to handle failed matches, so that it always returns () on success.

lexEof :: ParserM m => m () Source #

lexEof looks for optional spaces followed by the end of input. Uses Maybe inside ParserM to handle failed matches, so that it always returns () on success.

takeTillChar :: ParserM m => Char -> m ByteString Source #

Equivalent to takeTill (==c), except that it is optimized for | the equality case.

myLex' :: ParserM m => m ByteString Source #

Like myLex except that it is in ParserM

anyChar :: ParserM m => m Char Source #

Accepts the next character and returns it. Only fails at end of input.

endOfInput :: ParserM m => m () Source #

Only succeeds at end of input, consumes no characters.

takeTill :: ParserM m => (Char -> Bool) -> m ByteString Source #

Takes characters while p returns True. Always succeeds.

checkConsumes :: ParserM m => m a -> m a Source #

Ensure that a parser consumes input when producing a result Causes the initial state of the input stream to be held on to while the parser runs, so use with caution.

linesStartingWith :: ParserM m => Char -> m [ByteString] Source #

This is a highly optimized way to read lines that start with a particular character. To implement this efficiently we need access to the parser's internal state. If this is implemented in terms of the other primitives for the parser it requires us to consume one character at a time. That leads to (>>=) wasting significant time.

linesStartingWithEndingWith :: ParserM m => Char -> Char -> m [ByteString] Source #

This is a highly optimized way to read lines that start with a particular character, and stops when it reaches a particular | character. See linesStartingWith for details on why this | defined here as a primitive.