pads-haskell-0.1.0.0: PADS data description language for Haskell.

Copyright(c) 2011
Kathleen Fisher <kathleen.fisher@gmail.com>
John Launchbury <john.launchbury@gmail.com>
LicenseMIT
MaintainerKarl Cronburg <karl@cs.tufts.edu>
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

Language.Pads.PadsParser

Contents

Description

These are the combinators used to build PADS parsers. In this module we define the PadsParser parsing monad which operates in a model where each parsing step (bind in the monad) runs a function `f :: Source -> (a, Source)`. This is similar to how the Read typeclass implements parsing where we return the thing parsed by f of type a along with the remainder source input of type Source.

Some important notes for future developers: - primPads and queryP below let you define new PadsParsers using Haskell functions without having to crack open the monad yourself. - As soon as the monad encounters a failure, we stop parsing and return the parsed result as far as we got in the input string.

Synopsis

Documentation

parseStringInput :: PadsParser a -> String -> (a, String) Source #

Take a PadsParser for some type and an input String and parse the String using the PadsParser.

parseByteStringInput :: PadsParser a -> RawStream -> (a, RawStream) Source #

Same as parseStringInput but with a RawStream source as input.

parseFileInput :: PadsParser a -> FilePath -> IO a Source #

Same as parseStringInput but with a FilePath as input and IO output.

parseFileInputWithDisc :: RecordDiscipline -> PadsParser a -> FilePath -> IO a Source #

Same as parseFileInput but with the ability to specify a non-default record discipline.

The Pads Parsing Monad

newtype PadsParser a Source #

A Pads parser is a function over inputs to some type a and the remaining input.

Constructors

PadsParser 

Fields

Instances
Monad PadsParser Source #

This monad instance for Pads parsers looks just like any other sequencing monad (run the first one and pipe the result into the second) with one thing added: if any results on the way are bad, then the whole parse is bad.

Instance details

Defined in Language.Pads.PadsParser

Methods

(>>=) :: PadsParser a -> (a -> PadsParser b) -> PadsParser b #

(>>) :: PadsParser a -> PadsParser b -> PadsParser b #

return :: a -> PadsParser a #

fail :: String -> PadsParser a #

Functor PadsParser Source #

A Pads parser can be mapped over, which just says we need to run the parser, grab the resulting parsed value, and apply the function we're mapping to that result.

Instance details

Defined in Language.Pads.PadsParser

Methods

fmap :: (a -> b) -> PadsParser a -> PadsParser b #

(<$) :: a -> PadsParser b -> PadsParser a #

Applicative PadsParser Source #

Applicative instance for PadsParser to satisfy GHC

Instance details

Defined in Language.Pads.PadsParser

Methods

pure :: a -> PadsParser a #

(<*>) :: PadsParser (a -> b) -> PadsParser a -> PadsParser b #

liftA2 :: (a -> b -> c) -> PadsParser a -> PadsParser b -> PadsParser c #

(*>) :: PadsParser a -> PadsParser b -> PadsParser b #

(<*) :: PadsParser a -> PadsParser b -> PadsParser a #

type Result a = (a, Bool) Source #

A Pads parse result is just a tuple of the type parsed and a boolean indicating whether or not a parse error occured. If the boolean is False, the result type has been populated with default values. See Language.Pads.Generic for the type class implementing default values, and Language.Pads.CoreBaseTypes for definitions of default values for the built-in types.

badReturn :: a -> PadsParser a Source #

A pads parsing combinator used by other pads parsers when they detect a parse error.

mdReturn :: PadsMD md => (a, md) -> PadsParser (a, md) Source #

 

returnClean :: t -> PadsParser (t, Base_md) Source #

Construct a Pads parser which always returns the given value and metadata reporting no errors.

returnError :: t -> ErrMsg -> PadsParser (t, Base_md) Source #

Construct a Pads parser which always reports the given error message along with returning a (likely default) value given to us.

