From 5e1f0ba6f7b229b84f9139530afd40e9fad5f4cc Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Sat, 29 Sep 2018 20:33:17 -0600
Subject: [PATCH 1/9] lib: add a field to 'Journal' for a stack of include
 files

- In anticipation of megaparsec 7, which removes support for stacks of
  include files (as far as I can tell)
- Intended for the 'StateT Journal' layer of the parser
  - A stack of include files would be better in a 'ReaderT' layer, but I
    don't want to add another layer to the parser
- Intended for detecting cycles of include files
  - Potential issue: for proper error messages for include file cycles,
    we must remember to provide the filepath of the root journal file via
    the initial journal state passed to a 'JournalParser'; I imagine
    that we may forget to do so because in all other cases it is okay
    not to do so.
---
 hledger-lib/Hledger/Data/Journal.hs | 6 ++++--
 hledger-lib/Hledger/Data/Types.hs   | 1 +
 hledger-lib/Hledger/Read/Common.hs  | 5 ++++-
 3 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs
index bf6986f14..41e04cdaf 100644
--- a/hledger-lib/Hledger/Data/Journal.hs
+++ b/hledger-lib/Hledger/Data/Journal.hs
@@ -163,6 +163,7 @@ instance Sem.Semigroup Journal where
     ,jparsealiases              = jparsealiases              j2
     -- ,jparsetransactioncount     = jparsetransactioncount     j1 +  jparsetransactioncount     j2
     ,jparsetimeclockentries = jparsetimeclockentries j1 <> jparsetimeclockentries j2
+    ,jincludefilestack          = jincludefilestack          j2
     ,jdeclaredaccounts                  = jdeclaredaccounts                  j1 <> jdeclaredaccounts                  j2
     ,jcommodities               = jcommodities               j1 <> jcommodities               j2
     ,jinferredcommodities       = jinferredcommodities       j1 <> jinferredcommodities       j2
