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