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.