ref: HledgerParseErrors type alias

This commit is contained in:
Simon Michael 2022-03-20 09:00:47 -10:00
parent 2f28e1b0a7
commit 5ab7b9f643
5 changed files with 22 additions and 17 deletions

View File

@ -105,7 +105,7 @@ import Safe (headMay, lastMay, maximumMay, minimumMay)
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, string, string') import Text.Megaparsec.Char (char, char', digitChar, string, string')
import Text.Megaparsec.Char.Lexer (decimal, signed) import Text.Megaparsec.Char.Lexer (decimal, signed)
import Text.Megaparsec.Custom (customErrorBundlePretty) import Text.Megaparsec.Custom (customErrorBundlePretty, HledgerParseErrors)
import Text.Printf (printf) import Text.Printf (printf)
import Hledger.Data.Types import Hledger.Data.Types
@ -360,7 +360,7 @@ latestSpanContaining datespans = go
-- | Parse a period expression to an Interval and overall DateSpan using -- | Parse a period expression to an Interval and overall DateSpan using
-- the provided reference date, or return a parse error. -- the provided reference date, or return a parse error.
parsePeriodExpr 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) parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s)
-- | Like parsePeriodExpr, but call error' on failure. -- | Like parsePeriodExpr, but call error' on failure.
@ -408,14 +408,14 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
fixSmartDateStr :: Day -> Text -> Text fixSmartDateStr :: Day -> Text -> Text
fixSmartDateStr d s = fixSmartDateStr d s =
either (error' . printf "could not parse date %s %s" (show s) . show) id $ -- PARTIAL: 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. -- | 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 d = fmap showDate . fixSmartDateStrEither' d
fixSmartDateStrEither' fixSmartDateStrEither'
:: Day -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) Day :: Day -> Text -> Either HledgerParseErrors Day
fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
Right sd -> Right $ fixSmartDate d sd Right sd -> Right $ fixSmartDate d sd
Left e -> Left e Left e -> Left e

View File

@ -144,7 +144,7 @@ import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, newline, string) import Text.Megaparsec.Char (char, char', digitChar, newline, string)
import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Char.Lexer (decimal)
import Text.Megaparsec.Custom import Text.Megaparsec.Custom
(FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion) (FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion, HledgerParseErrors)
import Hledger.Data import Hledger.Data
import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery) 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) Right (q,p,d,g) -> pure (q, Precision p, d, g)
-- | Try to parse an amount from a string -- | 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) amountp'' s = runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s)
-- | Parse an amount from a string, or get an error. -- | Parse an amount from a string, or get an error.

View File

@ -113,7 +113,7 @@ import qualified Hledger.Read.CsvReader as CsvReader (reader)
-- | Run a journal parser in some monad. See also: parseWithState. -- | Run a journal parser in some monad. See also: parseWithState.
runJournalParser, rjp runJournalParser, rjp
:: Monad m :: 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) "" runJournalParser p = runParserT (evalStateT p nulljournal) ""
rjp = runJournalParser rjp = runJournalParser
@ -122,7 +122,7 @@ runErroringJournalParser, rejp
:: Monad m :: Monad m
=> ErroringJournalParser m a => ErroringJournalParser m a
-> Text -> Text
-> m (Either FinalParseError (Either (ParseErrorBundle Text HledgerParseErrorData) a)) -> m (Either FinalParseError (Either HledgerParseErrors a))
runErroringJournalParser p t = runErroringJournalParser p t =
runExceptT $ runParserT (evalStateT p nulljournal) "" t runExceptT $ runParserT (evalStateT p nulljournal) "" t
rejp = runErroringJournalParser rejp = runErroringJournalParser

View File

@ -87,7 +87,7 @@ parsewith p = runParser p ""
-- | Run a text parser in the identity monad. See also: parseWithState. -- | Run a text parser in the identity monad. See also: parseWithState.
runTextParser, rtp runTextParser, rtp
:: TextParser Identity a -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) a :: TextParser Identity a -> Text -> Either HledgerParseErrors a
runTextParser = parsewith runTextParser = parsewith
rtp = runTextParser rtp = runTextParser
@ -102,7 +102,7 @@ parseWithState
=> st => st
-> StateT st (ParsecT HledgerParseErrorData Text m) a -> StateT st (ParsecT HledgerParseErrorData Text m) a
-> Text -> Text
-> m (Either (ParseErrorBundle Text HledgerParseErrorData) a) -> m (Either HledgerParseErrors a)
parseWithState ctx p = runParserT (evalStateT p ctx) "" parseWithState ctx p = runParserT (evalStateT p ctx) ""
parseWithState' parseWithState'

View File

@ -7,8 +7,9 @@
{-# LANGUAGE StandaloneDeriving #-} -- new {-# LANGUAGE StandaloneDeriving #-} -- new
module Text.Megaparsec.Custom ( module Text.Megaparsec.Custom (
-- * Custom parse error type -- * Custom parse error types
HledgerParseErrorData, HledgerParseErrorData,
HledgerParseErrors,
-- * Failing with an arbitrary source position -- * Failing with an arbitrary source position
parseErrorAt, parseErrorAt,
@ -55,11 +56,9 @@ import Data.Text (Text)
import Text.Megaparsec import Text.Megaparsec
--- * Custom parse error type --- * Custom parse error types
-- | A custom error type for the parser. The type is specialized to
-- parsers of 'Text' streams.
-- | Custom error data for hledger parsers. Specialised for a 'Text' parse stream.
data HledgerParseErrorData data HledgerParseErrorData
-- | Fail with a message at a specific source position interval. The -- | Fail with a message at a specific source position interval. The
-- interval must be contained within a single line. -- interval must be contained within a single line.
@ -72,6 +71,12 @@ data HledgerParseErrorData
(NE.NonEmpty (ParseError Text HledgerParseErrorData)) -- Source fragment parse errors (NE.NonEmpty (ParseError Text HledgerParseErrorData)) -- Source fragment parse errors
deriving (Show, Eq, Ord) 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 -- We require an 'Ord' instance for 'CustomError' so that they may be
-- stored in a 'Set'. The actual instance is inconsequential, so we just -- stored in a 'Set'. The actual instance is inconsequential, so we just
-- derive it, but the derived instance requires an (orphan) instance for -- 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 -- 0 (that is, the beginning of the source file), which is the
-- case for 'ParseErrorBundle's returned from 'runParserT'. -- case for 'ParseErrorBundle's returned from 'runParserT'.
customErrorBundlePretty :: ParseErrorBundle Text HledgerParseErrorData -> String customErrorBundlePretty :: HledgerParseErrors -> String
customErrorBundlePretty errBundle = customErrorBundlePretty errBundle =
let errBundle' = errBundle { bundleErrors = let errBundle' = errBundle { bundleErrors =
NE.sortWith errorOffset $ -- megaparsec requires that the list of errors be sorted by their offsets NE.sortWith errorOffset $ -- megaparsec requires that the list of errors be sorted by their offsets