Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Hledger.Utils.Parse
Synopsis
- type SimpleStringParser a = Parsec HledgerParseErrorData String a
- type SimpleTextParser = Parsec HledgerParseErrorData Text
- type TextParser m a = ParsecT HledgerParseErrorData Text m a
- data SourcePos = SourcePos {
- sourceName :: FilePath
- sourceLine :: !Pos
- sourceColumn :: !Pos
- mkPos :: Int -> Pos
- unPos :: Pos -> Int
- initialPos :: FilePath -> SourcePos
- sourcePosPretty :: SourcePos -> String
- sourcePosPairPretty :: (SourcePos, SourcePos) -> String
- choice' :: [TextParser m a] -> TextParser m a
- choiceInState :: [StateT s (ParsecT HledgerParseErrorData Text m) a] -> StateT s (ParsecT HledgerParseErrorData Text m) a
- surroundedBy :: Applicative m => m openclose -> m a -> m a
- parsewith :: Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
- runTextParser :: TextParser Identity a -> Text -> Either HledgerParseErrors a
- rtp :: TextParser Identity a -> Text -> Either HledgerParseErrors a
- parsewithString :: Parsec e String a -> String -> Either (ParseErrorBundle String e) a
- parseWithState :: Monad m => st -> StateT st (ParsecT HledgerParseErrorData Text m) a -> Text -> m (Either HledgerParseErrors a)
- parseWithState' :: Stream s => st -> StateT st (ParsecT e s Identity) a -> s -> Either (ParseErrorBundle s e) a
- fromparse :: (Show t, Show (Token t), Show e) => Either (ParseErrorBundle t e) a -> a
- parseerror :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> a
- showDateParseError :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> String
- nonspace :: TextParser m Char
- isNewline :: Char -> Bool
- isNonNewlineSpace :: Char -> Bool
- restofline :: TextParser m String
- eolof :: TextParser m ()
- spacenonewline :: (Stream s, Char ~ Token s) => ParsecT HledgerParseErrorData s m Char
- skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m ()
- skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m ()
- skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m Bool
- dbgparse :: Int -> String -> TextParser m ()
- traceOrLogParse :: String -> TextParser m ()
- data HledgerParseErrorData
- type HledgerParseErrors = ParseErrorBundle Text HledgerParseErrorData
- parseErrorAt :: Int -> String -> HledgerParseErrorData
- parseErrorAtRegion :: Int -> Int -> String -> HledgerParseErrorData
- data SourceExcerpt
- getExcerptText :: SourceExcerpt -> Text
- excerpt_ :: MonadParsec HledgerParseErrorData Text m => m a -> m SourceExcerpt
- reparseExcerpt :: Monad m => SourceExcerpt -> ParsecT HledgerParseErrorData Text m a -> ParsecT HledgerParseErrorData Text m a
- customErrorBundlePretty :: HledgerParseErrors -> String
- type FinalParseError = FinalParseError' HledgerParseErrorData
- data FinalParseError' e
- type FinalParseErrorBundle = FinalParseErrorBundle' HledgerParseErrorData
- data FinalParseErrorBundle' e
- finalError :: ParseError Text e -> FinalParseError' e
- finalFancyFailure :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => Set (ErrorFancy e) -> m a
- finalFail :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => String -> m a
- finalCustomFailure :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => e -> m a
- finalErrorBundlePretty :: FinalParseErrorBundle' HledgerParseErrorData -> String
- attachSource :: FilePath -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
- parseIncludeFile :: Monad m => StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a -> st -> FilePath -> Text -> StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a
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
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
FromJSON SourcePos Source # | |
Defined in Hledger.Data.Json | |
ToJSON SourcePos Source # | |
Data SourcePos | |
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 | |
Read SourcePos | |
Show SourcePos | |
NFData SourcePos | |
Defined in Text.Megaparsec.Pos | |
Eq SourcePos | |
Ord SourcePos | |
type Rep SourcePos | |
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)))) |
Construction of Pos
from Int
. The function throws
InvalidPosException
when given a non-positive argument.
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.
parsewithString :: Parsec e String a -> String -> Either (ParseErrorBundle String e) a Source #
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 #
parseerror :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> a Source #
showDateParseError :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> String Source #
nonspace :: TextParser m Char Source #
isNonNewlineSpace :: Char -> Bool Source #
restofline :: TextParser m String Source #
eolof :: TextParser m () Source #
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT HledgerParseErrorData s m Char Source #
skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m () Source #
skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m () Source #
skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m Bool 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
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).
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
SourceExcerpt
s.
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 ParseErrorBundle
s 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.
Instances
Monoid (FinalParseError' e) Source # | |
Defined in Hledger.Utils.Parse Methods mempty :: FinalParseError' e # mappend :: FinalParseError' e -> FinalParseError' e -> FinalParseError' e # mconcat :: [FinalParseError' e] -> FinalParseError' e # | |
Semigroup (FinalParseError' e) Source # | |
Defined in Hledger.Utils.Parse Methods (<>) :: FinalParseError' e -> FinalParseError' e -> FinalParseError' e # sconcat :: NonEmpty (FinalParseError' e) -> FinalParseError' e # stimes :: Integral b => b -> FinalParseError' e -> FinalParseError' e # | |
Show e => Show (FinalParseError' e) Source # | |
Defined in Hledger.Utils.Parse Methods showsPrec :: Int -> FinalParseError' e -> ShowS # show :: FinalParseError' e -> String # showList :: [FinalParseError' e] -> ShowS # |
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
Show e => Show (FinalParseErrorBundle' e) Source # | |
Defined in Hledger.Utils.Parse Methods showsPrec :: Int -> FinalParseErrorBundle' e -> ShowS # show :: FinalParseErrorBundle' e -> String # showList :: [FinalParseErrorBundle' e] -> ShowS # |
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.