ref: HledgerParseErrors type alias
This commit is contained in:
parent
2f28e1b0a7
commit
5ab7b9f643
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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'
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user