From 5ab7b9f64321a8c27bc92daca1fdacb2ca0d5b41 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 20 Mar 2022 09:00:47 -1000 Subject: [PATCH] ref: HledgerParseErrors type alias --- hledger-lib/Hledger/Data/Dates.hs | 10 +++++----- hledger-lib/Hledger/Read/Common.hs | 4 ++-- hledger-lib/Hledger/Read/JournalReader.hs | 4 ++-- hledger-lib/Hledger/Utils/Parse.hs | 4 ++-- hledger-lib/Text/Megaparsec/Custom.hs | 17 +++++++++++------ 5 files changed, 22 insertions(+), 17 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index ec8220a82..a99b02630 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -105,7 +105,7 @@ import Safe (headMay, lastMay, maximumMay, minimumMay) import Text.Megaparsec import Text.Megaparsec.Char (char, char', digitChar, string, string') import Text.Megaparsec.Char.Lexer (decimal, signed) -import Text.Megaparsec.Custom (customErrorBundlePretty) +import Text.Megaparsec.Custom (customErrorBundlePretty, HledgerParseErrors) import Text.Printf (printf) import Hledger.Data.Types @@ -360,7 +360,7 @@ latestSpanContaining datespans = go -- | Parse a period expression to an Interval and overall DateSpan using -- the provided reference date, or return a parse error. parsePeriodExpr - :: Day -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) (Interval, DateSpan) + :: Day -> Text -> Either HledgerParseErrors (Interval, DateSpan) parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s) -- | Like parsePeriodExpr, but call error' on failure. @@ -408,14 +408,14 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e) fixSmartDateStr :: Day -> Text -> Text fixSmartDateStr d s = either (error' . printf "could not parse date %s %s" (show s) . show) id $ -- PARTIAL: - (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text HledgerParseErrorData) Text) + (fixSmartDateStrEither d s :: Either HledgerParseErrors Text) -- | A safe version of fixSmartDateStr. -fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) Text +fixSmartDateStrEither :: Day -> Text -> Either HledgerParseErrors Text fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d fixSmartDateStrEither' - :: Day -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) Day + :: Day -> Text -> Either HledgerParseErrors Day fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of Right sd -> Right $ fixSmartDate d sd Left e -> Left e diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 962a75fb8..bb64c8b6e 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -144,7 +144,7 @@ import Text.Megaparsec import Text.Megaparsec.Char (char, char', digitChar, newline, string) import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Custom - (FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion) + (FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion, HledgerParseErrors) import Hledger.Data import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery) @@ -855,7 +855,7 @@ amountwithoutpricep mult = do Right (q,p,d,g) -> pure (q, Precision p, d, g) -- | Try to parse an amount from a string -amountp'' :: String -> Either (ParseErrorBundle Text HledgerParseErrorData) Amount +amountp'' :: String -> Either HledgerParseErrors Amount amountp'' s = runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s) -- | Parse an amount from a string, or get an error. diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 8d48442b8..6377a9835 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -113,7 +113,7 @@ import qualified Hledger.Read.CsvReader as CsvReader (reader) -- | Run a journal parser in some monad. See also: parseWithState. runJournalParser, rjp :: Monad m - => JournalParser m a -> Text -> m (Either (ParseErrorBundle Text HledgerParseErrorData) a) + => JournalParser m a -> Text -> m (Either HledgerParseErrors a) runJournalParser p = runParserT (evalStateT p nulljournal) "" rjp = runJournalParser @@ -122,7 +122,7 @@ runErroringJournalParser, rejp :: Monad m => ErroringJournalParser m a -> Text - -> m (Either FinalParseError (Either (ParseErrorBundle Text HledgerParseErrorData) a)) + -> m (Either FinalParseError (Either HledgerParseErrors a)) runErroringJournalParser p t = runExceptT $ runParserT (evalStateT p nulljournal) "" t rejp = runErroringJournalParser diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs index 6e1863d98..47b21b988 100644 --- a/hledger-lib/Hledger/Utils/Parse.hs +++ b/hledger-lib/Hledger/Utils/Parse.hs @@ -87,7 +87,7 @@ parsewith p = runParser p "" -- | Run a text parser in the identity monad. See also: parseWithState. runTextParser, rtp - :: TextParser Identity a -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) a + :: TextParser Identity a -> Text -> Either HledgerParseErrors a runTextParser = parsewith rtp = runTextParser @@ -102,7 +102,7 @@ parseWithState => st -> StateT st (ParsecT HledgerParseErrorData Text m) a -> Text - -> m (Either (ParseErrorBundle Text HledgerParseErrorData) a) + -> m (Either HledgerParseErrors a) parseWithState ctx p = runParserT (evalStateT p ctx) "" parseWithState' diff --git a/hledger-lib/Text/Megaparsec/Custom.hs b/hledger-lib/Text/Megaparsec/Custom.hs index ab8352480..c0230a951 100644 --- a/hledger-lib/Text/Megaparsec/Custom.hs +++ b/hledger-lib/Text/Megaparsec/Custom.hs @@ -7,8 +7,9 @@ {-# LANGUAGE StandaloneDeriving #-} -- new module Text.Megaparsec.Custom ( - -- * Custom parse error type + -- * Custom parse error types HledgerParseErrorData, + HledgerParseErrors, -- * Failing with an arbitrary source position parseErrorAt, @@ -55,11 +56,9 @@ import Data.Text (Text) import Text.Megaparsec ---- * Custom parse error type - --- | A custom error type for the parser. The type is specialized to --- parsers of 'Text' streams. +--- * Custom parse error types +-- | Custom error data for hledger parsers. Specialised for a 'Text' parse stream. data HledgerParseErrorData -- | Fail with a message at a specific source position interval. The -- interval must be contained within a single line. @@ -72,6 +71,12 @@ data HledgerParseErrorData (NE.NonEmpty (ParseError Text HledgerParseErrorData)) -- Source fragment parse errors deriving (Show, Eq, Ord) +-- | 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. +type HledgerParseErrors = ParseErrorBundle Text HledgerParseErrorData + -- We require an 'Ord' instance for 'CustomError' so that they may be -- stored in a 'Set'. The actual instance is inconsequential, so we just -- derive it, but the derived instance requires an (orphan) instance for @@ -210,7 +215,7 @@ reparseExcerpt (SourceExcerpt offset txt) p = do -- 0 (that is, the beginning of the source file), which is the -- case for 'ParseErrorBundle's returned from 'runParserT'. -customErrorBundlePretty :: ParseErrorBundle Text HledgerParseErrorData -> String +customErrorBundlePretty :: HledgerParseErrors -> String customErrorBundlePretty errBundle = let errBundle' = errBundle { bundleErrors = NE.sortWith errorOffset $ -- megaparsec requires that the list of errors be sorted by their offsets