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
|
||||||
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
|
||||||
|
|||||||
@ -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.
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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'
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user