(=@=) :: PadsParser (t3 -> t2, t1 -> t) -> PadsParser (t3, t1) -> PadsParser (t2, t) infixl 5 Source #

 

Source manipulation functions

queryP :: (Source -> a) -> PadsParser a Source #

Run a pure function on the current source input from inside the PadsParser monad. Used for detecting things like isEOF, isEOR, or for peaking at the current head of the input with peekHeadP.

primPads :: (Source -> (a, Source)) -> PadsParser a Source #

Run a pure function to mutate the current input source.

liftStoP :: (Source -> Maybe (a, Source)) -> a -> PadsParser a Source #

Lift a function which runs in the Maybe monad to run in the PadsParser monad with the same semantics as primPads, with the added ability that a Nothing produces a parse failure.

replaceSource :: Source -> Result (a, Source) -> Result (a, Source) Source #

Replace the source in the given Result with the given Source

Monad choice combinators

choiceP :: [PadsParser a] -> PadsParser a Source #

One-by-one try a list of parsers in order until you find the one that works and return that one. If none of them work, return the last one that failed.

(<||>) :: PadsParser a -> PadsParser a -> PadsParser a Source #

Try the first parser and if it fails, try the second parser

(<++>) :: Result a -> Result a -> Result a Source #

Grab the first result if it succeeded, otherwise use the second one

parseTry :: PadsMD md => PadsParser (rep, md) -> PadsParser (rep, md) Source #

Run the given Pads parser on the current input, but after running it replace the (now possibly mutated input) with the original input while returning the result parsed.

Parsers for Pads language features

parseConstraint :: PadsMD md => PadsParser (rep, md) -> (rep -> md -> Bool) -> PadsParser (rep, md) Source #

This is where constraint predicates get run and converted into error messages upon predicate failure.

constraintReport :: PadsMD md => Bool -> md -> Base_md Source #

Convert the result of running a Pads constraint predicate into an error message.

parseTransform :: PadsMD dmd => PadsParser (sr, smd) -> (Span -> (sr, smd) -> (dr, dmd)) -> PadsParser (dr, dmd) Source #

Run the given parser and transform the result using the given Haskell function, which originally looked like this in Pads syntax:

type Foo = transform Bar => Baz using <|(bar2baz, baz2bar)|>

The first function in the antiquoted tuple (bar2baz) is run here, whereas the second function in the tuple (baz2bar) is used during pretty printing.

parsePartition :: PadsMD md => PadsParser (rep, md) -> RecordDiscipline -> PadsParser (rep, md) Source #

Run a parser with the appropriate record discipline enabled in the parsing monad. See the RecordDiscipline data type for the available disciplines along with appropriate Haskell functions that can be referenced from a Pads partition expression, e.g.:

type Foo = partition Bar using none

Note that the record discipline specified in a partition expression remains active until the parsing monad encounters another partition expression. This effectively means that record disciplines form a stack that get popped off as parsers complete. This stack however is implemented as scoped variables in nested calls of this function rather than as a Haskell stack stored in the monad.

parseListNoSepNoTerm :: PadsMD md => PadsParser (rep, md) -> PadsParser ([rep], (Base_md, [md])) Source #

 

parseListSepNoTerm :: (PadsMD md, PadsMD mdSep) => PadsParser (repSep, mdSep) -> PadsParser (rep, md) -> PadsParser ([rep], (Base_md, [md])) Source #

 

parseListNoSepLength :: PadsMD md => Int -> PadsParser (rep, md) -> PadsParser ([rep], (Base_md, [md])) Source #

 

parseListSepLength :: (PadsMD md, PadsMD mdSep) => PadsParser (repSep, mdSep) -> Int -> PadsParser (rep, md) -> PadsParser ([rep], (Base_md, [md])) Source #

 

parseListNoSepTerm :: (PadsMD md, PadsMD mdTerm) => PadsParser (repTerm, mdTerm) -> PadsParser (rep, md) -> PadsParser ([rep], (Base_md, [md])) Source #

 

