;lib: refactor, split out finaliseJournal

hledger-lib/Hledger/Read/Common.hs

@@ -35,6 +35,7 @@ module Hledger.Read.Common (
   journalSourcePos,
   parseAndFinaliseJournal,
   parseAndFinaliseJournal',
+  finaliseJournal,
   setYear,
   getYear,
   setDefaultCommodityAndStyle,
@@ -228,27 +229,51 @@ journalSourcePos p p' = JournalSourcePos (sourceName p) (fromIntegral . unPos $
 
 
 -- | Given a megaparsec ParsedJournal parser, input options, file
--- path and file content: parse and post-process a Journal, or give an error.
+-- path and file content: parse and finalise a Journal, or give an error.
 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
+  -- TODO: urgh.. clean this up somehow
+  case eep of
+    Left finalParseError -> throwError $ finalErrorBundlePretty $ attachSource f txt finalParseError
+    Right ep -> case ep of
+                  Left e   -> throwError $ customErrorBundlePretty e
+                  Right pj -> finaliseJournal iopts f txt pj
+
+-- | Like parseAndFinaliseJournal but takes a (non-Erroring) JournalParser.
+-- Used for timeclock/timedot.
+-- TODO: get rid of this, use parseAndFinaliseJournal instead
+parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts
+                           -> FilePath -> Text -> ExceptT String IO Journal
+parseAndFinaliseJournal' parser iopts f txt = do
   y <- liftIO getCurrentYear
   let initJournal = nulljournal
         { jparsedefaultyear = Just y
         , jincludefilestack = [f] }
-  eep <- liftIO $ runExceptT $
-    runParserT (evalStateT parser initJournal) f txt
-  -- TODO: urgh.. clean this up somehow
-  case eep of
-    Left finalParseError ->
-      throwError $ finalErrorBundlePretty $ attachSource f txt finalParseError
-
-    Right ep -> case ep of
+  ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt
+  -- see notes above
+  case ep of
     Left e   -> throwError $ customErrorBundlePretty e
+    Right pj -> finaliseJournal iopts f txt pj
 
-      Right pj ->
-
+-- | Post-process a Journal that has just been parsed or generated, in this order:
+--
+-- - apply canonical amount styles,
+--
+-- - save misc info and reverse transactions into their original parse order,
+--
+-- - evaluate balance assignments and balance each transaction,
+--
+-- - apply transaction modifiers (auto postings) if enabled,
+--
+-- - check balance assertions if enabled.
+--
+finaliseJournal :: InputOpts -> FilePath -> Text -> Journal -> ExceptT String IO Journal
+finaliseJournal iopts f txt pj = do
+  t <- liftIO getClockTime
   -- Infer and apply canonical styles for each commodity (or fail).
   -- TODO: since #903's refactoring for hledger 1.12,
   -- journalApplyCommodityStyles here is seeing the
@@ -270,61 +295,23 @@ parseAndFinaliseJournal parser iopts f txt = do
               -- first pass, doing most of the work
               (
                (journalModifyTransactions <$>) $  -- add auto postings after balancing ? #893b fails
-                     journalBalanceTransactions False $
+               journalBalanceTransactions False $ -- balance transactions without checking assertions
                -- journalModifyTransactions <$>   -- add auto postings before balancing ? probably #893a, #928, #938 fail
                journalReverse $
+               journalSetLastReadTime t $
                journalAddFile (f, txt) $
                pj')
-                    -- second pass, checking balance assertions
+              -- balance transactions a second time, now just checking balance assertions
               >>= (\j ->
                  journalBalanceTransactions (not $ ignore_assertions_ iopts) $
-                       journalSetLastReadTime t $
                  j)
 
             else
               -- automatic postings are not active
               journalBalanceTransactions (not $ ignore_assertions_ iopts) $
               journalReverse $
-                    journalAddFile (f, txt) $
               journalSetLastReadTime t $
-                    pj'
-            in
-              case fj of
-                Left e  -> throwError e
-                Right j -> return j
-
--- Like parseAndFinaliseJournal but takes a (non-Erroring) JournalParser.
--- Used for timeclock/timedot.
--- TODO: get rid of this, use parseAndFinaliseJournal instead
-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
-        { jparsedefaultyear = Just y
-        , jincludefilestack = [f] }
-  ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt
-  -- see notes above
-  case ep of
-    Left e   -> throwError $ customErrorBundlePretty e
-    Right pj ->
-      case journalApplyCommodityStyles pj of
-        Left e    -> throwError e
-        Right pj' -> 
-          let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj
-                   then journalModifyTransactions <$>
-                        (journalBalanceTransactions False $
-                         journalReverse $
-                         pj') >>=
-                        (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $
               journalAddFile (f, txt) $
-                               journalSetLastReadTime t $
-                               j)
-                   else journalBalanceTransactions (not $ ignore_assertions_ iopts) $
-                        journalReverse $
-                        journalAddFile (f, txt) $
-                        journalSetLastReadTime t $
               pj'
       in
         case fj of