hledger-lib-1.42.1: A library providing the core functionality of hledger
Safe HaskellSafe-Inferred
LanguageHaskell2010

Hledger.Utils.Parse

Synopsis

Some basic hledger parser flavours

type SimpleStringParser a = Parsec HledgerParseErrorData String a Source #

A parser of string to some type.

type SimpleTextParser = Parsec HledgerParseErrorData Text Source #

A parser of strict text to some type.

type TextParser m a = ParsecT HledgerParseErrorData Text m a Source #

A parser of text that runs in some monad.

SourcePos

data SourcePos #

The data type SourcePos represents source positions. It contains the name of the source file, a line number, and a column number. Source line and column positions change intensively during parsing, so we need to make them strict to avoid memory leaks.

Constructors

SourcePos 

Fields

Instances

Instances details
FromJSON SourcePos Source # 
Instance details

Defined in Hledger.Data.Json

ToJSON SourcePos Source # 
Instance details

Defined in Hledger.Data.Json

Data SourcePos 
Instance details

Defined in Text.Megaparsec.Pos

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SourcePos -> c SourcePos #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SourcePos #

toConstr :: SourcePos -> Constr #

dataTypeOf :: SourcePos -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c SourcePos) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos) #

gmapT :: (forall b. Data b => b -> b) -> SourcePos -> SourcePos #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SourcePos -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SourcePos -> r #

gmapQ :: (forall d. Data d => d -> u) -> SourcePos -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SourcePos -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos #

Generic SourcePos 
Instance details

Defined in Text.Megaparsec.Pos

Associated Types

type Rep SourcePos :: Type -> Type #

Read SourcePos 
Instance details

Defined in Text.Megaparsec.Pos

Show SourcePos 
Instance details

Defined in Text.Megaparsec.Pos

NFData SourcePos 
Instance details

Defined in Text.Megaparsec.Pos

Methods

rnf :: SourcePos -> () #

Eq SourcePos 
Instance details

Defined in Text.Megaparsec.Pos

Ord SourcePos 
Instance details

Defined in Text.Megaparsec.Pos

type Rep SourcePos 
Instance details

Defined in Text.Megaparsec.Pos

