lib: revise comments for "final" parse errors

- also simplify their implementation a bit

hledger-lib/Text/Megaparsec/Custom.hs

@@ -16,24 +16,24 @@ module Text.Megaparsec.Custom (
   customErrorBundlePretty,
 
 
-  -- * Final parse error types
+  -- * "Final" parse errors
   FinalParseError,
   FinalParseError',
   FinalParseErrorBundle,
   FinalParseErrorBundle',
 
-  -- * Constructing final parse errors
+  -- * Constructing "final" parse errors
   finalError,
   finalFancyFailure,
   finalFail,
   finalCustomFailure,
 
-  -- * Handling errors from include files with final parse errors
+  -- * Pretty-printing "final" parse errors
-  parseIncludeFile,
+  finalErrorBundlePretty,
   attachSource,
 
-  -- * Pretty-printing final parse errors
+  -- * Handling parse errors from include files with "final" parse errors
-  finalErrorBundlePretty,
+  parseIncludeFile,
 )
 where
 
@@ -138,33 +138,50 @@ customErrorBundlePretty errBundle =
     finds f = asum . map f . toList
 
 
---- * Final parse error types
+--- * "Final" parse errors
-
--- | A parse error type intended for throwing parse errors without the
--- possiblity of backtracking. Intended for use as the error type in an
--- 'ExceptT' layer of the parser. The 'ExceptT' layer is responsible for
--- handling include files, so this type also records a stack of include
--- files in order to report the stack in parse errors.
 --
--- In order to pretty-print our custom parse errors, we must bundle them
+-- | A type representing "final" parse errors that cannot be backtracked
--- with their full source text and filepaths (the 'FinalBundleWithStack'
+-- from and are guaranteed to halt parsing. The anti-backtracking
--- constructor). However, when an error is thrown from within a parser, we
+-- behaviour is implemented by an 'ExceptT' layer in the parser's monad
--- do not have access to the full source, so we must hold the parse error
+-- stack, using this type as the 'ExceptT' error type.
--- (the 'FinalError' constructor) until it can be joined with the source
+--
--- text and its filepath by the parser's caller.
+-- We have three goals for this type:
+-- (1) it should be possible to convert any parse error into a "final"
+-- parse error,
+-- (2) it should be possible to take a parse error thrown from an include
+-- file and re-throw it in the parent file, and
+-- (3) the pretty-printing of "final" parse errors should be consistent
+-- with that of ordinary parse errors, but should also report a stack of
+-- files for errors thrown from include files.
+--
+-- In order to pretty-print a "final" parse error (goal 3), it must be
+-- bundled with include filepaths and its full source text. When a "final"
+-- parse error is thrown from within a parser, we do not have access to
+-- the full source, so we must hold the parse error until it can be joined
+-- with its source (and include filepaths, if it was thrown from an
+-- include file) by the parser's caller.
+--
+-- A parse error with include filepaths and its full source text is
+-- represented by the 'FinalParseErrorBundle' type, while a parse error in
+-- need of either include filepaths, full source text, or both is
+-- represented by the 'FinalParseError' type.
 
 data FinalParseError' e
+  -- a parse error thrown as a "final" parse error
   = FinalError           (ParseError Text e)
+  -- a parse error obtained from running a parser, e.g. using 'runParserT'
   | FinalBundle          (ParseErrorBundle Text e)
