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

@@ -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.