@@ -189,8 +190,9 @@ nulljournal = Journal {
   ,jparseparentaccounts       = []
   ,jparsealiases              = []
   -- ,jparsetransactioncount     = 0
-  ,jparsetimeclockentries = []
-  ,jdeclaredaccounts                  = []
+  ,jparsetimeclockentries     = []
+  ,jincludefilestack          = []
+  ,jdeclaredaccounts          = []
   ,jcommodities               = M.fromList []
   ,jinferredcommodities       = M.fromList []
   ,jmarketprices              = []
diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs
index ee24fcf52..8d41ec9cd 100644
--- a/hledger-lib/Hledger/Data/Types.hs
+++ b/hledger-lib/Hledger/Data/Types.hs
@@ -363,6 +363,7 @@ data Journal = Journal {
   ,jparsealiases          :: [AccountAlias]                        -- ^ the current account name aliases in effect, specified by alias directives (& options ?)
   -- ,jparsetransactioncount :: Integer                               -- ^ the current count of transactions parsed so far (only journal format txns, currently)
   ,jparsetimeclockentries :: [TimeclockEntry]                       -- ^ timeclock sessions which have not been clocked out
+  ,jincludefilestack      :: [FilePath]
   -- principal data
   ,jdeclaredaccounts      :: [AccountName]                          -- ^ Accounts declared by account directives, in parse order (after journal finalisation) 
   ,jcommodities           :: M.Map CommoditySymbol Commodity        -- ^ commodities and formats declared by commodity directives
diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs
index c760c3d3a..1cf574f21 100644
--- a/hledger-lib/Hledger/Read/Common.hs
+++ b/hledger-lib/Hledger/Read/Common.hs
@@ -226,7 +226,10 @@ parseAndFinaliseJournal :: JournalParser IO ParsedJournal -> InputOpts
 parseAndFinaliseJournal parser iopts f txt = do
   t <- liftIO getClockTime
   y <- liftIO getCurrentYear
-  ep <- liftIO $ runParserT (evalStateT parser nulljournal {jparsedefaultyear=Just y}) f txt
+  let initJournal = nulljournal
+        { jparsedefaultyear = Just y
+        , jincludefilestack = [f] }
+  ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt
   case ep of
     Right pj -> 
       let pj' = if auto_ iopts then applyTransactionModifiers pj else pj in

From 2b3c97e1aff71bb02306282731a28bfe4b6778ae Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Tue, 25 Sep 2018 13:33:31 -0600
Subject: [PATCH 2/9] lib: tweak custom parse errors

- Don't immediately throw custom parse errors into 'ParsecT'; rather,
  just construct and return them
- This anticipates the re-implementation of an 'ExceptT' layer of the
  parser, which should be able throw custom parse errors
---
 hledger-lib/Hledger/Read/Common.hs        | 27 +++++++++++++----------
 hledger-lib/Hledger/Read/JournalReader.hs | 20 +++++++++--------
 hledger-lib/Text/Megaparsec/Custom.hs     | 17 ++++++--------
 3 files changed, 33 insertions(+), 31 deletions(-)

diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs
index 1cf574f21..2b0a475f2 100644
--- a/hledger-lib/Hledger/Read/Common.hs
+++ b/hledger-lib/Hledger/Read/Common.hs
@@ -364,11 +364,11 @@ datep' mYear = do
     endPos <- getPosition
     let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day
 
-    when (sep1 /= sep2) $ parseErrorAtRegion startPos endPos $
+    when (sep1 /= sep2) $ customFailure $ parseErrorAtRegion startPos endPos $
       "invalid date (mixing date separators is not allowed): " ++ dateStr
 
     case fromGregorianValid year month day of
-      Nothing -> parseErrorAtRegion startPos endPos $
+      Nothing -> customFailure $ parseErrorAtRegion startPos endPos $
                    "well-formed but invalid date: " ++ dateStr
       Just date -> pure $! date
 
@@ -379,12 +379,12 @@ datep' mYear = do
     case mYear of
       Just year ->
         case fromGregorianValid year (fromIntegral month) day of
-          Nothing -> parseErrorAtRegion startPos endPos $
+          Nothing -> customFailure $ parseErrorAtRegion startPos endPos $
                       "well-formed but invalid date: " ++ dateStr
           Just date -> pure $! date
         where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day
 
-      Nothing -> parseErrorAtRegion startPos endPos $
+      Nothing -> customFailure $ parseErrorAtRegion startPos endPos $
         "partial date "++dateStr++" found, but the current year is unknown"
         where dateStr = show month ++ [sep] ++ show day
 
@@ -415,23 +415,24 @@ datetimep' mYear = do
       pos1 <- getPosition
       h' <- twoDigitDecimal <?> "hour"
       pos2 <- getPosition
-      unless (h' >= 0 && h' <= 23) $ parseErrorAtRegion pos1 pos2
-        "invalid time (bad hour)"
+      unless (h' >= 0 && h' <= 23) $ customFailure $
+        parseErrorAtRegion pos1 pos2 "invalid time (bad hour)"
 
       char ':' <?> "':' (hour-minute separator)"
       pos3 <- getPosition
       m' <- twoDigitDecimal <?> "minute"
       pos4 <- getPosition
-      unless (m' >= 0 && m' <= 59) $ parseErrorAtRegion pos3 pos4
-        "invalid time (bad minute)"
+      unless (m' >= 0 && m' <= 59) $ customFailure $
+        parseErrorAtRegion pos3 pos4 "invalid time (bad minute)"
 
       s' <- option 0 $ do
         char ':' <?> "':' (minute-second separator)"
         pos5 <- getPosition
         s' <- twoDigitDecimal <?> "second"
         pos6 <- getPosition
-        unless (s' >= 0 && s' <= 59) $ parseErrorAtRegion pos5 pos6
-          "invalid time (bad second)" -- we do not support leap seconds
+        unless (s' >= 0 && s' <= 59) $ customFailure $
+          parseErrorAtRegion pos5 pos6 "invalid time (bad second)"
+          -- we do not support leap seconds
         pure s'
 
       pure $ TimeOfDay h' m' (fromIntegral s')
@@ -574,7 +575,8 @@ amountwithoutpricep = do
   interpretNumber posRegion suggestedStyle ambiguousNum mExp =
     let rawNum = either (disambiguateNumber suggestedStyle) id ambiguousNum
     in  case fromRawNumber rawNum mExp of
-          Left errMsg -> uncurry parseErrorAtRegion posRegion errMsg
+          Left errMsg -> customFailure $
+                           uncurry parseErrorAtRegion posRegion errMsg
           Right res -> pure res
 
 -- | Parse an amount from a string, or get an error.
@@ -793,7 +795,8 @@ rawnumberp = label "number" $ do
   mExtraFragment <- optional $ lookAhead $ try $
     char ' ' *> getPosition <* digitChar
   case mExtraFragment of
-    Just pos -> parseErrorAt pos "invalid number (excessive trailing digits)"
+    Just pos -> customFailure $
+                  parseErrorAt pos "invalid number (excessive trailing digits)"
     Nothing -> pure ()
 
   return $ dbg8 "rawnumberp" rawNumber
diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs
index c4024ef15..1a4f1f84c 100644
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@@ -195,18 +195,20 @@ includedirectivep = do
         -- Compiling filename as a glob pattern works even if it is a literal
         fileglob <- case tryCompileWith compDefault{errorRecovery=False} filename of
             Right x -> pure x
-            Left e -> parseErrorAt parserpos $ "Invalid glob pattern: " ++ e
+            Left e -> customFailure $
+                        parseErrorAt parserpos $ "Invalid glob pattern: " ++ e
         -- Get all matching files in the current working directory, sorting in
         -- lexicographic order to simulate the output of 'ls'.
         filepaths <- liftIO $ sort <$> globDir1 fileglob curdir
         if (not . null) filepaths
             then pure filepaths
-            else parseErrorAt parserpos $ "No existing files match pattern: " ++ filename
+            else customFailure $ parseErrorAt parserpos $
+                   "No existing files match pattern: " ++ filename
 
     parseChild parentpos filepath = do
         parentfilestack <- fmap sourceName . statePos <$> getParserState
-        when (filepath `elem` parentfilestack)
-            $ parseErrorAt parentpos ("Cyclic include: " ++ filepath)
+        when (filepath `elem` parentfilestack) $ customFailure $
+          parseErrorAt parentpos ("Cyclic include: " ++ filepath)
 
         childInput <- lift $ readFilePortably filepath
                              `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
@@ -294,7 +296,7 @@ commoditydirectiveonelinep = do
   _ <- lift followingcommentp
   let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg2 "style from commodity directive" astyle}
   if asdecimalpoint astyle == Nothing
-  then parseErrorAt pos pleaseincludedecimalpoint
+  then customFailure $ parseErrorAt pos pleaseincludedecimalpoint
   else modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j})
 
 pleaseincludedecimalpoint :: String
@@ -327,9 +329,9 @@ formatdirectivep expectedsym = do
   if acommodity==expectedsym
     then 
       if asdecimalpoint astyle == Nothing
-      then parseErrorAt pos pleaseincludedecimalpoint
+      then customFailure $ parseErrorAt pos pleaseincludedecimalpoint
       else return $ dbg2 "style from format subdirective" astyle
-    else parseErrorAt pos $
+    else customFailure $ parseErrorAt pos $
          printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity
 
 keywordp :: String -> JournalParser m ()
@@ -422,7 +424,7 @@ defaultcommoditydirectivep = do
   Amount{acommodity,astyle} <- amountp
   lift restofline
   if asdecimalpoint astyle == Nothing
-  then parseErrorAt pos pleaseincludedecimalpoint
+  then customFailure $ parseErrorAt pos pleaseincludedecimalpoint
   else setDefaultCommodityAndStyle (acommodity, astyle)
 
 marketpricedirectivep :: JournalParser m MarketPrice
@@ -481,7 +483,7 @@ periodictransactionp = do
   (periodtxt, (interval, span)) <- lift $ first T.strip <$> match (periodexprp d)
   -- In periodic transactions, the period expression has an additional constraint:
   case checkPeriodicTransactionStartDate interval span periodtxt of
-    Just e -> parseErrorAt pos e
+    Just e -> customFailure $ parseErrorAt pos e
     Nothing -> pure ()
   -- The line can end here, or it can continue with one or more spaces
   -- and then zero or more of the following fields. A bit awkward.
diff --git a/hledger-lib/Text/Megaparsec/Custom.hs b/hledger-lib/Text/Megaparsec/Custom.hs
index 5dce6f785..804b62ab4 100644
--- a/hledger-lib/Text/Megaparsec/Custom.hs
+++ b/hledger-lib/Text/Megaparsec/Custom.hs
@@ -9,7 +9,7 @@ module Text.Megaparsec.Custom (
   -- * Custom parse error type
   CustomErr,
 
-  -- * Throwing custom parse errors
+  -- * Constructing custom parse errors
   parseErrorAt,
   parseErrorAtRegion,
   withSource,
@@ -60,13 +60,12 @@ instance ShowErrorComponent CustomErr where
   showErrorComponent (ErrorWithSource _ e) = parseErrorTextPretty e
 
 
---- * Throwing custom parse errors
+--- * Constructing custom parse errors
 
 -- | Fail at a specific source position.
 
-parseErrorAt :: MonadParsec CustomErr s m => SourcePos -> String -> m a
-parseErrorAt pos msg = customFailure (ErrorFailAt pos (sourceColumn pos) msg)
-{-# INLINABLE parseErrorAt #-}
+parseErrorAt :: SourcePos -> String -> CustomErr
+parseErrorAt pos msg = ErrorFailAt pos (sourceColumn pos) msg
 
 -- | Fail at a specific source interval (within a single line). The
 -- interval is inclusive on the left and exclusive on the right; that is,
@@ -74,19 +73,17 @@ parseErrorAt pos msg = customFailure (ErrorFailAt pos (sourceColumn pos) msg)
 -- end position.
 
 parseErrorAtRegion
-  :: MonadParsec CustomErr s m
-  => SourcePos -- ^ Start position
+  :: SourcePos -- ^ Start position
   -> SourcePos -- ^ End position
   -> String    -- ^ Error message
-  -> m a
+  -> CustomErr
 parseErrorAtRegion startPos endPos msg =
   let startCol = sourceColumn startPos
       endCol' = mkPos $ subtract 1 $ unPos $ sourceColumn endPos
       endCol = if startCol <= endCol'
                     && sourceLine startPos == sourceLine endPos
                then endCol' else startCol
-  in  customFailure (ErrorFailAt startPos endCol msg)
-{-# INLINABLE parseErrorAtRegion #-}
+  in  ErrorFailAt startPos endCol msg
 
 -- | Attach a source file to a parse error. Intended for use with the
 -- 'region' parser combinator.

From 855a8f19850de3d4fcbb40715a27edd193aefc19 Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Tue, 25 Sep 2018 16:07:58 -0600
Subject: [PATCH 3/9] lib: Re-implement the 'ExceptT' layer of the parser

We previously had another parser type, 'type ErroringJournalParser =
ExceptT String ...' for throwing parse errors without the possibility of
backtracking. This parser type was removed under the assumption that it
would be possible to write our parser without this capability. However,
after a hairy backtracking bug, we would now prefer to have the option
to prevent backtracking.

- Define a 'FinalParseError' type specifically for the 'ExceptT' layer
- Any parse error can be raised as a "final" parse error
- Tracks the stack of include files for parser errors, anticipating the
  removal of the tracking of stacks of include files in megaparsec 7
  - Although a stack of include files is also tracked in the 'StateT
    Journal' layer of the parser, it seems easier to guarantee correct
    error messages in the 'ExceptT FinalParserError' layer
  - This does not make the 'StateT Journal' stack redundant because the
    'ExceptT FinalParseError' stack cannot be used to detect cycles of
    include files
---
 hledger-lib/Hledger/Read/Common.hs          |  43 +++++-
 hledger-lib/Hledger/Read/JournalReader.hs   |   2 +-
 hledger-lib/Hledger/Read/TimeclockReader.hs |   2 +-
 hledger-lib/Hledger/Read/TimedotReader.hs   |   2 +-
 hledger-lib/Hledger/Utils/Parse.hs          |   7 +
 hledger-lib/Text/Megaparsec/Custom.hs       | 154 +++++++++++++++++++-
 6 files changed, 203 insertions(+), 7 deletions(-)

diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs
index 2b0a475f2..89c1f1880 100644
--- a/hledger-lib/Hledger/Read/Common.hs
+++ b/hledger-lib/Hledger/Read/Common.hs
@@ -29,10 +29,13 @@ module Hledger.Read.Common (
   rtp,
   runJournalParser,
   rjp,
+  runErroringJournalParser,
+  rejp,
   genericSourcePos,
   journalSourcePos,
   applyTransactionModifiers,
   parseAndFinaliseJournal,
+  parseAndFinaliseJournal',
   setYear,
   getYear,
   setDefaultCommodityAndStyle,
@@ -99,7 +102,7 @@ where
 import Prelude ()
 import "base-compat-batteries" Prelude.Compat hiding (readFile)
 import "base-compat-batteries" Control.Monad.Compat
-import Control.Monad.Except (ExceptT(..), throwError)
+import Control.Monad.Except (ExceptT(..), runExceptT, throwError)
 import Control.Monad.State.Strict
 import Data.Bifunctor (bimap, second)
 import Data.Char
@@ -200,6 +203,16 @@ runJournalParser, rjp :: Monad m => JournalParser m a -> Text -> m (Either (Pars
 runJournalParser p t = runParserT (evalStateT p mempty) "" t
 rjp = runJournalParser
 
+-- | Run an erroring journal parser in some monad. See also: parseWithState.
+runErroringJournalParser, rejp
+  :: Monad m
+  => ErroringJournalParser m a
+  -> Text
+  -> m (Either FinalParseError (Either (ParseError Char CustomErr) a))
+runErroringJournalParser p t =
+  runExceptT $ runParserT (evalStateT p mempty) "" t
+rejp = runErroringJournalParser
+
 genericSourcePos :: SourcePos -> GenericSourcePos
 genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . unPos $ sourceColumn p)
 
@@ -221,9 +234,32 @@ applyTransactionModifiers j = j { jtxns = map applyallmodifiers $ jtxns j }
 
 -- | Given a megaparsec ParsedJournal parser, input options, file
 -- path and file content: parse and post-process a Journal, or give an error.
-parseAndFinaliseJournal :: JournalParser IO ParsedJournal -> InputOpts
+parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
                            -> FilePath -> Text -> ExceptT String IO Journal
 parseAndFinaliseJournal parser iopts f txt = do
+  t <- liftIO getClockTime
+  y <- liftIO getCurrentYear
+  let initJournal = nulljournal
+        { jparsedefaultyear = Just y
+        , jincludefilestack = [f] }
+  eep <- liftIO $ runExceptT $
+    runParserT (evalStateT parser initJournal) f txt
+  case eep of
+    Left finalParseError ->
+      throwError $ finalParseErrorPretty $ attachSource f txt finalParseError
+
+    Right ep -> case ep of
+      Left e -> throwError $ customParseErrorPretty txt e
+
+      Right pj ->
+        let pj' = if auto_ iopts then applyTransactionModifiers pj else pj in
+        case journalFinalise t f txt (not $ ignore_assertions_ iopts) pj' of
+                          Right j -> return j
+                          Left e  -> throwError e
+
+parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts
+                           -> FilePath -> Text -> ExceptT String IO Journal
+parseAndFinaliseJournal' parser iopts f txt = do
   t <- liftIO getClockTime
   y <- liftIO getCurrentYear
   let initJournal = nulljournal
@@ -231,12 +267,13 @@ parseAndFinaliseJournal parser iopts f txt = do
         , jincludefilestack = [f] }
   ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt
   case ep of
+    Left e   -> throwError $ customParseErrorPretty txt e
+
     Right pj -> 
       let pj' = if auto_ iopts then applyTransactionModifiers pj else pj in
       case journalFinalise t f txt (not $ ignore_assertions_ iopts) pj' of
                         Right j -> return j
                         Left e  -> throwError e
-    Left e   -> throwError $ customParseErrorPretty txt e
 
 setYear :: Year -> JournalParser m ()
 setYear y = modify' (\j -> j{jparsedefaultyear=Just y})
diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs
index 1a4f1f84c..91a2bf868 100644
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@@ -106,7 +106,7 @@ reader = Reader
 -- | Parse and post-process a "Journal" from hledger's journal file
 -- format, or give an error.
 parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
-parse iopts = parseAndFinaliseJournal journalp' iopts
+parse iopts = parseAndFinaliseJournal' journalp' iopts
   where
     journalp' = do 
       -- reverse parsed aliases to ensure that they are applied in order given on commandline
diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs
index 22bc2901c..597c2648d 100644
--- a/hledger-lib/Hledger/Read/TimeclockReader.hs
+++ b/hledger-lib/Hledger/Read/TimeclockReader.hs
@@ -78,7 +78,7 @@ reader = Reader
 -- format, saving the provided file path and the current time, or give an
 -- error.
 parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
-parse = parseAndFinaliseJournal timeclockfilep
+parse = parseAndFinaliseJournal' timeclockfilep
 
 timeclockfilep :: MonadIO m => JournalParser m ParsedJournal
 timeclockfilep = do many timeclockitemp
diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs
index 77fb37b7a..aca5776e6 100644
--- a/hledger-lib/Hledger/Read/TimedotReader.hs
+++ b/hledger-lib/Hledger/Read/TimedotReader.hs
@@ -64,7 +64,7 @@ reader = Reader
 
 -- | Parse and post-process a "Journal" from the timedot format, or give an error.
 parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
-parse = parseAndFinaliseJournal timedotfilep
+parse = parseAndFinaliseJournal' timedotfilep
 
 timedotfilep :: JournalParser m ParsedJournal
 timedotfilep = do many timedotfileitemp
diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs
index 409ee40e3..eb723ef6d 100644
--- a/hledger-lib/Hledger/Utils/Parse.hs
+++ b/hledger-lib/Hledger/Utils/Parse.hs
@@ -5,6 +5,7 @@ module Hledger.Utils.Parse (
   SimpleTextParser,
   TextParser,
   JournalParser,
+  ErroringJournalParser,
 
   choice',
   choiceInState,
@@ -27,6 +28,7 @@ module Hledger.Utils.Parse (
 )
 where
 
+import Control.Monad.Except (ExceptT)
 import Control.Monad.State.Strict (StateT, evalStateT)
 import Data.Char
 import Data.Functor.Identity (Identity(..))
@@ -52,6 +54,11 @@ type TextParser m a = ParsecT CustomErr Text m a
 -- | A parser of text in some monad, with a journal as state.
 type JournalParser m a = StateT Journal (ParsecT CustomErr Text m) a
 
+-- | A parser of text in some monad, with a journal as state, that can throw a
+-- "final" parse error that does not backtrack.
+type ErroringJournalParser m a =
+  StateT Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
+
 -- | Backtracking choice, use this when alternatives share a prefix.
 -- Consumes no input if all choices fail.
 choice' :: [TextParser m a] -> TextParser m a
diff --git a/hledger-lib/Text/Megaparsec/Custom.hs b/hledger-lib/Text/Megaparsec/Custom.hs
index 804b62ab4..c19195836 100644
--- a/hledger-lib/Text/Megaparsec/Custom.hs
+++ b/hledger-lib/Text/Megaparsec/Custom.hs
@@ -15,13 +15,35 @@ module Text.Megaparsec.Custom (
   withSource,
 
   -- * Pretty-printing custom parse errors
-  customParseErrorPretty
+  customParseErrorPretty,
+
+
+  -- * Final parse error types
+  FinalParseError,
+  FinalParseError',
+  FinalParseErrorBundle,
+  FinalParseErrorBundle',
+
+  -- * Constructing final parse errors
+  errorFinal,
+  finalFancyFailure,
+  finalFail,
+  finalCustomFailure,
+
+  -- * Handling errors from include files with final parse errors
+  parseIncludeFile,
+  attachSource,
+
+  -- * Pretty-printing final parse errors
+  finalParseErrorPretty,
 )
 where
 
 import Prelude ()
 import "base-compat-batteries" Prelude.Compat hiding (readFile)
 
+import Control.Monad.Except
+import Control.Monad.State.Strict (StateT, evalStateT)
 import Data.Foldable (asum, toList)
 import qualified Data.List.NonEmpty as NE
 import Data.Proxy (Proxy (Proxy))
@@ -129,6 +151,136 @@ customParseErrorPretty source err = case findCustomError err of
     finds f = asum . map f . toList
 
 
+--- * Final parse error types
+
+-- | 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.
+--
+-- In order to pretty-print a parse error, we must bundle it with the
+-- source text and its filepaths (the 'ErrorBundle' constructor). However,
+-- when an 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 the source text and its filepath by the parser's caller
+-- (the 'ErrorFinal' constructor).
+
+data FinalParseError' e
+  = ErrorFinal  (ParseError Char e)
+  | ErrorBundle (FinalParseErrorBundle' e)
+  deriving (Show)
+
+type FinalParseError = FinalParseError' CustomErr
+
+-- A 'Monoid' instance is necessary for 'ExceptT (FinalParseError'' e)' to
+-- be an instance of Alternative and MonadPlus, which are required for the
+-- use of e.g. the 'many' parser combinator. This monoid instance simply
+-- takes the first (left-most) error.
+
+instance Semigroup (FinalParseError' e) where
+  e <> _ = e
+
+instance Monoid (FinalParseError' e) where
+  mempty = ErrorFinal $
+    FancyError (initialPos "" NE.:| [])
+               (S.singleton (ErrorFail "default parse error"))
+  mappend = (<>)
+
+-- | A type bundling a 'ParseError' with its source file and a stack of
+-- include file paths (for pretty printing). Although Megaparsec 6
+-- maintains a stack of source files, making a field of this type
+-- redundant, this capability will be removed in Megaparsec 7. Therefore,
+-- we implement stacks of source files here for a smoother transition in
+-- the future.
+
+data FinalParseErrorBundle' e = FinalParseErrorBundle'
+  { finalParseError :: ParseError Char e
+  , errorSource     :: Text
+  , sourceFileStack :: NE.NonEmpty FilePath
+  } deriving (Show)
+
+type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr
+
+--- * Constructing and throwing final parse errors
+
+-- | Convert a "regular" parse error into a "final" parse error.
+
+errorFinal :: ParseError Char e -> FinalParseError' e
+errorFinal = ErrorFinal
+
+-- | Like 'fancyFailure', but as a "final" parse error.
+
+finalFancyFailure
+  :: (MonadParsec e s m, MonadError (FinalParseError' e) m)
+  => S.Set (ErrorFancy e) -> m a
+finalFancyFailure errSet = do
+  pos <- getPosition
+  let parseErr = FancyError (pos NE.:| []) errSet
+  throwError $ ErrorFinal parseErr
+
+-- | Like 'fail', but as a "final" parse error.
+
+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.
+
+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
+
+-- Some care must be taken for sources to be attached to the right parse
+-- errors when dealing with include files, so we capture the necessary
+-- procedure in this function.
+
+parseIncludeFile
+  :: forall st m a. Monad m
+  => StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
+  -> st
+  -> FilePath
+  -> Text
+  -> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
+parseIncludeFile parser initState filepath text =
+  catchError parser' handler
+  where
+    parser' = do
+      eResult <- lift $ lift $
+                  runParserT (evalStateT parser initState) filepath text
+      case eResult of
+        Left parseError -> throwError $ errorFinal parseError
+        Right result -> pure result
+
+    handler e = throwError $ ErrorBundle $ attachSource filepath text e
+
+
+attachSource
+  :: FilePath -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
+attachSource filePath sourceText finalParseError =
+  case finalParseError of
+    ErrorFinal parseError -> FinalParseErrorBundle'
+      { finalParseError = parseError
+      , errorSource     = sourceText
+      , sourceFileStack = filePath NE.:| []
+      }
+    ErrorBundle bundle -> bundle
+      { sourceFileStack = filePath NE.<| sourceFileStack bundle
+      }
+
+--- * Pretty-printing final parse errors
+
+-- | Pretty-print a "final" parse error: print the stack of include files,
+-- then apply the pretty-printer for custom parse errors.
+
+finalParseErrorPretty :: FinalParseErrorBundle' CustomErr -> String
+finalParseErrorPretty bundle =
+     concatMap printIncludeFile (NE.init (sourceFileStack bundle))
+  <> customParseErrorPretty (errorSource bundle) (finalParseError bundle)
+  where
+    printIncludeFile path = "in file included from " <> path <> ",\n"
+
+
 --- * Modified Megaparsec source
 
 -- The below code has been copied from Megaparsec (v.6.4.1,

From 3e54fc77a4d25708abda054089d9652f713d999c Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Thu, 27 Sep 2018 10:50:31 -0600
Subject: [PATCH 4/9] lib: make 'includedirectivep' an 'ErroringJournalParser'

- Update tests as well, requiring test utilities in Utils/Test.hs
  analogous to the those for 'JournalParser' but instead for
  'ErroringJournalParser'
---
 hledger-lib/Hledger/Read/JournalReader.hs | 24 ++++----
 hledger-lib/Hledger/Utils/Test.hs         | 75 +++++++++++++++++++++++
 2 files changed, 87 insertions(+), 12 deletions(-)

diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs
index 91a2bf868..6daf0a92b 100644
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@@ -106,7 +106,7 @@ reader = Reader
 -- | Parse and post-process a "Journal" from hledger's journal file
 -- format, or give an error.
 parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
-parse iopts = parseAndFinaliseJournal' journalp' iopts
+parse iopts = parseAndFinaliseJournal journalp' iopts
   where
     journalp' = do 
       -- reverse parsed aliases to ensure that they are applied in order given on commandline
@@ -124,10 +124,10 @@ aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++qu
 -- | A journal parser. Accumulates and returns a "ParsedJournal",
 -- which should be finalised/validated before use.
 --
--- >>> rjp (journalp <* eof) "2015/1/1\n a  0\n"
--- Right Journal  with 1 transactions, 1 accounts
+-- >>> rejp (journalp <* eof) "2015/1/1\n a  0\n"
+-- Right (Right Journal  with 1 transactions, 1 accounts)
 --
-journalp :: MonadIO m => JournalParser m ParsedJournal
+journalp :: MonadIO m => ErroringJournalParser m ParsedJournal
 journalp = do
   many addJournalItemP
   eof
@@ -135,7 +135,7 @@ journalp = do
 
 -- | A side-effecting parser; parses any kind of journal item
 -- and updates the parse state accordingly.
-addJournalItemP :: MonadIO m => JournalParser m ()
+addJournalItemP :: MonadIO m => ErroringJournalParser m ()
 addJournalItemP =
   -- all journal line types can be distinguished by the first
   -- character, can use choice without backtracking
@@ -154,7 +154,7 @@ addJournalItemP =
 -- | Parse any journal directive and update the parse state accordingly.
 -- Cf http://hledger.org/manual.html#directives,
 -- http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
-directivep :: MonadIO m => JournalParser m ()
+directivep :: MonadIO m => ErroringJournalParser m ()
 directivep = (do
   optional $ char '!'
   choice [
@@ -174,7 +174,7 @@ directivep = (do
    ]
   ) <?> "directive"
 
-includedirectivep :: MonadIO m => JournalParser m ()
+includedirectivep :: MonadIO m => ErroringJournalParser m ()
 includedirectivep = do
   string "include"
   lift (skipSome spacenonewline)
@@ -784,8 +784,8 @@ tests_JournalReader = tests "JournalReader" [
 
   ,tests "directivep" [
     test "supports !" $ do 
-      expectParse directivep "!account a\n"
-      expectParse directivep "!D 1.0\n"
+      expectParseE directivep "!account a\n"
+      expectParseE directivep "!D 1.0\n"
     ]
 
   ,test "accountdirectivep" $ do
@@ -808,8 +808,8 @@ tests_JournalReader = tests "JournalReader" [
      expectParse ignoredpricecommoditydirectivep "N $\n"
 
   ,test "includedirectivep" $ do
-    test "include" $ expectParseError includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
-    test "glob" $ expectParseError includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
+    test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
+    test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
 
   ,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep
     "P 2017/01/30 BTC $922.83\n"
@@ -828,7 +828,7 @@ tests_JournalReader = tests "JournalReader" [
 
 
   ,tests "journalp" [
-    test "empty file" $ expectParseEq journalp "" nulljournal
+    test "empty file" $ expectParseEqE journalp "" nulljournal
     ]
 
   ]
diff --git a/hledger-lib/Hledger/Utils/Test.hs b/hledger-lib/Hledger/Utils/Test.hs
index 208d5e6ef..c382cd311 100644
--- a/hledger-lib/Hledger/Utils/Test.hs
+++ b/hledger-lib/Hledger/Utils/Test.hs
@@ -16,13 +16,18 @@ module Hledger.Utils.Test (
   ,is
   ,expectEqPP
   ,expectParse
+  ,expectParseE
   ,expectParseError
+  ,expectParseErrorE
   ,expectParseEq
+  ,expectParseEqE
   ,expectParseEqOn
+  ,expectParseEqOnE
 ) 
 where
 
 import Control.Exception
+import Control.Monad.Except (ExceptT, runExceptT)
 import Control.Monad.State.Strict (StateT, evalStateT)
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Monoid ((<>))
@@ -101,6 +106,7 @@ is = flip expectEqPP
 
 -- | Test that this stateful parser runnable in IO successfully parses 
 -- all of the given input text, showing the parse error if it fails. 
+
 -- Suitable for hledger's JournalParser parsers.
 expectParse :: (Monoid st, Eq a, Show a, HasCallStack) => 
   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test ()
@@ -108,6 +114,24 @@ expectParse parser input = do
   ep <- E.io (runParserT (evalStateT (parser <* eof) mempty) "" input)
   either (fail.(++"\n").("\nparse error at "++).parseErrorPretty) (const ok) ep
 
+-- Suitable for hledger's ErroringJournalParser parsers.
+expectParseE
+  :: (Monoid st, Eq a, Show a, HasCallStack)
+  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
+  -> T.Text
+  -> E.Test ()
+expectParseE parser input = do
+  let filepath = ""
+  eep <- E.io $ runExceptT $
+           runParserT (evalStateT (parser <* eof) mempty) filepath input
+  case eep of
+    Left finalErr ->
+      let prettyErr = finalParseErrorPretty $ attachSource filepath input finalErr
+      in  fail $ "parse error at " <> prettyErr
+    Right ep -> either (fail.(++"\n").("\nparse error at "++).parseErrorPretty)
+                       (const ok)
+                       ep
+
 -- | Test that this stateful parser runnable in IO fails to parse 
 -- the given input text, with a parse error containing the given string. 
 expectParseError :: (Monoid st, Eq a, Show a, HasCallStack) => 
@@ -122,12 +146,43 @@ expectParseError parser input errstr = do
       then ok
       else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
 
+expectParseErrorE
+  :: (Monoid st, Eq a, Show a, HasCallStack)
+  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
+  -> T.Text
+  -> String
+  -> E.Test ()
+expectParseErrorE parser input errstr = do
+  let filepath = ""
+  eep <- E.io $ runExceptT $ runParserT (evalStateT parser mempty) filepath input
+  case eep of
+    Left finalErr -> do
+      let prettyErr = finalParseErrorPretty $ attachSource filepath input finalErr
+      if errstr `isInfixOf` prettyErr
+      then ok
+      else fail $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n"
+    Right ep -> case ep of
+      Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
+      Left e  -> do
+        let e' = parseErrorPretty e
+        if errstr `isInfixOf` e'
+        then ok
+        else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
+
 -- | Like expectParse, but also test the parse result is an expected value,
 -- pretty-printing both if it fails. 
 expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) => 
   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test ()
 expectParseEq parser input expected = expectParseEqOn parser input id expected
 
+expectParseEqE
+  :: (Monoid st, Eq a, Show a, HasCallStack)
+  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
+  -> T.Text
+  -> a
+  -> E.Test ()
+expectParseEqE parser input expected = expectParseEqOnE parser input id expected
+
 -- | Like expectParseEq, but transform the parse result with the given function 
 -- before comparing it.
 expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) => 
@@ -136,3 +191,23 @@ expectParseEqOn parser input f expected = do
   ep <- E.io $ runParserT (evalStateT (parser <* eof) mempty) "" input
   either (fail . (++"\n") . ("\nparse error at "++) . parseErrorPretty) (expectEqPP expected . f) ep
 
+expectParseEqOnE
+  :: (Monoid st, Eq b, Show b, HasCallStack)
+  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
+  -> T.Text
+  -> (a -> b)
+  -> b
+  -> E.Test ()
+expectParseEqOnE parser input f expected = do
+  let filepath = ""
+  eep <- E.io $ runExceptT $
+           runParserT (evalStateT (parser <* eof) mempty) filepath input
+  case eep of
+    Left finalErr ->
+      let prettyErr = finalParseErrorPretty $ attachSource filepath input finalErr
+      in  fail $ "parse error at " <> prettyErr
+    Right ep ->
+      either (fail . (++"\n") . ("\nparse error at "++) . parseErrorPretty)
+             (expectEqPP expected . f)
+             ep
+

From 31d4e930e7901101ca2fea6e05e6c2c693f3a363 Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Thu, 27 Sep 2018 13:44:42 -0600
Subject: [PATCH 5/9] lib: Re-implement 'includedirectivep' with the new
 'ExceptT' layer

- Parse errors encountered in include files are treated as "final" parse
  errors in the parent file, preventing backtracking and fixing an issue
  in #853
---
 hledger-lib/Hledger/Read/JournalReader.hs | 65 ++++++++++-------------
 1 file changed, 29 insertions(+), 36 deletions(-)

diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs
index 6daf0a92b..4b94f9d0d 100644
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@@ -189,6 +189,7 @@ includedirectivep = do
   void newline
 
   where
+    getFilePaths :: MonadIO m => SourcePos -> FilePath -> JournalParser m [FilePath]
     getFilePaths parserpos filename = do
         curdir <- lift $ expandPath (takeDirectory $ sourceName parserpos) ""
                          `orRethrowIOError` (show parserpos ++ " locating " ++ filename)
@@ -205,49 +206,41 @@ includedirectivep = do
             else customFailure $ parseErrorAt parserpos $
                    "No existing files match pattern: " ++ filename
 
+    parseChild :: MonadIO m => SourcePos -> FilePath -> ErroringJournalParser m ()
     parseChild parentpos filepath = do
-        parentfilestack <- fmap sourceName . statePos <$> getParserState
-        when (filepath `elem` parentfilestack) $ customFailure $
-          parseErrorAt parentpos ("Cyclic include: " ++ filepath)
+      parentj <- get
 
-        childInput <- lift $ readFilePortably filepath
-                             `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
+      let parentfilestack = jincludefilestack parentj
+      when (filepath `elem` parentfilestack) $
+        fail ("Cyclic include: " ++ filepath)
 
-        -- save parent state
-        parentParserState <- getParserState
-        parentj <- get
+      childInput <- lift $ readFilePortably filepath
+                            `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
+      let initChildj = newJournalWithParseStateFrom filepath parentj
 
-        let childj = newJournalWithParseStateFrom parentj
+      let parser = choiceInState
+            [ journalp
+            , timeclockfilep
+            , timedotfilep
+            ] -- can't include a csv file yet, that reader is special
+      updatedChildj <- journalAddFile (filepath, childInput) <$>
+                        parseIncludeFile parser initChildj filepath childInput
 
-        -- set child state
-        setInput childInput
-        pushPosition $ initialPos filepath
-        put childj
-
-        -- parse include file
-        let parsers = [ journalp
-                      , timeclockfilep
-                      , timedotfilep
-                      ] -- can't include a csv file yet, that reader is special
-        updatedChildj <- journalAddFile (filepath, childInput) <$>
-                        region (withSource childInput) (choiceInState parsers)
-
-        -- restore parent state, prepending the child's parse info
-        setParserState parentParserState
-        put $ updatedChildj <> parentj
-        -- discard child's parse info, prepend its (reversed) list data, combine other fields
+      -- discard child's parse info,  combine other fields
+      put $ updatedChildj <> parentj
 
 
-newJournalWithParseStateFrom :: Journal -> Journal
-newJournalWithParseStateFrom j = mempty{
-   jparsedefaultyear      = jparsedefaultyear j
-  ,jparsedefaultcommodity = jparsedefaultcommodity j
-  ,jparseparentaccounts   = jparseparentaccounts j
-  ,jparsealiases          = jparsealiases j
-  ,jcommodities           = jcommodities j
-  -- ,jparsetransactioncount = jparsetransactioncount j
-  ,jparsetimeclockentries = jparsetimeclockentries j
-  }
+    newJournalWithParseStateFrom :: FilePath -> Journal -> Journal
+    newJournalWithParseStateFrom filepath j = mempty{
+      jparsedefaultyear      = jparsedefaultyear j
+      ,jparsedefaultcommodity = jparsedefaultcommodity j
+      ,jparseparentaccounts   = jparseparentaccounts j
+      ,jparsealiases          = jparsealiases j
+      ,jcommodities           = jcommodities j
+      -- ,jparsetransactioncount = jparsetransactioncount j
+      ,jparsetimeclockentries = jparsetimeclockentries j
+      ,jincludefilestack      = filepath : jincludefilestack j
+      }
 
 -- | Lift an IO action into the exception monad, rethrowing any IO
 -- error with the given message prepended.

From 26369c28a3fcc24f86cc4d55ab3f6c8bda6f7be4 Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Sat, 29 Sep 2018 22:43:39 -0600
Subject: [PATCH 6/9] lib: remove old code for include file parse errors

---
 hledger-lib/Text/Megaparsec/Custom.hs | 19 +++----------------
 1 file changed, 3 insertions(+), 16 deletions(-)

diff --git a/hledger-lib/Text/Megaparsec/Custom.hs b/hledger-lib/Text/Megaparsec/Custom.hs
index c19195836..6fd034cbc 100644
--- a/hledger-lib/Text/Megaparsec/Custom.hs
+++ b/hledger-lib/Text/Megaparsec/Custom.hs
@@ -12,7 +12,6 @@ module Text.Megaparsec.Custom (
   -- * Constructing custom parse errors
   parseErrorAt,
   parseErrorAtRegion,
-  withSource,
 
   -- * Pretty-printing custom parse errors
   customParseErrorPretty,
@@ -64,10 +63,6 @@ data CustomErr
   = ErrorFailAt SourcePos -- Starting position
                 Pos -- Ending position (column; same line as start)
                 String -- Error message
-  -- | Attach a source file to a parse error (for error reporting from
-  -- include files, e.g. with the 'region' parser combinator)
-  | ErrorWithSource Text -- Source file contents
-                    (ParseError Char CustomErr) -- The original
   deriving (Show, Eq, Ord)
 
 -- We require an 'Ord' instance for 'CustomError' so that they may be
@@ -79,7 +74,6 @@ deriving instance (Ord c, Ord e) => Ord (ParseError c e)
 
 instance ShowErrorComponent CustomErr where
   showErrorComponent (ErrorFailAt _ _ errMsg) = errMsg
-  showErrorComponent (ErrorWithSource _ e) = parseErrorTextPretty e
 
 
 --- * Constructing custom parse errors
@@ -107,13 +101,6 @@ parseErrorAtRegion startPos endPos msg =
                then endCol' else startCol
   in  ErrorFailAt startPos endCol msg
 
--- | Attach a source file to a parse error. Intended for use with the
--- 'region' parser combinator.
-
-withSource :: Text -> ParseError Char CustomErr -> ParseError Char CustomErr
-withSource s e =
-  FancyError (errorPos e) $ S.singleton $ ErrorCustom $ ErrorWithSource s e
-
 
 --- * Pretty-printing custom parse errors
 
@@ -127,9 +114,6 @@ customParseErrorPretty :: Text -> ParseError Char CustomErr -> String
 customParseErrorPretty source err = case findCustomError err of
   Nothing -> customParseErrorPretty' source err pos1
 
-  Just (ErrorWithSource customSource customErr) ->
-    customParseErrorPretty customSource customErr
-
   Just (ErrorFailAt sourcePos col errMsg) ->
     let newPositionStack = sourcePos NE.:| NE.tail (errorPos err)
         errorIntervalLength = mkPos $ max 1 $
@@ -200,6 +184,7 @@ data FinalParseErrorBundle' e = FinalParseErrorBundle'
 
 type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr
 
+
 --- * Constructing and throwing final parse errors
 
 -- | Convert a "regular" parse error into a "final" parse error.
@@ -229,6 +214,7 @@ 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
 
 -- Some care must be taken for sources to be attached to the right parse
@@ -268,6 +254,7 @@ attachSource filePath sourceText finalParseError =
       { sourceFileStack = filePath NE.<| sourceFileStack bundle
       }
 
+
 --- * Pretty-printing final parse errors
 
 -- | Pretty-print a "final" parse error: print the stack of include files,

From 3d2584d869240ef87983c0395e084142d803ba84 Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Sat, 29 Sep 2018 19:32:08 -0600
Subject: [PATCH 7/9] lib: switch to megaparsec 7

---
 hledger-lib/Hledger/Data/Dates.hs            |  19 +-
 hledger-lib/Hledger/Read/Common.hs           |  93 +++---
 hledger-lib/Hledger/Read/CsvReader.hs        |  25 +-
 hledger-lib/Hledger/Read/JournalReader.hs    |  50 ++--
 hledger-lib/Hledger/Read/TimeclockReader.hs  |   3 +-
 hledger-lib/Hledger/Read/TimedotReader.hs    |   2 +-
 hledger-lib/Hledger/Reports/ReportOptions.hs |  12 +-
 hledger-lib/Hledger/Utils/Debug.hs           |   2 +-
 hledger-lib/Hledger/Utils/Parse.hs           |  29 +-
 hledger-lib/Hledger/Utils/Test.hs            |  27 +-
 hledger-lib/Text/Megaparsec/Custom.hs        | 297 +++++++------------
 hledger-lib/hledger-lib.cabal                |   8 +-
 hledger-lib/package.yaml                     |   2 +-
 hledger-ui/Hledger/UI/ErrorScreen.hs         |   4 +-
 hledger-ui/hledger-ui.cabal                  |   4 +-
 hledger-ui/package.yaml                      |   2 +-
 hledger-web/Hledger/Web/Widget/AddForm.hs    |   4 +-
 hledger-web/hledger-web.cabal                |   4 +-
 hledger-web/package.yaml                     |   2 +-
 hledger/Hledger/Cli/Commands/Add.hs          |   2 +-
 hledger/Hledger/Cli/Commands/Rewrite.hs      |   2 +-
 hledger/hledger.cabal                        |  10 +-
 hledger/package.yaml                         |   2 +-
 stack-ghc7.10.yaml                           |   8 +-
 stack-ghc8.0.yaml                            |   7 +-
 stack-ghc8.2.yaml                            |   5 +-
 stack.yaml                                   |   4 +-
 tests/journal/parse-errors.test              |   2 +-
 28 files changed, 282 insertions(+), 349 deletions(-)

diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs
index 0e5334348..2838f3b3c 100644
--- a/hledger-lib/Hledger/Data/Dates.hs
+++ b/hledger-lib/Hledger/Data/Dates.hs
@@ -77,6 +77,7 @@ where
 
 import Prelude ()
 import "base-compat-batteries" Prelude.Compat
+import Control.Applicative.Permutations
 import Control.Monad
 import "base-compat-batteries" Data.List.Compat
 import Data.Default
@@ -96,7 +97,7 @@ import Data.Time.LocalTime
 import Safe (headMay, lastMay, readMay)
 import Text.Megaparsec
 import Text.Megaparsec.Char
-import Text.Megaparsec.Perm
+import Text.Megaparsec.Custom
 import Text.Printf
 
 import Hledger.Data.Types
@@ -314,13 +315,14 @@ earliest (Just d1) (Just d2) = Just $ min d1 d2
 
 -- | Parse a period expression to an Interval and overall DateSpan using
 -- the provided reference date, or return a parse error.
-parsePeriodExpr :: Day -> Text -> Either (ParseError Char CustomErr) (Interval, DateSpan)
+parsePeriodExpr
+  :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
 parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s)
 
 -- | Like parsePeriodExpr, but call error' on failure.
 parsePeriodExpr' :: Day -> Text -> (Interval, DateSpan)
 parsePeriodExpr' refdate s =
-  either (error' . ("failed to parse:" ++) . parseErrorPretty) id $
+  either (error' . ("failed to parse:" ++) . customErrorBundlePretty) id $
   parsePeriodExpr refdate s
 
 maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)
@@ -380,13 +382,14 @@ fixSmartDateStr :: Day -> Text -> String
 fixSmartDateStr d s = either
                        (\e->error' $ printf "could not parse date %s %s" (show s) (show e))
                        id
-                       $ (fixSmartDateStrEither d s :: Either (ParseError Char CustomErr) String)
+                       $ (fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String)
 
 -- | A safe version of fixSmartDateStr.
-fixSmartDateStrEither :: Day -> Text -> Either (ParseError Char CustomErr) String
+fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) String
 fixSmartDateStrEither d = either Left (Right . showDate) . fixSmartDateStrEither' d
 
-fixSmartDateStrEither' :: Day -> Text -> Either (ParseError Char CustomErr) Day
+fixSmartDateStrEither'
+  :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
 fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
                                Right sd -> Right $ fixSmartDate d sd
                                Left e -> Left e
@@ -987,7 +990,9 @@ reportingintervalp = choice' [
                           return $ DayOfMonth n,
                        do string' "every"
                           let mnth = choice' [month, mon] >>= \(_,m,_) -> return (read m)
-                          d_o_y <- makePermParser $ DayOfYear <$$> try (skipMany spacenonewline *> mnth) <||> try (skipMany spacenonewline *> nth)
+                          d_o_y <- runPermutation $
+                            DayOfYear <$> toPermutation (try (skipMany spacenonewline *> mnth))
+                                      <*> toPermutation (try (skipMany spacenonewline *> nth))
                           optOf_ "year"
                           return d_o_y,
                        do string' "every"
diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs
index 89c1f1880..b305fa957 100644
--- a/hledger-lib/Hledger/Read/Common.hs
+++ b/hledger-lib/Hledger/Read/Common.hs
@@ -194,12 +194,15 @@ rawOptsToInputOpts rawopts = InputOpts{
 --- * parsing utilities
 
 -- | Run a text parser in the identity monad. See also: parseWithState.
-runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char CustomErr) a
+runTextParser, rtp
+  :: TextParser Identity a -> Text -> Either (ParseErrorBundle Text CustomErr) a
 runTextParser p t =  runParser p "" t
 rtp = runTextParser
 
 -- | Run a journal parser in some monad. See also: parseWithState.
-runJournalParser, rjp :: Monad m => JournalParser m a -> Text -> m (Either (ParseError Char CustomErr) a)
+runJournalParser, rjp
+  :: Monad m
+  => JournalParser m a -> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
 runJournalParser p t = runParserT (evalStateT p mempty) "" t
 rjp = runJournalParser
 
@@ -208,7 +211,7 @@ runErroringJournalParser, rejp
   :: Monad m
   => ErroringJournalParser m a
   -> Text
-  -> m (Either FinalParseError (Either (ParseError Char CustomErr) a))
+  -> m (Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
 runErroringJournalParser p t =
   runExceptT $ runParserT (evalStateT p mempty) "" t
 rejp = runErroringJournalParser
@@ -246,10 +249,10 @@ parseAndFinaliseJournal parser iopts f txt = do
     runParserT (evalStateT parser initJournal) f txt
   case eep of
     Left finalParseError ->
-      throwError $ finalParseErrorPretty $ attachSource f txt finalParseError
+      throwError $ finalErrorBundlePretty $ attachSource f txt finalParseError
 
     Right ep -> case ep of
-      Left e -> throwError $ customParseErrorPretty txt e
+      Left e -> throwError $ customErrorBundlePretty e
 
       Right pj ->
         let pj' = if auto_ iopts then applyTransactionModifiers pj else pj in
@@ -267,7 +270,7 @@ parseAndFinaliseJournal' parser iopts f txt = do
         , jincludefilestack = [f] }
   ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt
   case ep of
-    Left e   -> throwError $ customParseErrorPretty txt e
+    Left e   -> throwError $ customErrorBundlePretty e
 
     Right pj -> 
       let pj' = if auto_ iopts then applyTransactionModifiers pj else pj in
@@ -385,43 +388,43 @@ datep = do
 
 datep' :: Maybe Year -> TextParser m Day
 datep' mYear = do
-  startPos <- getPosition
+  startOffset <- getOffset
   d1 <- decimal <?> "year or month"
   sep <- satisfy isDateSepChar <?> "date separator"
   d2 <- decimal <?> "month or day"
-  fullDate startPos d1 sep d2 <|> partialDate startPos mYear d1 sep d2
+  fullDate startOffset d1 sep d2 <|> partialDate startOffset mYear d1 sep d2
   <?> "full or partial date"
 
   where
 
-  fullDate :: SourcePos -> Integer -> Char -> Int -> TextParser m Day
-  fullDate startPos year sep1 month = do
+  fullDate :: Int -> Integer -> Char -> Int -> TextParser m Day
+  fullDate startOffset year sep1 month = do
     sep2 <- satisfy isDateSepChar <?> "date separator"
     day <- decimal <?> "day"
-    endPos <- getPosition
+    endOffset <- getOffset
     let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day
 
-    when (sep1 /= sep2) $ customFailure $ parseErrorAtRegion startPos endPos $
+    when (sep1 /= sep2) $ customFailure $ parseErrorAtRegion startOffset endOffset $
       "invalid date (mixing date separators is not allowed): " ++ dateStr
 
     case fromGregorianValid year month day of
-      Nothing -> customFailure $ parseErrorAtRegion startPos endPos $
+      Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
                    "well-formed but invalid date: " ++ dateStr
       Just date -> pure $! date
 
   partialDate
-    :: SourcePos -> Maybe Year -> Integer -> Char -> Int -> TextParser m Day
-  partialDate startPos mYear month sep day = do
-    endPos <- getPosition
+    :: Int -> Maybe Year -> Integer -> Char -> Int -> TextParser m Day
+  partialDate startOffset mYear month sep day = do
+    endOffset <- getOffset
     case mYear of
       Just year ->
         case fromGregorianValid year (fromIntegral month) day of
-          Nothing -> customFailure $ parseErrorAtRegion startPos endPos $
+          Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
                       "well-formed but invalid date: " ++ dateStr
           Just date -> pure $! date
         where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day
 
-      Nothing -> customFailure $ parseErrorAtRegion startPos endPos $
+      Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $
         "partial date "++dateStr++" found, but the current year is unknown"
         where dateStr = show month ++ [sep] ++ show day
 
@@ -449,26 +452,26 @@ datetimep' mYear = do
   where
     timeOfDay :: TextParser m TimeOfDay
     timeOfDay = do
-      pos1 <- getPosition
+      off1 <- getOffset
       h' <- twoDigitDecimal <?> "hour"
-      pos2 <- getPosition
+      off2 <- getOffset
       unless (h' >= 0 && h' <= 23) $ customFailure $
-        parseErrorAtRegion pos1 pos2 "invalid time (bad hour)"
+        parseErrorAtRegion off1 off2 "invalid time (bad hour)"
 
       char ':' <?> "':' (hour-minute separator)"
-      pos3 <- getPosition
+      off3 <- getOffset
       m' <- twoDigitDecimal <?> "minute"
-      pos4 <- getPosition
+      off4 <- getOffset
       unless (m' >= 0 && m' <= 59) $ customFailure $
-        parseErrorAtRegion pos3 pos4 "invalid time (bad minute)"
+        parseErrorAtRegion off3 off4 "invalid time (bad minute)"
 
       s' <- option 0 $ do
         char ':' <?> "':' (minute-second separator)"
-        pos5 <- getPosition
+        off5 <- getOffset
         s' <- twoDigitDecimal <?> "second"
-        pos6 <- getPosition
+        off6 <- getOffset
         unless (s' >= 0 && s' <= 59) $ customFailure $
-          parseErrorAtRegion pos5 pos6 "invalid time (bad second)"
+          parseErrorAtRegion off5 off6 "invalid time (bad second)"
           -- we do not support leap seconds
         pure s'
 
@@ -565,22 +568,22 @@ amountwithoutpricep = do
     suggestedStyle <- getAmountStyle c
     commodityspaced <- lift $ skipMany' spacenonewline
     sign2 <- lift $ signp
-    posBeforeNum <- getPosition
+    offBeforeNum <- getOffset
     ambiguousRawNum <- lift rawnumberp
     mExponent <- lift $ optional $ try exponentp
-    posAfterNum <- getPosition
-    let numRegion = (posBeforeNum, posAfterNum)
+    offAfterNum <- getOffset
+    let numRegion = (offBeforeNum, offAfterNum)
     (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent
     let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
     return $ Amount c (sign (sign2 q)) NoPrice s mult
 
   rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount
   rightornosymbolamountp mult sign = label "amount" $ do
-    posBeforeNum <- getPosition
+    offBeforeNum <- getOffset
     ambiguousRawNum <- lift rawnumberp
     mExponent <- lift $ optional $ try exponentp
-    posAfterNum <- getPosition
-    let numRegion = (posBeforeNum, posAfterNum)
+    offAfterNum <- getOffset
+    let numRegion = (offBeforeNum, offAfterNum)
     mSpaceAndCommodity <- lift $ optional $ try $ (,) <$> skipMany' spacenonewline <*> commoditysymbolp
     case mSpaceAndCommodity of
       -- right symbol amount
@@ -604,7 +607,7 @@ amountwithoutpricep = do
   -- For reducing code duplication. Doesn't parse anything. Has the type
   -- of a parser only in order to throw parse errors (for convenience).
   interpretNumber
-    :: (SourcePos, SourcePos)
+    :: (Int, Int) -- offsets
     -> Maybe AmountStyle
     -> Either AmbiguousNumber RawNumber
     -> Maybe Int
@@ -671,7 +674,7 @@ partialbalanceassertionp :: JournalParser m BalanceAssertion
 partialbalanceassertionp = optional $ do
   sourcepos <- try $ do
     lift (skipMany spacenonewline)
-    sourcepos <- genericSourcePos <$> lift getPosition
+    sourcepos <- genericSourcePos <$> lift getSourcePos
     char '='
     pure sourcepos
   lift (skipMany spacenonewline)
@@ -830,10 +833,10 @@ rawnumberp = label "number" $ do
     fail "invalid number (invalid use of separator)"
 
   mExtraFragment <- optional $ lookAhead $ try $
-    char ' ' *> getPosition <* digitChar
+    char ' ' *> getOffset <* digitChar
   case mExtraFragment of
-    Just pos -> customFailure $
-                  parseErrorAt pos "invalid number (excessive trailing digits)"
+    Just off -> customFailure $
+                  parseErrorAt off "invalid number (excessive trailing digits)"
     Nothing -> pure ()
 
   return $ dbg8 "rawnumberp" rawNumber
@@ -1193,19 +1196,19 @@ commenttagsanddatesp mYear = do
 -- default date is provided. A missing year in DATE2 will be inferred
 -- from DATE.
 --
--- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]"
+-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]"
 -- Right [("date",2016-01-02),("date2",2016-03-04)]
 --
--- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[1]"
+-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[1]"
 -- Left ...not a bracketed date...
 --
--- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]"
--- Left ...1:11:...well-formed but invalid date: 2016/1/32...
+-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]"
+-- Left ...1:2:...well-formed but invalid date: 2016/1/32...
 --
--- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[1/31]"
--- Left ...1:6:...partial date 1/31 found, but the current year is unknown...
+-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[1/31]"
+-- Left ...1:2:...partial date 1/31 found, but the current year is unknown...
 --
--- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]"
+-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]"
 -- Left ...1:13:...expecting month or day...
 --
 bracketeddatetagsp
diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs
index 34dae98a0..419bf2435 100644
--- a/hledger-lib/Hledger/Read/CsvReader.hs
+++ b/hledger-lib/Hledger/Read/CsvReader.hs
@@ -38,7 +38,6 @@ import Control.Monad.Except
 import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
 import Data.Char (toLower, isDigit, isSpace, ord)
 import "base-compat-batteries" Data.List.Compat
-import Data.List.NonEmpty (fromList)
 import Data.Maybe
 import Data.Ord
 import qualified Data.Set as S
@@ -59,12 +58,12 @@ import System.FilePath
 import qualified Data.Csv as Cassava
 import qualified Data.Csv.Parser.Megaparsec as CassavaMP
 import qualified Data.ByteString as B
-import Data.ByteString.Lazy (fromStrict)
+import qualified Data.ByteString.Lazy as BL
 import Data.Foldable
 import Text.Megaparsec hiding (parse)
 import Text.Megaparsec.Char
+import Text.Megaparsec.Custom
 import Text.Printf (printf)
-import Data.Word
 
 import Hledger.Data
 import Hledger.Utils
@@ -76,7 +75,7 @@ type Record = [Field]
 
 type Field = String
 
-data CSVError = CSVError (ParseError Word8 CassavaMP.ConversionError)
+data CSVError = CSVError (ParseErrorBundle BL.ByteString CassavaMP.ConversionError)
     deriving Show
 
 reader :: Reader
@@ -193,7 +192,7 @@ parseCassava separator path content =
         Left  msg -> Left $ CSVError msg
         Right a   -> Right a
     where parseResult = fmap parseResultToCsv $ CassavaMP.decodeWith (decodeOptions separator) Cassava.NoHeader path lazyContent
-          lazyContent = fromStrict $ T.encodeUtf8 content
+          lazyContent = BL.fromStrict $ T.encodeUtf8 content
 
 decodeOptions :: Char -> Cassava.DecodeOptions
 decodeOptions separator = Cassava.defaultDecodeOptions {
@@ -431,19 +430,19 @@ parseAndValidateCsvRules :: FilePath -> T.Text -> ExceptT String IO CsvRules
 parseAndValidateCsvRules rulesfile s = do
   let rules = parseCsvRules rulesfile s
   case rules of
-    Left e -> ExceptT $ return $ Left $ parseErrorPretty e
+    Left e -> ExceptT $ return $ Left $ customErrorBundlePretty e
     Right r -> do
                r_ <- liftIO $ runExceptT $ validateRules r
                ExceptT $ case r_ of
-                 Left  s -> return $ Left $ parseErrorPretty $ makeParseError rulesfile s
+                 Left  s -> return $ Left $ parseErrorPretty $ makeParseError s
                  Right r -> return $ Right r
 
   where
-    makeParseError :: FilePath -> String -> ParseError Char String
-    makeParseError f s = FancyError (fromList [initialPos f]) (S.singleton $ ErrorFail s)
+    makeParseError :: String -> ParseError T.Text String
+    makeParseError s = FancyError 0 (S.singleton $ ErrorFail s)
 
 -- | Parse this text as CSV conversion rules. The file path is for error messages.
-parseCsvRules :: FilePath -> T.Text -> Either (ParseError Char CustomErr) CsvRules
+parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text CustomErr) CsvRules
 -- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
 parseCsvRules rulesfile s =
   runParser (evalStateT rulesp rules) rulesfile s
@@ -513,7 +512,7 @@ directives =
   ]
 
 directivevalp :: CsvRulesParser String
-directivevalp = anyChar `manyTill` lift eolof
+directivevalp = anySingle `manyTill` lift eolof
 
 fieldnamelistp :: CsvRulesParser [CsvFieldName]
 fieldnamelistp = (do
@@ -588,7 +587,7 @@ assignmentseparatorp = do
 fieldvalp :: CsvRulesParser String
 fieldvalp = do
   lift $ dbgparse 2 "trying fieldvalp"
-  anyChar `manyTill` lift eolof
+  anySingle `manyTill` lift eolof
 
 conditionalblockp :: CsvRulesParser ConditionalBlock
 conditionalblockp = do
@@ -631,7 +630,7 @@ regexp = do
   lift $ dbgparse 3 "trying regexp"
   notFollowedBy matchoperatorp
   c <- lift nonspace
-  cs <- anyChar `manyTill` lift eolof
+  cs <- anySingle `manyTill` lift eolof
   return $ strip $ c:cs
 
 -- fieldmatcher = do
diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs
index 4b94f9d0d..06dc034d1 100644
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@@ -180,30 +180,32 @@ includedirectivep = do
   lift (skipSome spacenonewline)
   filename <- T.unpack <$> takeWhileP Nothing (/= '\n') -- don't consume newline yet
 
-  parentpos <- getPosition
+  parentoff <- getOffset
+  parentpos <- getSourcePos
 
-  filepaths <- getFilePaths parentpos filename
+  filepaths <- getFilePaths parentoff parentpos filename
 
   forM_ filepaths $ parseChild parentpos
 
   void newline
 
   where
-    getFilePaths :: MonadIO m => SourcePos -> FilePath -> JournalParser m [FilePath]
-    getFilePaths parserpos filename = do
+    getFilePaths
+      :: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath]
+    getFilePaths parseroff parserpos filename = do
         curdir <- lift $ expandPath (takeDirectory $ sourceName parserpos) ""
                          `orRethrowIOError` (show parserpos ++ " locating " ++ filename)
         -- Compiling filename as a glob pattern works even if it is a literal
         fileglob <- case tryCompileWith compDefault{errorRecovery=False} filename of
             Right x -> pure x
             Left e -> customFailure $
-                        parseErrorAt parserpos $ "Invalid glob pattern: " ++ e
+                        parseErrorAt parseroff $ "Invalid glob pattern: " ++ e
         -- Get all matching files in the current working directory, sorting in
         -- lexicographic order to simulate the output of 'ls'.
         filepaths <- liftIO $ sort <$> globDir1 fileglob curdir
         if (not . null) filepaths
             then pure filepaths
-            else customFailure $ parseErrorAt parserpos $
+            else customFailure $ parseErrorAt parseroff $
                    "No existing files match pattern: " ++ filename
 
     parseChild :: MonadIO m => SourcePos -> FilePath -> ErroringJournalParser m ()
@@ -229,7 +231,6 @@ includedirectivep = do
       -- discard child's parse info,  combine other fields
       put $ updatedChildj <> parentj
 
-
     newJournalWithParseStateFrom :: FilePath -> Journal -> Journal
     newJournalWithParseStateFrom filepath j = mempty{
       jparsedefaultyear      = jparsedefaultyear j
@@ -279,17 +280,17 @@ commoditydirectivep = commoditydirectiveonelinep <|> commoditydirectivemultiline
 -- >>> Right _ <- rjp commoditydirectiveonelinep "commodity $1.00 ; blah\n"
 commoditydirectiveonelinep :: JournalParser m ()
 commoditydirectiveonelinep = do
-  (pos, Amount{acommodity,astyle}) <- try $ do
+  (off, Amount{acommodity,astyle}) <- try $ do
     string "commodity"
     lift (skipSome spacenonewline)
-    pos <- getPosition
+    off <- getOffset
     amount <- amountp
-    pure $ (pos, amount)
+    pure $ (off, amount)
   lift (skipMany spacenonewline)
   _ <- lift followingcommentp
   let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg2 "style from commodity directive" astyle}
   if asdecimalpoint astyle == Nothing
-  then customFailure $ parseErrorAt pos pleaseincludedecimalpoint
+  then customFailure $ parseErrorAt off pleaseincludedecimalpoint
   else modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j})
 
 pleaseincludedecimalpoint :: String
@@ -316,15 +317,15 @@ formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle
 formatdirectivep expectedsym = do
   string "format"
   lift (skipSome spacenonewline)
-  pos <- getPosition
+  off <- getOffset
   Amount{acommodity,astyle} <- amountp
   _ <- lift followingcommentp
   if acommodity==expectedsym
     then 
       if asdecimalpoint astyle == Nothing
-      then customFailure $ parseErrorAt pos pleaseincludedecimalpoint
+      then customFailure $ parseErrorAt off pleaseincludedecimalpoint
       else return $ dbg2 "style from format subdirective" astyle
-    else customFailure $ parseErrorAt pos $
+    else customFailure $ parseErrorAt off $
          printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity
 
 keywordp :: String -> JournalParser m ()
@@ -366,7 +367,7 @@ basicaliasp = do
   old <- rstrip <$> (some $ noneOf ("=" :: [Char]))
   char '='
   skipMany spacenonewline
-  new <- rstrip <$> anyChar `manyTill` eolof  -- eol in journal, eof in command lines, normally
+  new <- rstrip <$> anySingle `manyTill` eolof  -- eol in journal, eof in command lines, normally
   return $ BasicAlias (T.pack old) (T.pack new)
 
 regexaliasp :: TextParser m AccountAlias
@@ -378,7 +379,7 @@ regexaliasp = do
   skipMany spacenonewline
   char '='
   skipMany spacenonewline
-  repl <- anyChar `manyTill` eolof
+  repl <- anySingle `manyTill` eolof
   return $ RegexAlias re repl
 
 endaliasesdirectivep :: JournalParser m ()
@@ -413,11 +414,11 @@ defaultcommoditydirectivep :: JournalParser m ()
 defaultcommoditydirectivep = do
   char 'D' <?> "default commodity"
   lift (skipSome spacenonewline)
-  pos <- getPosition
+  off <- getOffset
   Amount{acommodity,astyle} <- amountp
   lift restofline
   if asdecimalpoint astyle == Nothing
-  then customFailure $ parseErrorAt pos pleaseincludedecimalpoint
+  then customFailure $ parseErrorAt off pleaseincludedecimalpoint
   else setDefaultCommodityAndStyle (acommodity, astyle)
 
 marketpricedirectivep :: JournalParser m MarketPrice
@@ -471,12 +472,12 @@ periodictransactionp = do
   char '~' <?> "periodic transaction"
   lift $ skipMany spacenonewline
   -- a period expression
-  pos <- getPosition
+  off <- getOffset
   d <- liftIO getCurrentDay
   (periodtxt, (interval, span)) <- lift $ first T.strip <$> match (periodexprp d)
   -- In periodic transactions, the period expression has an additional constraint:
   case checkPeriodicTransactionStartDate interval span periodtxt of
-    Just e -> customFailure $ parseErrorAt pos e
+    Just e -> customFailure $ parseErrorAt off e
     Nothing -> pure ()
   -- The line can end here, or it can continue with one or more spaces
   -- and then zero or more of the following fields. A bit awkward.
@@ -511,7 +512,7 @@ periodictransactionp = do
 transactionp :: JournalParser m Transaction
 transactionp = do
   -- dbgparse 0 "transactionp"
-  startpos <- getPosition
+  startpos <- getSourcePos
   date <- datep <?> "transaction"
   edate <- optional (lift $ secondarydatep date) <?> "secondary date"
   lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline"
@@ -521,7 +522,7 @@ transactionp = do
   (comment, tags) <- lift transactioncommentp
   let year = first3 $ toGregorian date
   postings <- postingsp (Just year)
-  endpos <- getPosition
+  endpos <- getSourcePos
   let sourcepos = journalSourcePos startpos endpos
   return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings ""
 
@@ -589,8 +590,9 @@ tests_JournalReader = tests "JournalReader" [
     test "YYYY.MM.DD" $ expectParse datep "2018.01.01"
     test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown"
     test "yearless date with default year" $ do 
-      ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep "1/1"
-      either (fail.("parse error at "++).parseErrorPretty) (const ok) ep
+      let s = "1/1"
+      ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s
+      either (fail.("parse error at "++).customErrorBundlePretty) (const ok) ep
     test "no leading zero" $ expectParse datep "2018/1/1"
 
   ,test "datetimep" $ do
diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs
index 597c2648d..e997b59ec 100644
--- a/hledger-lib/Hledger/Read/TimeclockReader.hs
+++ b/hledger-lib/Hledger/Read/TimeclockReader.hs
@@ -58,7 +58,6 @@ import           Data.Maybe (fromMaybe)
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Text.Megaparsec hiding (parse)
-import           Text.Megaparsec.Char
 
 import           Hledger.Data
 -- XXX too much reuse ?
@@ -105,7 +104,7 @@ timeclockfilep = do many timeclockitemp
 -- | Parse a timeclock entry.
 timeclockentryp :: JournalParser m TimeclockEntry
 timeclockentryp = do
-  sourcepos <- genericSourcePos <$> lift getPosition
+  sourcepos <- genericSourcePos <$> lift getSourcePos
   code <- oneOf ("bhioO" :: [Char])
   lift (skipSome spacenonewline)
   datetime <- datetimep
diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs
index aca5776e6..2eafd0902 100644
--- a/hledger-lib/Hledger/Read/TimedotReader.hs
+++ b/hledger-lib/Hledger/Read/TimedotReader.hs
@@ -104,7 +104,7 @@ timedotdayp = do
 timedotentryp :: JournalParser m Transaction
 timedotentryp = do
   traceParse "  timedotentryp"
-  pos <- genericSourcePos <$> getPosition
+  pos <- genericSourcePos <$> getSourcePos
   lift (skipMany spacenonewline)
   a <- modifiedaccountnamep
   lift (skipMany spacenonewline)
diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs
index 271060386..17687b838 100644
--- a/hledger-lib/Hledger/Reports/ReportOptions.hs
+++ b/hledger-lib/Hledger/Reports/ReportOptions.hs
@@ -48,7 +48,7 @@ import Data.Default
 import Safe
 import System.Console.ANSI (hSupportsANSI)
 import System.IO (stdout)
-import Text.Megaparsec.Error
+import Text.Megaparsec.Custom
 
 import Hledger.Data
 import Hledger.Query
@@ -240,11 +240,11 @@ beginDatesFromRawOpts d = catMaybes . map (begindatefromrawopt d)
   where
     begindatefromrawopt d (n,v)
       | n == "begin" =
-          either (\e -> usageError $ "could not parse "++n++" date: "++parseErrorPretty e) Just $
+          either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $
           fixSmartDateStrEither' d (T.pack v)
       | n == "period" =
         case
-          either (\e -> usageError $ "could not parse period option: "++parseErrorPretty e) id $
+          either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $
           parsePeriodExpr d (stripquotes $ T.pack v)
         of
           (_, DateSpan (Just b) _) -> Just b
@@ -258,11 +258,11 @@ endDatesFromRawOpts d = catMaybes . map (enddatefromrawopt d)
   where
     enddatefromrawopt d (n,v)
       | n == "end" =
-          either (\e -> usageError $ "could not parse "++n++" date: "++parseErrorPretty e) Just $
+          either (\e -> usageError $ "could not parse "++n++" date: "++customErrorBundlePretty e) Just $
           fixSmartDateStrEither' d (T.pack v)
       | n == "period" =
         case
-          either (\e -> usageError $ "could not parse period option: "++parseErrorPretty e) id $
+          either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) id $
           parsePeriodExpr d (stripquotes $ T.pack v)
         of
           (_, DateSpan _ (Just e)) -> Just e
@@ -276,7 +276,7 @@ intervalFromRawOpts = lastDef NoInterval . catMaybes . map intervalfromrawopt
   where
     intervalfromrawopt (n,v)
       | n == "period" =
-          either (\e -> usageError $ "could not parse period option: "++parseErrorPretty e) (Just . fst) $
+          either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) (Just . fst) $
           parsePeriodExpr nulldate (stripquotes $ T.pack v) -- reference date does not affect the interval
       | n == "daily"     = Just $ Days 1
       | n == "weekly"    = Just $ Weeks 1
diff --git a/hledger-lib/Hledger/Utils/Debug.hs b/hledger-lib/Hledger/Utils/Debug.hs
index 567a3db27..055282dfc 100644
--- a/hledger-lib/Hledger/Utils/Debug.hs
+++ b/hledger-lib/Hledger/Utils/Debug.hs
@@ -225,7 +225,7 @@ plogAt lvl
 -- (position and next input) to the console. (See also megaparsec's dbg.)
 traceParse :: String -> TextParser m ()
 traceParse msg = do
-  pos <- getPosition
+  pos <- getSourcePos
   next <- (T.take peeklength) `fmap` getInput
   let (l,c) = (sourceLine pos, sourceColumn pos)
       s  = printf "at line %2d col %2d: %s" (unPos l) (unPos c) (show next) :: String
diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs
index eb723ef6d..3a7c0bbae 100644
--- a/hledger-lib/Hledger/Utils/Parse.hs
+++ b/hledger-lib/Hledger/Utils/Parse.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Hledger.Utils.Parse (
@@ -72,15 +73,21 @@ choiceInState = choice . map try
 surroundedBy :: Applicative m => m openclose -> m a -> m a
 surroundedBy p = between p p
 
-parsewith :: Parsec e Text a -> Text -> Either (ParseError Char e) a
+parsewith :: Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
 parsewith p = runParser p ""
 
-parsewithString :: Parsec e String a -> String -> Either (ParseError Char e) a
+parsewithString
+  :: Parsec e String a -> String -> Either (ParseErrorBundle String e) a
 parsewithString p = runParser p ""
 
 -- | Run a stateful parser with some initial state on a text.
 -- See also: runTextParser, runJournalParser.
-parseWithState :: Monad m => st -> StateT st (ParsecT CustomErr Text m) a -> Text -> m (Either (ParseError Char CustomErr) a)
+parseWithState
+  :: Monad m
+  => st
+  -> StateT st (ParsecT CustomErr Text m) a
+  -> Text
+  -> m (Either (ParseErrorBundle Text CustomErr) a)
 parseWithState ctx p s = runParserT (evalStateT p ctx) "" s
 
 parseWithState'
@@ -88,19 +95,23 @@ parseWithState'
   => st
   -> StateT st (ParsecT e s Identity) a
   -> s
-  -> (Either (ParseError (Token s) e) a)
+  -> (Either (ParseErrorBundle s e) a)
 parseWithState' ctx p s = runParser (evalStateT p ctx) "" s
 
-fromparse :: (Show t, Show e) => Either (ParseError t e) a -> a
+fromparse
+  :: (Show t, Show (Token t), Show e) => Either (ParseErrorBundle t e) a -> a
 fromparse = either parseerror id
 
-parseerror :: (Show t, Show e) => ParseError t e -> a
+parseerror :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> a
 parseerror e = error' $ showParseError e
 
-showParseError :: (Show t, Show e) => ParseError t e -> String
+showParseError
+  :: (Show t, Show (Token t), Show e)
+  => ParseErrorBundle t e -> String
 showParseError e = "parse error at " ++ show e
 
-showDateParseError :: (Show t, Show e) => ParseError t e -> String
+showDateParseError
+  :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> String
 showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e)
 
 nonspace :: TextParser m Char
@@ -113,7 +124,7 @@ spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char
 spacenonewline = satisfy isNonNewlineSpace
 
 restofline :: TextParser m String
-restofline = anyChar `manyTill` newline
+restofline = anySingle `manyTill` newline
 
 eolof :: TextParser m ()
 eolof = (newline >> return ()) <|> eof
diff --git a/hledger-lib/Hledger/Utils/Test.hs b/hledger-lib/Hledger/Utils/Test.hs
index c382cd311..98f939b79 100644
--- a/hledger-lib/Hledger/Utils/Test.hs
+++ b/hledger-lib/Hledger/Utils/Test.hs
@@ -112,7 +112,9 @@ expectParse :: (Monoid st, Eq a, Show a, HasCallStack) =>
   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test ()
 expectParse parser input = do
   ep <- E.io (runParserT (evalStateT (parser <* eof) mempty) "" input)
-  either (fail.(++"\n").("\nparse error at "++).parseErrorPretty) (const ok) ep
+  either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty)
+         (const ok)
+         ep
 
 -- Suitable for hledger's ErroringJournalParser parsers.
 expectParseE
@@ -126,11 +128,12 @@ expectParseE parser input = do
            runParserT (evalStateT (parser <* eof) mempty) filepath input
   case eep of
     Left finalErr ->
-      let prettyErr = finalParseErrorPretty $ attachSource filepath input finalErr
+      let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
       in  fail $ "parse error at " <> prettyErr
-    Right ep -> either (fail.(++"\n").("\nparse error at "++).parseErrorPretty)
-                       (const ok)
-                       ep
+    Right ep ->
+      either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty)
+             (const ok)
+             ep
 
 -- | Test that this stateful parser runnable in IO fails to parse 
 -- the given input text, with a parse error containing the given string. 
@@ -141,7 +144,7 @@ expectParseError parser input errstr = do
   case ep of
     Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
     Left e  -> do
-      let e' = parseErrorPretty e
+      let e' = customErrorBundlePretty e
       if errstr `isInfixOf` e'
       then ok
       else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
@@ -157,14 +160,14 @@ expectParseErrorE parser input errstr = do
   eep <- E.io $ runExceptT $ runParserT (evalStateT parser mempty) filepath input
   case eep of
     Left finalErr -> do
-      let prettyErr = finalParseErrorPretty $ attachSource filepath input finalErr
+      let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
       if errstr `isInfixOf` prettyErr
       then ok
       else fail $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n"
     Right ep -> case ep of
       Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
       Left e  -> do
-        let e' = parseErrorPretty e
+        let e' = customErrorBundlePretty e
         if errstr `isInfixOf` e'
         then ok
         else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
@@ -189,7 +192,9 @@ expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) =>
   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> E.Test ()
 expectParseEqOn parser input f expected = do
   ep <- E.io $ runParserT (evalStateT (parser <* eof) mempty) "" input
-  either (fail . (++"\n") . ("\nparse error at "++) . parseErrorPretty) (expectEqPP expected . f) ep
+  either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
+         (expectEqPP expected . f)
+         ep
 
 expectParseEqOnE
   :: (Monoid st, Eq b, Show b, HasCallStack)
@@ -204,10 +209,10 @@ expectParseEqOnE parser input f expected = do
            runParserT (evalStateT (parser <* eof) mempty) filepath input
   case eep of
     Left finalErr ->
-      let prettyErr = finalParseErrorPretty $ attachSource filepath input finalErr
+      let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
       in  fail $ "parse error at " <> prettyErr
     Right ep ->
-      either (fail . (++"\n") . ("\nparse error at "++) . parseErrorPretty)
+      either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
              (expectEqPP expected . f)
              ep
 
diff --git a/hledger-lib/Text/Megaparsec/Custom.hs b/hledger-lib/Text/Megaparsec/Custom.hs
index 6fd034cbc..53993390d 100644
--- a/hledger-lib/Text/Megaparsec/Custom.hs
+++ b/hledger-lib/Text/Megaparsec/Custom.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PackageImports #-}
@@ -14,7 +13,7 @@ module Text.Megaparsec.Custom (
   parseErrorAtRegion,
 
   -- * Pretty-printing custom parse errors
-  customParseErrorPretty,
+  customErrorBundlePretty,
 
 
   -- * Final parse error types
@@ -24,7 +23,7 @@ module Text.Megaparsec.Custom (
   FinalParseErrorBundle',
 
   -- * Constructing final parse errors
-  errorFinal,
+  finalError,
   finalFancyFailure,
   finalFail,
   finalCustomFailure,
@@ -34,7 +33,7 @@ module Text.Megaparsec.Custom (
   attachSource,
 
   -- * Pretty-printing final parse errors
-  finalParseErrorPretty,
+  finalErrorBundlePretty,
 )
 where
 
@@ -45,10 +44,8 @@ import Control.Monad.Except
 import Control.Monad.State.Strict (StateT, evalStateT)
 import Data.Foldable (asum, toList)
 import qualified Data.List.NonEmpty as NE
-import Data.Proxy (Proxy (Proxy))
 import qualified Data.Set as S
 import Data.Text (Text)
-import Data.Void (Void)
 import Text.Megaparsec
 
 
@@ -60,8 +57,8 @@ import Text.Megaparsec
 data CustomErr
   -- | Fail with a message at a specific source position interval. The
   -- interval must be contained within a single line.
-  = ErrorFailAt SourcePos -- Starting position
-                Pos -- Ending position (column; same line as start)
+  = ErrorFailAt Int -- Starting offset
+                Int -- Ending offset
                 String -- Error message
   deriving (Show, Eq, Ord)
 
@@ -70,62 +67,68 @@ data CustomErr
 -- derive it, but this requires an (orphan) instance for 'ParseError'.
 -- Hopefully this does not cause any trouble.
 
-deriving instance (Ord c, Ord e) => Ord (ParseError c e)
+deriving instance (Eq (Token c), Ord (Token c), Ord c, Ord e) => Ord (ParseError c e)
 
 instance ShowErrorComponent CustomErr where
   showErrorComponent (ErrorFailAt _ _ errMsg) = errMsg
+  errorComponentLen (ErrorFailAt startOffset endOffset _) =
+    endOffset - startOffset
 
 
 --- * Constructing custom parse errors
 
--- | Fail at a specific source position.
+-- | Fail at a specific source position, given by the raw offset from the
+-- start of the input stream (the number of tokens processed at that
+-- point).
 
-parseErrorAt :: SourcePos -> String -> CustomErr
-parseErrorAt pos msg = ErrorFailAt pos (sourceColumn pos) msg
+parseErrorAt :: Int -> String -> CustomErr
+parseErrorAt offset msg = ErrorFailAt offset (offset+1) msg
 
--- | Fail at a specific source interval (within a single line). The
--- interval is inclusive on the left and exclusive on the right; that is,
--- it spans from the start position to just before (and not including) the
--- end position.
+-- | Fail at a specific source interval, given by the raw offsets of its
+-- endpoints from the start of the input stream (the numbers of tokens
+-- processed at those points).
+--
+-- Note that care must be taken to ensure that the specified interval does
+-- not span multiple lines of the input source, as this will not be
+-- checked.
 
 parseErrorAtRegion
-  :: SourcePos -- ^ Start position
-  -> SourcePos -- ^ End position
-  -> String    -- ^ Error message
+  :: Int    -- ^ Start offset
+  -> Int    -- ^ End end offset
+  -> String -- ^ Error message
   -> CustomErr
-parseErrorAtRegion startPos endPos msg =
-  let startCol = sourceColumn startPos
-      endCol' = mkPos $ subtract 1 $ unPos $ sourceColumn endPos
-      endCol = if startCol <= endCol'
-                    && sourceLine startPos == sourceLine endPos
-               then endCol' else startCol
-  in  ErrorFailAt startPos endCol msg
+parseErrorAtRegion startOffset endOffset msg =
+  if startOffset < endOffset
+    then ErrorFailAt startOffset endOffset msg
+    else ErrorFailAt startOffset (startOffset+1) msg
 
 
 --- * Pretty-printing custom parse errors
 
 -- | Pretty-print our custom parse errors and display the line on which
--- the parse error occured. Use this instead of 'parseErrorPretty'.
+-- the parse error occured.
 --
--- If any custom errors are present, arbitrarily take the first one (since
--- only one custom error should be used at a time).
+-- Use this instead of 'errorBundlePretty' when custom parse errors are
+-- thrown, otherwise the continuous highlighting in the pretty-printed
+-- parse error will be displaced from its proper position.
 
-customParseErrorPretty :: Text -> ParseError Char CustomErr -> String
-customParseErrorPretty source err = case findCustomError err of
-  Nothing -> customParseErrorPretty' source err pos1
-
-  Just (ErrorFailAt sourcePos col errMsg) ->
-    let newPositionStack = sourcePos NE.:| NE.tail (errorPos err)
-        errorIntervalLength = mkPos $ max 1 $
-          unPos col - unPos (sourceColumn sourcePos) + 1
-
-        newErr :: ParseError Char Void
-        newErr = FancyError newPositionStack (S.singleton (ErrorFail errMsg))
-
-    in  customParseErrorPretty' source newErr errorIntervalLength
+customErrorBundlePretty :: ParseErrorBundle Text CustomErr -> String
+customErrorBundlePretty errBundle =
+  let errBundle' = errBundle
+        { bundleErrors = fmap setCustomErrorOffset $ bundleErrors errBundle }
+  in  errorBundlePretty errBundle'
 
   where
-    findCustomError :: ParseError Char CustomErr -> Maybe CustomErr
+    setCustomErrorOffset
+      :: ParseError Text CustomErr -> ParseError Text CustomErr
+    setCustomErrorOffset err = case findCustomError err of
+      Nothing -> err
+      Just errFailAt@(ErrorFailAt startOffset _ _) ->
+        FancyError startOffset $ S.singleton $ ErrorCustom errFailAt
+
+    -- If any custom errors are present, arbitrarily take the first one
+    -- (since only one custom error should be used at a time).
+    findCustomError :: ParseError Text CustomErr -> Maybe CustomErr
     findCustomError err = case err of
       FancyError _ errSet -> 
         finds (\case {ErrorCustom e -> Just e; _ -> Nothing}) errSet
@@ -139,23 +142,26 @@ customParseErrorPretty source err = case findCustomError err of
 
 -- | 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.
+-- '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 a parse error, we must bundle it with the
--- source text and its filepaths (the 'ErrorBundle' constructor). However,
--- when an 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 the source text and its filepath by the parser's caller
--- (the 'ErrorFinal' constructor).
+-- In order to pretty-print our custom parse errors, we must bundle them
+-- with their full source text and filepaths (the 'FinalBundleWithStack'
+-- constructor). However, when an error is thrown from within a parser, we
+-- do not have access to the full source, so we must hold the parse error
+-- (the 'FinalError' constructor) until it can be joined with the source
+-- text and its filepath by the parser's caller.
 
 data FinalParseError' e
-  = ErrorFinal  (ParseError Char e)
-  | ErrorBundle (FinalParseErrorBundle' e)
+  = FinalError           (ParseError Text e)
+  | FinalBundle          (ParseErrorBundle Text e)
+  | FinalBundleWithStack (FinalParseErrorBundle' e)
   deriving (Show)
 
 type FinalParseError = FinalParseError' CustomErr
 
--- A 'Monoid' instance is necessary for 'ExceptT (FinalParseError'' e)' to
+-- A 'Monoid' instance is necessary for 'ExceptT (FinalParseError' e)' to
 -- be an instance of Alternative and MonadPlus, which are required for the
 -- use of e.g. the 'many' parser combinator. This monoid instance simply
 -- takes the first (left-most) error.
@@ -164,22 +170,16 @@ instance Semigroup (FinalParseError' e) where
   e <> _ = e
 
 instance Monoid (FinalParseError' e) where
-  mempty = ErrorFinal $
-    FancyError (initialPos "" NE.:| [])
-               (S.singleton (ErrorFail "default parse error"))
+  mempty = FinalError $ FancyError 0 $
+            S.singleton (ErrorFail "default parse error")
   mappend = (<>)
 
--- | A type bundling a 'ParseError' with its source file and a stack of
--- include file paths (for pretty printing). Although Megaparsec 6
--- maintains a stack of source files, making a field of this type
--- redundant, this capability will be removed in Megaparsec 7. Therefore,
--- we implement stacks of source files here for a smoother transition in
--- the future.
+-- | A type bundling a 'ParseError' with its full source file and a stack
+-- of include file paths (for pretty printing).
 
 data FinalParseErrorBundle' e = FinalParseErrorBundle'
-  { finalParseError :: ParseError Char e
-  , errorSource     :: Text
-  , sourceFileStack :: NE.NonEmpty FilePath
+  { finalErrorBundle :: ParseErrorBundle Text e
+  , sourceFileStack  :: NE.NonEmpty FilePath
   } deriving (Show)
 
 type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr
@@ -189,8 +189,8 @@ type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr
 
 -- | Convert a "regular" parse error into a "final" parse error.
 
-errorFinal :: ParseError Char e -> FinalParseError' e
-errorFinal = ErrorFinal
+finalError :: ParseError Text e -> FinalParseError' e
+finalError = FinalError
 
 -- | Like 'fancyFailure', but as a "final" parse error.
 
@@ -198,9 +198,8 @@ finalFancyFailure
   :: (MonadParsec e s m, MonadError (FinalParseError' e) m)
   => S.Set (ErrorFancy e) -> m a
 finalFancyFailure errSet = do
-  pos <- getPosition
-  let parseErr = FancyError (pos NE.:| []) errSet
-  throwError $ ErrorFinal parseErr
+  offset <- getOffset
+  throwError $ FinalError $ FancyError offset errSet
 
 -- | Like 'fail', but as a "final" parse error.
 
@@ -235,24 +234,30 @@ parseIncludeFile parser initState filepath text =
       eResult <- lift $ lift $
                   runParserT (evalStateT parser initState) filepath text
       case eResult of
-        Left parseError -> throwError $ errorFinal parseError
+        Left parseErrorBundle -> throwError $ FinalBundle parseErrorBundle
         Right result -> pure result
 
-    handler e = throwError $ ErrorBundle $ attachSource filepath text e
+    handler e = throwError $ FinalBundleWithStack $ attachSource filepath text e
 
 
 attachSource
   :: FilePath -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
-attachSource filePath sourceText finalParseError =
-  case finalParseError of
-    ErrorFinal parseError -> FinalParseErrorBundle'
-      { finalParseError = parseError
-      , errorSource     = sourceText
-      , sourceFileStack = filePath NE.:| []
-      }
-    ErrorBundle bundle -> bundle
-      { sourceFileStack = filePath NE.<| sourceFileStack bundle
-      }
+attachSource filePath sourceText finalParseError = case finalParseError of
+
+    FinalError parseError ->
+      let bundle = ParseErrorBundle
+            { bundleErrors = parseError NE.:| []
+            , bundlePosState = initialPosState filePath sourceText }
+      in  FinalParseErrorBundle'
+            { finalErrorBundle = bundle
+            , sourceFileStack  = filePath NE.:| [] }
+
+    FinalBundle peBundle -> FinalParseErrorBundle'
+      { finalErrorBundle = peBundle
+      , sourceFileStack  = filePath NE.:| [] }
+
+    FinalBundleWithStack fpeBundle -> fpeBundle
+      { sourceFileStack = filePath NE.<| sourceFileStack fpeBundle }
 
 
 --- * Pretty-printing final parse errors
@@ -260,125 +265,23 @@ attachSource filePath sourceText finalParseError =
 -- | Pretty-print a "final" parse error: print the stack of include files,
 -- then apply the pretty-printer for custom parse errors.
 
-finalParseErrorPretty :: FinalParseErrorBundle' CustomErr -> String
-finalParseErrorPretty bundle =
+finalErrorBundlePretty :: FinalParseErrorBundle' CustomErr -> String
+finalErrorBundlePretty bundle =
      concatMap printIncludeFile (NE.init (sourceFileStack bundle))
-  <> customParseErrorPretty (errorSource bundle) (finalParseError bundle)
+  <> customErrorBundlePretty (finalErrorBundle bundle)
   where
     printIncludeFile path = "in file included from " <> path <> ",\n"
 
 
---- * Modified Megaparsec source
+--- * Helpers
 
--- The below code has been copied from Megaparsec (v.6.4.1,
--- Text.Megaparsec.Error) and modified to suit our needs. These changes are
--- indicated by square brackets. The following copyright notice, conditions,
--- and disclaimer apply to all code below this point.
---
--- Copyright © 2015–2018 Megaparsec contributors<br>
--- Copyright © 2007 Paolo Martini<br>
--- Copyright © 1999–2000 Daan Leijen
---
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are met:
---
--- * Redistributions of source code must retain the above copyright notice,
---   this list of conditions and the following disclaimer.
---
--- * Redistributions in binary form must reproduce the above copyright notice,
---   this list of conditions and the following disclaimer in the documentation
---   and/or other materials provided with the distribution.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS
--- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
--- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
--- NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
--- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
--- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
--- OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
--- EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
--- | Pretty-print a 'ParseError Char CustomErr' and display the line on
--- which the parse error occurred. The rendered 'String' always ends with
--- a newline.
-
-customParseErrorPretty'
-  :: ( ShowToken (Token s)
-     , LineToken (Token s)
-     , ShowErrorComponent e
-     , Stream s )
-  => s                 -- ^ Original input stream
-  -> ParseError (Token s) e -- ^ Parse error to render
-  -> Pos               -- ^ Length of error interval [added]
-  -> String            -- ^ Result of rendering
-customParseErrorPretty' = customParseErrorPretty_ defaultTabWidth
-
-
-customParseErrorPretty_
-  :: forall s e.
-     ( ShowToken (Token s)
-     , LineToken (Token s)
-     , ShowErrorComponent e
-     , Stream s )
-  => Pos               -- ^ Tab width
-  -> s                 -- ^ Original input stream
-  -> ParseError (Token s) e -- ^ Parse error to render
-  -> Pos               -- ^ Length of error interval [added]
-  -> String            -- ^ Result of rendering
-customParseErrorPretty_ w s e l =
-  sourcePosStackPretty (errorPos e) <> ":\n" <>
-    padding <> "|\n" <>
-    lineNumber <> " | " <> rline <> "\n" <>
-    padding <> "| " <> rpadding <> highlight <> "\n" <> -- [added `highlight`]
-    parseErrorTextPretty e
-  where
-    epos       = NE.head (errorPos e) -- [changed from NE.last to NE.head]
-    lineNumber = (show . unPos . sourceLine) epos
-    padding    = replicate (length lineNumber + 1) ' '
-    rpadding   = replicate (unPos (sourceColumn epos) - 1) ' '
-    highlight  = replicate (unPos l) '^' -- [added]
-    rline      =
-      case rline' of
-        [] -> "<empty line>"
-        xs -> expandTab w xs
-    rline'     = fmap tokenAsChar . chunkToTokens (Proxy :: Proxy s) $
-      selectLine (sourceLine epos) s
-
--- | Select a line from input stream given its number.
-
-selectLine
-  :: forall s. (LineToken (Token s), Stream s)
-  => Pos               -- ^ Number of line to select
-  -> s                 -- ^ Input stream
-  -> Tokens s          -- ^ Selected line
-selectLine l = go pos1
-  where
-    go !n !s =
-      if n == l
-        then fst (takeWhile_ notNewline s)
-        else go (n <> pos1) (stripNewline $ snd (takeWhile_ notNewline s))
-    notNewline = not . tokenIsNewline
-    stripNewline s =
-      case take1_ s of
-        Nothing -> s
-        Just (_, s') -> s'
-
--- | Replace tab characters with given number of spaces.
-
-expandTab
-  :: Pos
-  -> String
-  -> String
-expandTab w' = go 0
-  where
-    go 0 []        = []
-    go 0 ('\t':xs) = go w xs
-    go 0 (x:xs)    = x : go 0 xs
-    go !n xs       = ' ' : go (n - 1) xs
-    w              = unPos w'
+-- The "tab width" and "line prefix" are taken from the defaults defined
+-- in 'initialState'.
 
+initialPosState :: FilePath -> Text -> PosState Text
+initialPosState filePath sourceText = PosState
+  { pstateInput      = sourceText
+  , pstateOffset     = 0
+  , pstateSourcePos  = initialPos filePath
+  , pstateTabWidth   = defaultTabWidth
+  , pstateLinePrefix = "" }
diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal
index 921d64418..279523bbb 100644
--- a/hledger-lib/hledger-lib.cabal
+++ b/hledger-lib/hledger-lib.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 5d69eead3be5d0a10a8e272a4bdf63ba320e9e6914fae3d6031538bd8bd6206d
+-- hash: 54632c4329f85aa921fb91abbed9c0871465e0cfb4cdfa05a390447c6d796b83
 
 name:           hledger-lib
 version:        1.10.99
@@ -122,7 +122,7 @@ library
     , extra
     , filepath
     , hashtables >=1.2.3.1
-    , megaparsec >=6.4.1 && <7
+    , megaparsec >=6.4.1
     , mtl
     , mtl-compat
     , old-time
@@ -222,7 +222,7 @@ test-suite doctests
     , extra
     , filepath
     , hashtables >=1.2.3.1
-    , megaparsec >=6.4.1 && <7
+    , megaparsec >=6.4.1
     , mtl
     , mtl-compat
     , old-time
@@ -322,7 +322,7 @@ test-suite easytests
     , filepath
     , hashtables >=1.2.3.1
     , hledger-lib
-    , megaparsec >=6.4.1 && <7
+    , megaparsec >=6.4.1
     , mtl
     , mtl-compat
     , old-time
diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml
index aa9a36a09..27f24573b 100644
--- a/hledger-lib/package.yaml
+++ b/hledger-lib/package.yaml
@@ -57,7 +57,7 @@ dependencies:
 - easytest
 - filepath
 - hashtables >=1.2.3.1
-- megaparsec >=6.4.1 && < 7
+- megaparsec >=6.4.1
 - mtl
 - mtl-compat
 - old-time
diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs
index ec04ca0de..5ca55eb3f 100644
--- a/hledger-ui/Hledger/UI/ErrorScreen.hs
+++ b/hledger-ui/Hledger/UI/ErrorScreen.hs
@@ -112,8 +112,8 @@ esHandle _ _ = error "event handler called with wrong screen type, should not ha
 -- Temporary, we should keep the original parse error location. XXX
 hledgerparseerrorpositionp :: ParsecT Void String t (String, Int, Int)
 hledgerparseerrorpositionp = do
-  anyChar `manyTill` char '"'
-  f <- anyChar `manyTill` (oneOf ['"','\n'])
+  anySingle `manyTill` char '"'
+  f <- anySingle `manyTill` (oneOf ['"','\n'])
   string " (line "
   l <- read <$> some digitChar
   string ", column "
diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal
index f83db7047..fd8d94165 100644
--- a/hledger-ui/hledger-ui.cabal
+++ b/hledger-ui/hledger-ui.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: fc23afcaa9a76cad46878b6bc6d6f9f6bb3f59623438031956b1d8cdb9315c17
+-- hash: 88116009cafa64bb3351a332b88f9848d895f7bc4e614a8647f9c26c6405ba35
 
 name:           hledger-ui
 version:        1.10.99
@@ -77,7 +77,7 @@ executable hledger-ui
     , fsnotify >=0.2.1.2 && <0.4
     , hledger >=1.10.99 && <1.11
     , hledger-lib >=1.10.99 && <1.11
-    , megaparsec >=6.4.1 && <7
+    , megaparsec >=6.4.1
     , microlens >=0.4
     , microlens-platform >=0.2.3.1
     , pretty-show >=1.6.4
diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml
index ac79b2667..c3b125f63 100644
--- a/hledger-ui/package.yaml
+++ b/hledger-ui/package.yaml
@@ -54,7 +54,7 @@ dependencies:
 - fsnotify >=0.2.1.2 && <0.4
 - microlens >=0.4
 - microlens-platform >=0.2.3.1
-- megaparsec >=6.4.1 && < 7
+- megaparsec >=6.4.1
 - pretty-show >=1.6.4
 - process >=1.2
 - safe >=0.2
diff --git a/hledger-web/Hledger/Web/Widget/AddForm.hs b/hledger-web/Hledger/Web/Widget/AddForm.hs
index c66d2767e..47e85f070 100644
--- a/hledger-web/Hledger/Web/Widget/AddForm.hs
+++ b/hledger-web/Hledger/Web/Widget/AddForm.hs
@@ -21,7 +21,7 @@ import qualified Data.Text as T
 import Data.Time (Day)
 import Text.Blaze.Internal (Markup, preEscapedString)
 import Text.JSON
-import Text.Megaparsec (eof, parseErrorPretty, runParser)
+import Text.Megaparsec (eof, errorBundlePretty, runParser)
 import Yesod
 
 import Hledger
@@ -131,7 +131,7 @@ validatePostings a b =
     catPostings (t, t', Left (e, e')) xs = (t, t', e, e') : xs
     catPostings (t, t', Right _) xs = (t, t', Nothing, Nothing) : xs
 
-    errorToFormMsg = first (("Invalid value: " <>) . T.pack . parseErrorPretty)
+    errorToFormMsg = first (("Invalid value: " <>) . T.pack . errorBundlePretty)
     validateAccount = errorToFormMsg . runParser (accountnamep <* eof) "" . T.strip
     validateAmount = errorToFormMsg . runParser (evalStateT (amountp <* eof) mempty) "" . T.strip
 
diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal
index 2c5b97f0a..6100b055a 100644
--- a/hledger-web/hledger-web.cabal
+++ b/hledger-web/hledger-web.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: f7bbdd2a2c0bf60f14a1c2d1538414933ed62708598213563167d021baba748b
+-- hash: b77366b5a138b9d5a3b4c4541bfb875642f06b621bd690712d022f53ab1afbf6
 
 name:           hledger-web
 version:        1.10.99
@@ -169,7 +169,7 @@ library
     , http-client
     , http-conduit
     , json
-    , megaparsec >=6.4.1 && <7
+    , megaparsec >=6.4.1
     , mtl
     , semigroups
     , shakespeare >=2.0.2.2
diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml
index 6edd856f5..e8200ab86 100644
--- a/hledger-web/package.yaml
+++ b/hledger-web/package.yaml
@@ -114,7 +114,7 @@ library:
   - http-conduit
   - http-client
   - json
-  - megaparsec >=6.4.1 && < 7
+  - megaparsec >=6.4.1
   - mtl
   - semigroups
   - shakespeare >=2.0.2.2
diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs
index 1182f2aae..032010625 100644
--- a/hledger/Hledger/Cli/Commands/Add.hs
+++ b/hledger/Hledger/Cli/Commands/Add.hs
@@ -296,7 +296,7 @@ amountAndCommentWizard EntryState{..} = do
       amountandcommentp = do
         a <- amountp
         lift (skipMany spacenonewline)
-        c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anyChar)
+        c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle)
         -- eof
         return (a,c)
       balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings
diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs
index 5234bc462..893436b2a 100755
--- a/hledger/Hledger/Cli/Commands/Rewrite.hs
+++ b/hledger/Hledger/Cli/Commands/Rewrite.hs
@@ -193,7 +193,7 @@ transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} =
   where
     q = T.pack $ query_ ropts
     ps = map (parseposting . stripquotes . T.pack) $ listofstringopt "add-posting" rawopts
-    parseposting t = either (error' . parseErrorPretty' t') id ep 
+    parseposting t = either (error' . errorBundlePretty) id ep
       where
         ep = runIdentity (runJournalParser (postingp Nothing <* eof) t')
         t' = " " <> t <> "\n" -- inject space and newline for proper parsing
diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal
index 1175d08f2..4516ca6aa 100644
--- a/hledger/hledger.cabal
+++ b/hledger/hledger.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 70e6e178ba5d2d6601ebf07e79fdcc19d2480a0544225da23ee3155e928fd85c
+-- hash: eeed47cc18e00b190b0dd220f044f4f63c60442fa26ee301c44454b5f66e09ca
 
 name:           hledger
 version:        1.10.99
@@ -131,7 +131,7 @@ library
     , here
     , hledger-lib >=1.10.99 && <1.11
     , lucid
-    , megaparsec >=6.4.1 && <7
+    , megaparsec >=6.4.1
     , mtl
     , mtl-compat
     , old-time
@@ -182,7 +182,7 @@ executable hledger
     , here
     , hledger
     , hledger-lib >=1.10.99 && <1.11
-    , megaparsec >=6.4.1 && <7
+    , megaparsec >=6.4.1
     , mtl
     , mtl-compat
     , old-time
@@ -236,7 +236,7 @@ test-suite test
     , here
     , hledger
     , hledger-lib >=1.10.99 && <1.11
-    , megaparsec >=6.4.1 && <7
+    , megaparsec >=6.4.1
     , mtl
     , mtl-compat
     , old-time
@@ -291,7 +291,7 @@ benchmark bench
     , hledger
     , hledger-lib >=1.10.99 && <1.11
     , html
-    , megaparsec >=6.4.1 && <7
+    , megaparsec >=6.4.1
     , mtl
     , mtl-compat
     , old-time
diff --git a/hledger/package.yaml b/hledger/package.yaml
index b79cbab8d..d4e4b86aa 100644
--- a/hledger/package.yaml
+++ b/hledger/package.yaml
@@ -93,7 +93,7 @@ dependencies:
 - filepath
 - haskeline >=0.6
 - here
-- megaparsec >=6.4.1 && < 7
+- megaparsec >=6.4.1
 - mtl
 - mtl-compat
 - old-time
diff --git a/stack-ghc7.10.yaml b/stack-ghc7.10.yaml
index 5f2e9c07e..2b6e51fc8 100644
--- a/stack-ghc7.10.yaml
+++ b/stack-ghc7.10.yaml
@@ -26,8 +26,8 @@ extra-deps:
 - base-orphans-0.7
 - bifunctors-5.5.2
 - brick-0.37.1
-- cassava-megaparsec-1.0.0
-- config-ini-0.2.2.0
+- cassava-megaparsec-2.0.0
+- config-ini-0.2.3.0
 - criterion-1.4.1.0
 - data-clist-0.1.2.1
 - directory-1.2.7.0
@@ -43,13 +43,13 @@ extra-deps:
 - integer-logarithms-1.0.2.1
 - kan-extensions-5.1
 - lens-4.16.1
-- megaparsec-6.4.1
+- megaparsec-7.0.1
 - microstache-1.0.1.1
 - mmorph-1.1.2
 - monad-control-1.0.2.3
 - network-2.6.3.5
 - optparse-applicative-0.14.2.0
-- parser-combinators-0.4.0
+- parser-combinators-1.0.0
 - persistent-2.7.0
 - persistent-template-2.5.4
 - profunctors-5.2.2
diff --git a/stack-ghc8.0.yaml b/stack-ghc8.0.yaml
index df616e2e4..d566e2b24 100644
--- a/stack-ghc8.0.yaml
+++ b/stack-ghc8.0.yaml
@@ -20,7 +20,8 @@ extra-deps:
 - base-compat-0.10.1
 - base-compat-batteries-0.10.1
 - bifunctors-5.5.2
-- cassava-megaparsec-1.0.0
+- cassava-megaparsec-2.0.0
+- config-ini-0.2.3.0
 - criterion-1.4.1.0
 - doctest-0.16.0
 - generics-sop-0.3.2.0
@@ -29,11 +30,11 @@ extra-deps:
 - http-types-0.12.1
 - insert-ordered-containers-0.2.1.0
 - lens-4.16.1
-- megaparsec-6.4.1
+- megaparsec-7.0.1
 - microstache-1.0.1.1
 - mmorph-1.1.2
 - network-2.6.3.5
-- parser-combinators-0.4.0
+- parser-combinators-1.0.0
 - persistent-template-2.5.4
 - scientific-0.3.6.2
 - servant-0.13.0.1
diff --git a/stack-ghc8.2.yaml b/stack-ghc8.2.yaml
index a72106c7d..a579ae2e6 100644
--- a/stack-ghc8.2.yaml
+++ b/stack-ghc8.2.yaml
@@ -15,9 +15,12 @@ extra-deps:
 - aeson-1.3.1.1
 - base-compat-0.10.1
 - base-compat-batteries-0.10.1
-- cassava-megaparsec-1.0.0
+- cassava-megaparsec-2.0.0
+- config-ini-0.2.3.0
 - criterion-1.4.1.0
 - doctest-0.16.0
+- megaparsec-7.0.1
+- parser-combinators-1.0.0
 - swagger2-2.2.2
 # avoid no hashable instance for AccountName from doctests
 - hashtables-1.2.3.1
diff --git a/stack.yaml b/stack.yaml
index b5814d9c9..cec70e4b6 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -10,7 +10,9 @@ packages:
 - hledger-api
 
 extra-deps:
-- cassava-megaparsec-1.0.0
+- cassava-megaparsec-2.0.0
+- megaparsec-7.0.1
+- config-ini-0.2.3.0
 
 nix:
   pure: false
diff --git a/tests/journal/parse-errors.test b/tests/journal/parse-errors.test
index 32093fff8..b24347f78 100644
--- a/tests/journal/parse-errors.test
+++ b/tests/journal/parse-errors.test
@@ -12,7 +12,7 @@ hledger: -:1:5:
 1 | 2018
   |     ^
 unexpected newline
-expecting date separator or the rest of year or month
+expecting date separator or digit
 
 >=1
 

From a8d642d5b5bc76e76c21d3ee7a7abd50cd1a70be Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Mon, 8 Oct 2018 21:44:31 -0600
Subject: [PATCH 8/9] lib: revise comments for "final" parse errors

- also simplify their implementation a bit
---
 hledger-lib/Text/Megaparsec/Custom.hs | 175 +++++++++++++++-----------
 1 file changed, 104 insertions(+), 71 deletions(-)

diff --git a/hledger-lib/Text/Megaparsec/Custom.hs b/hledger-lib/Text/Megaparsec/Custom.hs
index 53993390d..c71df3e7a 100644
--- a/hledger-lib/Text/Megaparsec/Custom.hs
+++ b/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
-  parseIncludeFile,
+  -- * Pretty-printing "final" parse errors
+  finalErrorBundlePretty,
   attachSource,
 
-  -- * Pretty-printing final parse errors
-  finalErrorBundlePretty,
+  -- * Handling parse errors from include files with "final" parse errors
+  parseIncludeFile,
 )
 where
 
@@ -138,33 +138,50 @@ customErrorBundlePretty errBundle =
     finds f = asum . map f . toList
 
 
---- * Final parse error types
-
--- | 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.
+--- * "Final" parse errors
 --
--- In order to pretty-print our custom parse errors, we must bundle them
--- with their full source text and filepaths (the 'FinalBundleWithStack'
--- constructor). However, when an error is thrown from within a parser, we
--- do not have access to the full source, so we must hold the parse error
--- (the 'FinalError' constructor) until it can be joined with the source
--- text and its filepath by the parser's caller.
+-- | A type representing "final" parse errors that cannot be backtracked
+-- from and are guaranteed to halt parsing. The anti-backtracking
+-- behaviour is implemented by an 'ExceptT' layer in the parser's monad
+-- stack, using this type as the 'ExceptT' error type.
+--
+-- 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
--- be an instance of Alternative and MonadPlus, which are required for the
--- use of e.g. the 'many' parser combinator. This monoid instance simply
--- takes the first (left-most) error.
+-- We need a 'Monoid' instance for 'FinalParseError' so that 'ExceptT
+-- FinalParseError m' is an instance of Alternative and MonadPlus, which
+-- is needed to use some parser combinators, e.g. 'many'.
+--
+-- 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
--- of include file paths (for pretty printing).
+-- | A type bundling a 'ParseError' with its full source text, filepath,
+-- 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
--- errors when dealing with include files, so we capture the necessary
--- procedure in this function.
+-- | Pretty-print a "final" parse error: print the stack of include files,
+-- then apply the pretty-printer for parse error bundles. Note that
+-- 'attachSource' must be used on a "final" parse error before it can be
+-- pretty-printed.
 
-parseIncludeFile
-  :: forall st m a. Monad m
-  => StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
-  -> st
-  -> FilePath
-  -> Text
-  -> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
-parseIncludeFile parser initState filepath text =
-  catchError parser' handler
+finalErrorBundlePretty :: FinalParseErrorBundle' CustomErr -> String
+finalErrorBundlePretty bundle =
+     concatMap showIncludeFilepath (includeFileStack bundle)
+  <> customErrorBundlePretty (finalErrorBundle bundle)
   where
-    parser' = do
-      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
+    showIncludeFilepath path = "in file included from " <> path <> ",\n"
 
+-- | 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 ->
-      let bundle = ParseErrorBundle
-            { bundleErrors = parseError NE.:| []
-            , bundlePosState = initialPosState filePath sourceText }
-      in  FinalParseErrorBundle'
-            { finalErrorBundle = bundle
-            , sourceFileStack  = filePath NE.:| [] }
+  -- A parse error thrown directly with the 'FinalError' constructor
+  -- requires both source and filepath.
+  FinalError parseError ->
+    let bundle = ParseErrorBundle
+          { bundleErrors = parseError NE.:| []
+          , bundlePosState = initialPosState filePath sourceText }
+    in  FinalParseErrorBundle'
+          { finalErrorBundle = bundle
+          , includeFileStack  = [] }
 
-    FinalBundle peBundle -> FinalParseErrorBundle'
-      { finalErrorBundle = peBundle
-      , sourceFileStack  = filePath NE.:| [] }
+  -- A 'ParseErrorBundle' already has the appropriate source and filepath
+  -- and so needs neither.
+  FinalBundle peBundle -> FinalParseErrorBundle'
+    { finalErrorBundle = peBundle
+    , includeFileStack = [] }
 
-    FinalBundleWithStack fpeBundle -> fpeBundle
-      { sourceFileStack = filePath NE.<| sourceFileStack fpeBundle }
+  -- A parse error from a 'FinalParseErrorBundle' was thrown from an
+  -- 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,
--- then apply the pretty-printer for custom parse errors.
+-- | Parse a file with the given parser and initial state, discarding the
+-- final state and re-throwing any parse errors as "final" parse errors.
 
-finalErrorBundlePretty :: FinalParseErrorBundle' CustomErr -> String
-finalErrorBundlePretty bundle =
-     concatMap printIncludeFile (NE.init (sourceFileStack bundle))
-  <> customErrorBundlePretty (finalErrorBundle bundle)
+parseIncludeFile
+  :: Monad m
+  => StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
+  -> 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
--- in 'initialState'.
+-- Like megaparsec's 'initialState', but instead for 'PosState'. Used when
+-- constructing 'ParseErrorBundle's. The values for "tab width" and "line
+-- prefix" are taken from 'initialState'.
 
 initialPosState :: FilePath -> Text -> PosState Text
 initialPosState filePath sourceText = PosState

From e45070aab597210e901e339c0c7a50b73b2670f9 Mon Sep 17 00:00:00 2001
From: Alex Chen <awchen@ucalgary.ca>
Date: Tue, 9 Oct 2018 11:15:33 -0600
Subject: [PATCH 9/9] Update dependency bounds for megaparsec

---
 hledger-lib/hledger-lib.cabal |  8 ++++----
 hledger-lib/package.yaml      |  2 +-
 hledger-ui/hledger-ui.cabal   |  4 ++--
 hledger-ui/package.yaml       |  2 +-
 hledger-web/hledger-web.cabal |  8 ++++----
 hledger-web/package.yaml      |  2 +-
 hledger/hledger.cabal         | 10 +++++-----
 hledger/package.yaml          |  2 +-
 8 files changed, 19 insertions(+), 19 deletions(-)

diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal
index 645e6b869..59f934a10 100644
--- a/hledger-lib/hledger-lib.cabal
+++ b/hledger-lib/hledger-lib.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: f3cc307bb564ecec4c16143a1d254c4cbbbee1483eb7860c711e3c4c5ed46431
+-- hash: ec4f3b835e224318ad3608ab36126e3e07d3c54075f648eba27476bb51db15f4
 
 name:           hledger-lib
 version:        1.11
@@ -122,7 +122,7 @@ library
     , extra
     , filepath
     , hashtables >=1.2.3.1
-    , megaparsec >=6.4.1
+    , megaparsec >=7.0.0 && <8
     , mtl
     , mtl-compat
     , old-time
@@ -222,7 +222,7 @@ test-suite doctests
     , extra
     , filepath
     , hashtables >=1.2.3.1
-    , megaparsec >=6.4.1
+    , megaparsec >=7.0.0 && <8
     , mtl
     , mtl-compat
     , old-time
@@ -322,7 +322,7 @@ test-suite easytests
     , filepath
     , hashtables >=1.2.3.1
     , hledger-lib
-    , megaparsec >=6.4.1
+    , megaparsec >=7.0.0 && <8
     , mtl
     , mtl-compat
     , old-time
diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml
index c248fe95c..f097fa3a4 100644
--- a/hledger-lib/package.yaml
+++ b/hledger-lib/package.yaml
@@ -57,7 +57,7 @@ dependencies:
 - easytest
 - filepath
 - hashtables >=1.2.3.1
-- megaparsec >=6.4.1
+- megaparsec >=7.0.0 && <8
 - mtl
 - mtl-compat
 - old-time
diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal
index 6886fb391..f8da776cc 100644
--- a/hledger-ui/hledger-ui.cabal
+++ b/hledger-ui/hledger-ui.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d2925ba85674c61c233d118134f8b3cd090ca0900953652b4253755bb8840c9c
+-- hash: 61b73ed221f9d6964b622e7b8ea40259e9c82efd8b28dadc89d6a643ea947b94
 
 name:           hledger-ui
 version:        1.11
@@ -77,7 +77,7 @@ executable hledger-ui
     , fsnotify >=0.2.1.2 && <0.4
     , hledger >=1.11 && <1.12
     , hledger-lib >=1.11 && <1.12
-    , megaparsec >=6.4.1
+    , megaparsec >=7.0.0 && <8
     , microlens >=0.4
     , microlens-platform >=0.2.3.1
     , pretty-show >=1.6.4
diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml
index 5fabaa2be..fb8177576 100644
--- a/hledger-ui/package.yaml
+++ b/hledger-ui/package.yaml
@@ -54,7 +54,7 @@ dependencies:
 - fsnotify >=0.2.1.2 && <0.4
 - microlens >=0.4
 - microlens-platform >=0.2.3.1
-- megaparsec >=6.4.1
+- megaparsec >=7.0.0 && <8
 - pretty-show >=1.6.4
 - process >=1.2
 - safe >=0.2
diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal
index b9be2e317..e92fdb6f1 100644
--- a/hledger-web/hledger-web.cabal
+++ b/hledger-web/hledger-web.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: a990f6fed36d14942e007240e0b37a9ff1147902b74cadc426403828ce3950a6
+-- hash: 60eb9cb226968eed42b507637364f5960aa6b6fb91dff8a46fcbd40295780df6
 
 name:           hledger-web
 version:        1.11
@@ -127,8 +127,6 @@ flag threaded
   default: True
 
 library
-  hs-source-dirs:
-      ./.
   exposed-modules:
       Hledger.Web
       Hledger.Web.Application
@@ -148,6 +146,8 @@ library
       Hledger.Web.Widget.Common
   other-modules:
       Paths_hledger_web
+  hs-source-dirs:
+      ./.
   ghc-options: -Wall -fwarn-tabs
   cpp-options: -DVERSION="1.11"
   build-depends:
@@ -169,7 +169,7 @@ library
     , http-client
     , http-conduit
     , json
-    , megaparsec >=6.4.1
+    , megaparsec >=7.0.0 && <8
     , mtl
     , semigroups
     , shakespeare >=2.0.2.2
diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml
index bf3191e76..8a4939eb6 100644
--- a/hledger-web/package.yaml
+++ b/hledger-web/package.yaml
@@ -114,7 +114,7 @@ library:
   - http-conduit
   - http-client
   - json
-  - megaparsec >=6.4.1
+  - megaparsec >=7.0.0 && <8
   - mtl
   - semigroups
   - shakespeare >=2.0.2.2
diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal
index 56c522943..1234a42bc 100644
--- a/hledger/hledger.cabal
+++ b/hledger/hledger.cabal
@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: a53ed723ef2c43c6425e4bf2d40ae7a37b9816dcdbd49795a7a7972b4b4ca203
+-- hash: e89846e17f78017f83d440cb2fcfe10caba2b0c4c6a61195b4faffcdd2b7a100
 
 name:           hledger
 version:        1.11
@@ -131,7 +131,7 @@ library
     , here
     , hledger-lib >=1.11 && <1.12
     , lucid
-    , megaparsec >=6.4.1
+    , megaparsec >=7.0.0 && <8
     , mtl
     , mtl-compat
     , old-time
@@ -182,7 +182,7 @@ executable hledger
     , here
     , hledger
     , hledger-lib >=1.11 && <1.12
-    , megaparsec >=6.4.1
+    , megaparsec >=7.0.0 && <8
     , mtl
     , mtl-compat
     , old-time
@@ -236,7 +236,7 @@ test-suite test
     , here
     , hledger
     , hledger-lib >=1.11 && <1.12
-    , megaparsec >=6.4.1
+    , megaparsec >=7.0.0 && <8
     , mtl
     , mtl-compat
     , old-time
@@ -291,7 +291,7 @@ benchmark bench
     , hledger
     , hledger-lib >=1.11 && <1.12
     , html
-    , megaparsec >=6.4.1
+    , megaparsec >=7.0.0 && <8
     , mtl
     , mtl-compat
     , old-time
diff --git a/hledger/package.yaml b/hledger/package.yaml
index 186f8a600..c3f2441da 100644
--- a/hledger/package.yaml
+++ b/hledger/package.yaml
@@ -93,7 +93,7 @@ dependencies:
 - filepath
 - haskeline >=0.6
 - here
-- megaparsec >=6.4.1
+- megaparsec >=7.0.0 && <8
 - mtl
 - mtl-compat
 - old-time