+  -- a parse error thrown from an include file
   | FinalBundleWithStack (FinalParseErrorBundle' e)
   deriving (Show)
 
 type FinalParseError = FinalParseError' CustomErr
 
--- A 'Monoid' instance is necessary for 'ExceptT (FinalParseError' e)' to
+-- We need a 'Monoid' instance for 'FinalParseError' so that 'ExceptT
--- be an instance of Alternative and MonadPlus, which are required for the
+-- FinalParseError m' is an instance of Alternative and MonadPlus, which
--- use of e.g. the 'many' parser combinator. This monoid instance simply
+-- is needed to use some parser combinators, e.g. 'many'.
--- takes the first (left-most) error.
+--
+-- This monoid instance simply takes the first (left-most) error.
 
 instance Semigroup (FinalParseError' e) where
   e <> _ = e
@@ -174,12 +191,16 @@ instance Monoid (FinalParseError' e) where
             S.singleton (ErrorFail "default parse error")
   mappend = (<>)
 
--- | A type bundling a 'ParseError' with its full source file and a stack
+-- | A type bundling a 'ParseError' with its full source text, filepath,
--- of include file paths (for pretty printing).
+-- and stack of include files. Suitable for pretty-printing.
+--
+-- Megaparsec's 'ParseErrorBundle' type already bundles a parse error with
+-- its full source text and filepath, so we just add a stack of include
+-- files.
 
 data FinalParseErrorBundle' e = FinalParseErrorBundle'
   { finalErrorBundle :: ParseErrorBundle Text e
-  , sourceFileStack  :: NE.NonEmpty FilePath
+  , includeFileStack :: [FilePath]
   } deriving (Show)
 
 type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr
@@ -192,7 +213,7 @@ type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr
 finalError :: ParseError Text e -> FinalParseError' e
 finalError = FinalError
 
--- | Like 'fancyFailure', but as a "final" parse error.
+-- | Like megaparsec's 'fancyFailure', but as a "final" parse error.
 
 finalFancyFailure
   :: (MonadParsec e s m, MonadError (FinalParseError' e) m)
@@ -207,76 +228,88 @@ finalFail
   :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => String -> m a
 finalFail = finalFancyFailure . S.singleton . ErrorFail
 
--- | Like 'customFailure', but as a "final" parse error.
+-- | Like megaparsec's 'customFailure', but as a "final" parse error.
 
 finalCustomFailure
   :: (MonadParsec e s m, MonadError (FinalParseError' e) m) => e -> m a
 finalCustomFailure = finalFancyFailure . S.singleton . ErrorCustom
 
 
---- * Handling errors from include files with "final" parse errors
+--- * Pretty-printing "final" parse errors
 
--- Some care must be taken for sources to be attached to the right parse
+-- | Pretty-print a "final" parse error: print the stack of include files,
--- errors when dealing with include files, so we capture the necessary
+-- then apply the pretty-printer for parse error bundles. Note that
--- procedure in this function.
+-- 'attachSource' must be used on a "final" parse error before it can be
+-- pretty-printed.
 
-parseIncludeFile
+finalErrorBundlePretty :: FinalParseErrorBundle' CustomErr -> String
-  :: forall st m a. Monad m
+finalErrorBundlePretty bundle =
-  => StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
+     concatMap showIncludeFilepath (includeFileStack bundle)
-  -> st
+  <> customErrorBundlePretty (finalErrorBundle bundle)
-  -> FilePath
-  -> Text
-  -> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
-parseIncludeFile parser initState filepath text =
-  catchError parser' handler
   where
-    parser' = do
+    showIncludeFilepath path = "in file included from " <> path <> ",\n"
-      eResult <- lift $ lift $
-                  runParserT (evalStateT parser initState) filepath text
-      case eResult of
-        Left parseErrorBundle -> throwError $ FinalBundle parseErrorBundle
-        Right result -> pure result
-
-    handler e = throwError $ FinalBundleWithStack $ attachSource filepath text e
 
+-- | Supply a filepath and source text to a "final" parse error so that it
+-- can be pretty-printed. You must ensure that you provide the appropriate
+-- source text and filepath.
 
 attachSource
   :: FilePath -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
 attachSource filePath sourceText finalParseError = case finalParseError of
 
-    FinalError parseError ->
+  -- A parse error thrown directly with the 'FinalError' constructor
-      let bundle = ParseErrorBundle
+  -- requires both source and filepath.
-            { bundleErrors = parseError NE.:| []
+  FinalError parseError ->
-            , bundlePosState = initialPosState filePath sourceText }
+    let bundle = ParseErrorBundle
-      in  FinalParseErrorBundle'
+          { bundleErrors = parseError NE.:| []
-            { finalErrorBundle = bundle
+          , bundlePosState = initialPosState filePath sourceText }
-            , sourceFileStack  = filePath NE.:| [] }
+    in  FinalParseErrorBundle'
+          { finalErrorBundle = bundle
+          , includeFileStack  = [] }
 
-    FinalBundle peBundle -> FinalParseErrorBundle'
+  -- A 'ParseErrorBundle' already has the appropriate source and filepath
-      { finalErrorBundle = peBundle
+  -- and so needs neither.
-      , sourceFileStack  = filePath NE.:| [] }
+  FinalBundle peBundle -> FinalParseErrorBundle'
+    { finalErrorBundle = peBundle
+    , includeFileStack = [] }
 
-    FinalBundleWithStack fpeBundle -> fpeBundle
+  -- A parse error from a 'FinalParseErrorBundle' was thrown from an
-      { sourceFileStack = filePath NE.<| sourceFileStack fpeBundle }
+  -- include file, so we add the filepath to the stack.
+  FinalBundleWithStack fpeBundle -> fpeBundle
+    { includeFileStack = filePath : includeFileStack fpeBundle }
 
 
---- * Pretty-printing final parse errors
+--- * Handling parse errors from include files with "final" parse errors
 
--- | Pretty-print a "final" parse error: print the stack of include files,
+-- | Parse a file with the given parser and initial state, discarding the
--- then apply the pretty-printer for custom parse errors.
+-- final state and re-throwing any parse errors as "final" parse errors.
 
-finalErrorBundlePretty :: FinalParseErrorBundle' CustomErr -> String
+parseIncludeFile
-finalErrorBundlePretty bundle =
+  :: Monad m
-     concatMap printIncludeFile (NE.init (sourceFileStack bundle))
+  => StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
-  <> customErrorBundlePretty (finalErrorBundle bundle)
+  -> st
+  -> FilePath
+  -> Text
+  -> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
+parseIncludeFile parser initialState filepath text =
+  catchError parser' handler
   where
-    printIncludeFile path = "in file included from " <> path <> ",\n"
+    parser' = do
+      eResult <- lift $ lift $
+                  runParserT (evalStateT parser initialState) filepath text
+      case eResult of
+        Left parseErrorBundle -> throwError $ FinalBundle parseErrorBundle
+        Right result -> pure result
+
+    -- Attach source and filepath of the include file to its parse errors
+    handler e = throwError $ FinalBundleWithStack $ attachSource filepath text e
 
 
 --- * Helpers
 
--- The "tab width" and "line prefix" are taken from the defaults defined
+-- Like megaparsec's 'initialState', but instead for 'PosState'. Used when
--- in 'initialState'.
+-- constructing 'ParseErrorBundle's. The values for "tab width" and "line
+-- prefix" are taken from 'initialState'.
 
 initialPosState :: FilePath -> Text -> PosState Text
 initialPosState filePath sourceText = PosState