type Rep SourcePos = D1 ('MetaData "SourcePos" "Text.Megaparsec.Pos" "megaparsec-9.7.0-IV8liuRqvC38Do74tIEbur" 'False) (C1 ('MetaCons "SourcePos" 'PrefixI 'True) (S1 ('MetaSel ('Just "sourceName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FilePath) :*: (S1 ('MetaSel ('Just "sourceLine") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Pos) :*: S1 ('MetaSel ('Just "sourceColumn") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Pos))))

mkPos :: Int -> Pos #

Construction of Pos from Int. The function throws InvalidPosException when given a non-positive argument.

Since: megaparsec-6.0.0

unPos :: Pos -> Int #

Extract Int from Pos.

Since: megaparsec-6.0.0

initialPos :: FilePath -> SourcePos #

Construct initial position (line 1, column 1) given name of source file.

sourcePosPretty :: SourcePos -> String #

Pretty-print a SourcePos.

Since: megaparsec-5.0.0

sourcePosPairPretty :: (SourcePos, SourcePos) -> String Source #

Render a pair of source positions in human-readable form, only displaying the range of lines.

Parsers and helpers

choice' :: [TextParser m a] -> TextParser m a Source #

Backtracking choice, use this when alternatives share a prefix. Consumes no input if all choices fail.

choiceInState :: [StateT s (ParsecT HledgerParseErrorData Text m) a] -> StateT s (ParsecT HledgerParseErrorData Text m) a Source #

Backtracking choice, use this when alternatives share a prefix. Consumes no input if all choices fail.

surroundedBy :: Applicative m => m openclose -> m a -> m a Source #

runTextParser :: TextParser Identity a -> Text -> Either HledgerParseErrors a Source #

Run a text parser in the identity monad. See also: parseWithState.

rtp :: TextParser Identity a -> Text -> Either HledgerParseErrors a Source #

Run a text parser in the identity monad. See also: parseWithState.

parseWithState :: Monad m => st -> StateT st (ParsecT HledgerParseErrorData Text m) a -> Text -> m (Either HledgerParseErrors a) Source #

Run a stateful parser with some initial state on a text. See also: runTextParser, runJournalParser.

parseWithState' :: Stream s => st -> StateT st (ParsecT e s Identity) a -> s -> Either (ParseErrorBundle s e) a Source #

fromparse :: (Show t, Show (Token t), Show e) => Either (ParseErrorBundle t e) a -> a Source #

parseerror :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> a Source #

Trace the state of hledger parsers

dbgparse :: Int -> String -> TextParser m () Source #

Trace to stderr or log to debug log the provided label (if non-null) and current parser state (position and next input), if the global debug level is at or above the specified level. Uses unsafePerformIO.

traceOrLogParse :: String -> TextParser m () Source #

Trace to stderr or log to debug log the provided label (if non-null) and current parser state (position and next input). See also: Hledger.Utils.Debug, megaparsec's dbg. Uses unsafePerformIO. XXX Can be hard to make this evaluate.

More helpers, previously in Text.Megaparsec.Custom

Custom parse error types

data HledgerParseErrorData Source #

Custom error data for hledger parsers. Specialised for a Text parse stream. ReparseableTextParseErrorData ?

Instances

Instances details
Show HledgerParseErrorData Source # 
Instance details

Defined in Hledger.Utils.Parse

Eq HledgerParseErrorData Source # 
Instance details

Defined in Hledger.Utils.Parse

Ord HledgerParseErrorData Source # 
Instance details

Defined in Hledger.Utils.Parse

ShowErrorComponent HledgerParseErrorData Source # 
Instance details

Defined in Hledger.Utils.Parse

Ord (ParseError Text HledgerParseErrorData) Source # 
Instance details

Defined in Hledger.Utils.Parse

type HledgerParseErrors = ParseErrorBundle Text HledgerParseErrorData Source #

A specialised version of ParseErrorBundle: a non-empty collection of hledger parse errors, equipped with PosState to help pretty-print them. Specialised for a Text parse stream.

Failing with an arbitrary source position

parseErrorAt :: Int -> String -> HledgerParseErrorData Source #

Fail at a specific source position, given by the raw offset from the start of the input stream (the number of tokens processed at that point).

parseErrorAtRegion Source #

Arguments

:: Int

Start offset

-> Int

End end offset

-> String

Error message

-> HledgerParseErrorData 

Fail at a specific source interval, given by the raw offsets of its endpoints from the start of the input stream (the numbers of tokens processed at those points).

Note that care must be taken to ensure that the specified interval does not span multiple lines of the input source. This will not be checked.

Re-parsing

data SourceExcerpt Source #

A fragment of source suitable for "re-parsing". The purpose of this data type is to preserve the content and source position of the excerpt so that parse errors raised during "re-parsing" may properly reference the original source.

getExcerptText :: SourceExcerpt -> Text Source #

Get the raw text of a source excerpt.

excerpt_ :: MonadParsec HledgerParseErrorData Text m => m a -> m SourceExcerpt Source #

'excerpt_ p' applies the given parser p and extracts the portion of the source consumed by p, along with the source position of this portion. This is the only way to create a source excerpt suitable for "re-parsing" by reparseExcerpt.

reparseExcerpt :: Monad m => SourceExcerpt -> ParsecT HledgerParseErrorData Text m a -> ParsecT HledgerParseErrorData Text m a Source #

'reparseExcerpt s p' "re-parses" the source excerpt s using the parser p. Parse errors raised by p will be re-thrown at the source position of the source excerpt.

In order for the correct source file to be displayed when re-throwing parse errors, we must ensure that the source file during the use of 'reparseExcerpt s p' is the same as that during the use of excerpt_ that generated the source excerpt s. However, we can usually expect this condition to be satisfied because, at the time of writing, the only changes of source file in the codebase take place through include files, and the parser for include files neither accepts nor returns SourceExcerpts.

Pretty-printing custom parse errors

customErrorBundlePretty :: HledgerParseErrors -> String Source #

Pretty-print our custom parse errors. It is necessary to use this instead of errorBundlePretty when custom parse errors are thrown.

This function intercepts our custom parse errors and applies final adjustments (finalizeCustomError) before passing them to errorBundlePretty. These adjustments are part of the implementation of the behaviour of our custom parse errors.

Note: We must ensure that the offset of the PosState of the provided ParseErrorBundle is no larger than the offset specified by a ErrorFailAt constructor. This is guaranteed if this offset is set to 0 (that is, the beginning of the source file), which is the case for ParseErrorBundles returned from runParserT.

Final parse errors

data FinalParseError' e Source #

A type representing "final" parse errors that cannot be backtracked from and are guaranteed to halt parsing. The anti-backtracking behaviour is implemented by an ExceptT layer in the parser's monad stack, using this type as the ExceptT error type.

We have three goals for this type: (1) it should be possible to convert any parse error into a "final" parse error, (2) it should be possible to take a parse error thrown from an include file and re-throw it in the parent file, and (3) the pretty-printing of "final" parse errors should be consistent with that of ordinary parse errors, but should also report a stack of files for errors thrown from include files.

In order to pretty-print a "final" parse error (goal 3), it must be bundled with include filepaths and its full source text. When a "final" parse error is thrown from within a parser, we do not have access to the full source, so we must hold the parse error until it can be joined with its source (and include filepaths, if it was thrown from an include file) by the parser's caller.

A parse error with include filepaths and its full source text is represented by the FinalParseErrorBundle type, while a parse error in need of either include filepaths, full source text, or both is represented by the FinalParseError type.

data FinalParseErrorBundle' e Source #

A type bundling a ParseError with its full source text, filepath, and stack of include files. Suitable for pretty-printing.

Megaparsec's ParseErrorBundle type already bundles a parse error with its full source text and filepath, so we just add a stack of include files.

Instances

Instances details
Show e => Show (FinalParseErrorBundle' e) Source # 
Instance details

Defined in Hledger.Utils.Parse

Constructing "final" parse errors

finalError :: ParseError Text e -> FinalParseError' e Source #

Convert a "regular" parse error into a "final" parse error.

finalFancyFailure :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => Set (ErrorFancy e) -> m a Source #

Like megaparsec's fancyFailure, but as a "final" parse error.

finalFail :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => String -> m a Source #

Like fail, but as a "final" parse error.

finalCustomFailure :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => e -> m a Source #

Like megaparsec's customFailure, but as a "final" parse error.

Pretty-printing "final" parse errors

finalErrorBundlePretty :: FinalParseErrorBundle' HledgerParseErrorData -> String Source #

Pretty-print a "final" parse error: print the stack of include files, then apply the pretty-printer for parse error bundles. Note that attachSource must be used on a "final" parse error before it can be pretty-printed.

attachSource :: FilePath -> Text -> FinalParseError' e -> FinalParseErrorBundle' e Source #

Supply a filepath and source text to a "final" parse error so that it can be pretty-printed. You must ensure that you provide the appropriate source text and filepath.

Handling parse errors from include files with "final" parse errors

parseIncludeFile :: Monad m => StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a -> st -> FilePath -> Text -> StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a Source #

Parse a file with the given parser and initial state, discarding the final state and re-throwing any parse errors as "final" parse errors.