parseListSepTerm :: (PadsMD md, PadsMD mdSep, PadsMD mdTerm) => PadsParser (repSep, mdSep) -> PadsParser (repTerm, mdTerm) -> PadsParser (rep, md) -> PadsParser ([rep], (Base_md, [md])) Source #

 

listReport :: PadsMD b => PadsParser [(a, b)] -> PadsParser ([a], (Base_md, [b])) Source #

 

parseMany :: PadsMD md => PadsParser (rep, md) -> PadsParser [(rep, md)] Source #

Parse zero or more instances of the given parser. Stop parsing when the parser encounters something it is unable to parse properly. This means, during a valid parse, we attempt to parse more of the input than we really should and only given up when there isn't a single valid parse.

parseManySep :: (PadsMD md, PadsMD mdSep) => PadsParser (repSep, mdSep) -> PadsParser (rep, md) -> PadsParser [(rep, md)] Source #

Parse one or more instances of the given parser.

parseManySep1 :: (PadsMD md, PadsMD mdSep) => PadsParser (repSep, mdSep) -> PadsParser (rep, md) -> PadsParser [(rep, md)] Source #

Parse zero or more instances of the given parser. TODO: The name of this and parseManySep are misleading / should be swapped?

parseCount :: PadsMD md => Int -> PadsParser (rep, md) -> PadsParser [(rep, md)] Source #

Parse n instances of the given parser.

parseCountSep :: PadsMD md => Int -> PadsParser rmdSep -> PadsParser (rep, md) -> PadsParser [(rep, md)] Source #

Parse n instances of the given parser with another parser acting as the separator between instances of the first parser. Note that this properly intersperses the separator

parseManyTerm :: (PadsMD md, PadsMD mdTerm) => PadsParser (repTerm, mdTerm) -> PadsParser (rep, md) -> PadsParser [(rep, md)] Source #

Parse many instances of the given parser until we see an instance of the terminator parser. Parsing satisfies the following rules in decreasing order of precedence: * If we see the terminator, parse it and stop parsing (even if the terminator is ambiguous with the given parser). * If we see the end of file, stop parsing and return what we've parsed thus far. * Parse an instance of the given parser and recurse.

parseManySepTerm :: (PadsMD md, PadsMD mdSep, PadsMD mdTerm) => PadsParser (repSep, mdSep) -> PadsParser (repTerm, mdTerm) -> PadsParser (rep, md) -> PadsParser [(rep, md)] Source #

Like parseManyTerm but with a separator in-between instances of the given parser.

seekSep :: PadsParser a1 -> PadsParser a2 -> PadsParser (Bool, [Char]) Source #

Consume input until we find the terminator, separator, end-of-file, or end-of-record. If we find (in decreasing order of precedence): * The terminator, then report that we successfully terminated * The end-of-file, report successful termination. * The separator, report that we successfully seeked until a separator was consumed from the input. * An end-of-record symbol, report a bad parse

Note that the fact that we report successful termination upon end-of-file is probably a bug, because it means we report a successful parse even though we didn't find the terminator to the list being parsed.

junkReport :: PadsMD md => md -> Loc -> [Char] -> md Source #

 

getLoc :: PadsParser Loc Source #

Get the current source location offset into the data we're currently parsing.

takeP :: Integral a => a -> PadsParser String Source #

Remove and return the first n characters from the input source

takeBytesP :: Integral a => a -> PadsParser RawStream Source #

Remove and return the first n bytes from the input source

peekHeadP :: PadsParser Char Source #

Query the current symbol (character) of input

takeHeadP :: PadsParser Char Source #

Remove and return the current symbol (character) of input

takeHeadStrP :: String -> PadsParser Bool Source #

See takeHeadStr - returns false in the PadsParser monad iff the front of current source matches the given string with the side effect of removing that string from the front of the source if it does.