lib: refactor

hledger-lib/Hledger/Data/Journal.hs

@@ -485,21 +485,21 @@ filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter tm
 -}
 
 -- | Do post-parse processing on a parsed journal to make it ready for
--- use.  Reverse parsed data to normal order, canonicalise amount
+-- use.  Reverse parsed data to normal order, standardise amount
 -- formats, check/ensure that transactions are balanced, and maybe
 -- check balance assertions.
 journalFinalise :: ClockTime -> FilePath -> Text -> Bool -> ParsedJournal -> Either String Journal
-journalFinalise t path txt assrt j@Journal{jfiles=fs} = do
+journalFinalise t path txt assrt j@Journal{jfiles=fs} =
-  (journalTieTransactions <$>
+  journalTieTransactions <$> 
-    (journalBalanceTransactions assrt $
+  (journalBalanceTransactions assrt $
-    journalApplyCommodityStyles $
+   journalApplyCommodityStyles $
-    j{ jfiles        = (path,txt) : reverse fs
+   j {jfiles        = (path,txt) : reverse fs
-     , jlastreadtime = t
+     ,jlastreadtime = t
-     , jtxns         = reverse $ jtxns j -- NOTE: see addTransaction
+     ,jtxns         = reverse $ jtxns j -- NOTE: see addTransaction
-     , jmodifiertxns = reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction
+     ,jmodifiertxns = reverse $ jmodifiertxns j -- NOTE: see addModifierTransaction
-     , jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction
+     ,jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction
-     , jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice
+     ,jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice
-     }))
+     })
 
 journalNumberAndTieTransactions = journalTieTransactions . journalNumberTransactions
 
@@ -521,9 +521,12 @@ journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{
 -- message if any of them fail.
 journalCheckBalanceAssertions :: Journal -> Either String Journal
 journalCheckBalanceAssertions j =
-  runST $ journalBalanceTransactionsST True j
+  runST $ journalBalanceTransactionsST 
-  (return ()) (\_ _ -> return ()) (const $ return j) -- noops
+    True 
-
+    j 
+    (return ())
+    (\_ _ -> return ()) 
+    (const $ return j)
 
 -- | Check a posting's balance assertion and return an error if it
 -- fails.
@@ -561,59 +564,58 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just (ass,_)} amt
             (diffplus ++ showAmount diff)
 checkBalanceAssertion _ _ = Right ()
 
--- | Environment for 'CurrentBalancesModifier'
-data Env s = Env { eBalances :: HT.HashTable s AccountName MixedAmount
-                 , eStoreTx :: Transaction -> ST s ()
-                 , eAssrt :: Bool
-                 , eStyles :: Maybe (M.Map CommoditySymbol AmountStyle) }
-
--- | Monad transformer stack with a reference to a mutable hashtable
--- of current account balances and a mutable array of finished
--- transactions in original parsing order.
-type CurrentBalancesModifier s = R.ReaderT (Env s) (ExceptT String (ST s))
-
 -- | Fill in any missing amounts and check that all journal transactions
 -- balance, or return an error message. This is done after parsing all
 -- amounts and applying canonical commodity styles, since balancing
 -- depends on display precision. Reports only the first error encountered.
 journalBalanceTransactions :: Bool -> Journal -> Either String Journal
 journalBalanceTransactions assrt j =
-  runST $ 
+  runST $ journalBalanceTransactionsST 
-    journalBalanceTransactionsST 
+    assrt -- check balance assertions also ?
-      assrt -- check balance assertions also ?
+    (journalNumberTransactions j) -- journal to process
-      (journalNumberTransactions j) -- journal to process
+    (newArray_ (1, genericLength $ jtxns j) :: forall s. ST s (STArray s Integer Transaction)) -- initialise state
-      (newArray_ (1, genericLength $ jtxns j) :: forall s. ST s (STArray s Integer Transaction)) -- initialise state
+    (\arr tx -> writeArray arr (tindex tx) tx)    -- update state
-      (\arr tx -> writeArray arr (tindex tx) tx)    -- update state
+    (fmap (\txns -> j{ jtxns = txns}) . getElems) -- summarise state
-      (fmap (\txns -> j{ jtxns = txns}) . getElems) -- summarise state
 
-
+-- | Helper used by 'journalBalanceTransactions' and 'journalCheckBalanceAssertions'.
--- | Generalization used in the definition of
--- 'journalBalanceTransactionsST and 'journalCheckBalanceAssertions'
 journalBalanceTransactionsST ::
   Bool
   -> Journal
-  -> ST s txns
+  -> ST s txns                        -- ^ initialise state
-  -- ^ creates transaction store
+  -> (txns -> Transaction -> ST s ()) -- ^ update state
-  -> (txns -> Transaction -> ST s ())
+  -> (txns -> ST s a)                 -- ^ summarise state
-  -- ^ "store" operation
-  -> (txns -> ST s a)
-  -- ^ calculate result from transactions
   -> ST s (Either String a)
 journalBalanceTransactionsST assrt j createStore storeIn extract =
   runExceptT $ do
     bals <- lift $ HT.newSized size
     txStore <- lift $ createStore
-    flip R.runReaderT (Env bals (storeIn txStore) assrt $
+    let env = Env bals 
-                       Just $ jinferredcommodities j) $ do
+                  (storeIn txStore) 
+                  assrt
+                  (Just $ jinferredcommodities j)
+    flip R.runReaderT env $ do
       dated <- fmap snd . sortBy (comparing fst) . concat
-             <$> mapM' discriminateByDate (jtxns j)
+                <$> mapM' discriminateByDate (jtxns j)
       mapM' checkInferAndRegisterAmounts dated
     lift $ extract txStore
-  where size = genericLength $ journalPostings j
+    where 
+      size = genericLength $ journalPostings j
 
--- | This converts a transaction into a list of objects whose dates
+-- | Monad transformer stack with a reference to a mutable hashtable
--- have to be considered when checking balance assertions and handled
+-- of current account balances and a mutable array of finished
--- by 'checkInferAndRegisterAmounts'.
+-- transactions in original parsing order.
+type CurrentBalancesModifier s = R.ReaderT (Env s) (ExceptT String (ST s))
+
+-- | Environment for 'CurrentBalancesModifier'
+data Env s = Env { eBalances :: HT.HashTable s AccountName MixedAmount
+                 , eStoreTx  :: Transaction -> ST s ()
+                 , eAssrt    :: Bool
+                 , eStyles   :: Maybe (M.Map CommoditySymbol AmountStyle) 
+                 }
+
+-- | This converts a transaction into a list of transactions or
+-- postings whose dates have to be considered when checking 
+-- balance assertions and handled by 'checkInferAndRegisterAmounts'.
 --
 -- Transaction without balance assignments can be balanced and stored
 -- immediately and their (possibly) dated postings are returned.
@@ -626,25 +628,24 @@ discriminateByDate :: Transaction
 discriminateByDate tx
   | null (assignmentPostings tx) = do
       styles <- R.reader $ eStyles
-      balanced <- lift $ ExceptT $ return
+      balanced <- lift $ ExceptT $ return $ balanceTransaction styles tx
-        $ balanceTransaction styles tx
       storeTransaction balanced
-      return $ fmap (postingDate &&& (Left . removePrices))
+      return $ 
-        $ tpostings $ balanced
+        fmap (postingDate &&& (Left . removePrices)) $ tpostings $ balanced
   | True                         = do
       when (any (isJust . pdate) $ tpostings tx) $
         throwError $ unlines $
         ["Not supported: Transactions with balance assignments "
         ,"AND dated postings without amount:\n"
         , showTransaction tx]
-      return [(tdate tx, Right
+      return 
-                $ tx { tpostings = removePrices <$> tpostings tx })]
+        [(tdate tx, Right $ tx { tpostings = removePrices <$> tpostings tx })]
 
--- | This function takes different objects describing changes to
+-- | This function takes an object describing changes to
--- account balances on a single day. It can handle either a single
+-- account balances on a single day - either a single posting 
--- posting (from an already balanced transaction without assigments)
+-- (from an already balanced transaction without assignments)
--- or a whole transaction with assignments (which is required to no
+-- or a whole transaction with assignments (which is required to 
--- posting with pdate set.).
+-- have no posting with pdate set).
 --
 -- For a single posting, there is not much to do. Only add its amount
 -- to its account and check the assertion, if there is one. This
@@ -654,9 +655,9 @@ discriminateByDate tx
 -- 'addAmountAndCheckBalance', if there is an amount. If there is no
 -- amount, the amount is inferred by the assertion or left empty if
 -- there is no assertion. Then, the transaction is balanced, the
--- inferred amount added to the balance (all in
+-- inferred amount added to the balance (all in 'balanceTransactionUpdate') 
--- 'balanceTransactionUpdate') and the resulting transaction with no
+-- and the resulting transaction with no missing amounts is stored 
--- missing amounts is stored in the array, for later retrieval.
+-- in the array, for later retrieval.
 --
 -- Again in short:
 --
@@ -682,45 +683,42 @@ checkInferAndRegisterAmounts (Right oldTx) = do
       (fmap (\a -> p { pamount = a, porigin = Just $ originalPosting p }) . setBalance (paccount p) . fst)
       $ pbalanceassertion p
 
--- | Adds a posting's amonut to the posting's account balance and
+-- | Adds a posting's amount to the posting's account balance and
--- checks a possible balance assertion. If there is no amount, it runs
+-- checks a possible balance assertion. Or if there is no amount,
--- the supplied fallback action.
+-- runs the supplied fallback action.
-addAmountAndCheckBalance :: (Posting -> CurrentBalancesModifier s Posting)
+addAmountAndCheckBalance :: 
-            -- ^ action to execute, if posting has no amount
+     (Posting -> CurrentBalancesModifier s Posting) -- ^ action if posting has no amount
-            -> Posting
+  -> Posting
-            -> CurrentBalancesModifier s Posting
+  -> CurrentBalancesModifier s Posting
 addAmountAndCheckBalance _ p | hasAmount p = do
   newAmt <- addToBalance (paccount p) $ pamount p
   assrt <- R.reader eAssrt
-  lift $ when assrt $ ExceptT $ return
+  lift $ when assrt $ ExceptT $ return $ checkBalanceAssertion p newAmt
-    $ checkBalanceAssertion p newAmt
   return p
 addAmountAndCheckBalance fallback p = fallback p
 
 -- | Sets an account's balance to a given amount and returns the
--- difference of new and old amount
+-- difference of new and old amount.
 setBalance :: AccountName -> Amount -> CurrentBalancesModifier s MixedAmount
 setBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do
   old <- HT.lookup bals acc
   let new = Mixed $ (amt :) $ maybe []
-        (filter ((/= acommodity amt) . acommodity) . amounts) old
+              (filter ((/= acommodity amt) . acommodity) . amounts) old
   HT.insert bals acc new
   return $ maybe new (new -) old
 
--- | Adds an amount to an account's balance and returns the resulting
+-- | Adds an amount to an account's balance and returns the resulting balance.
--- balance
 addToBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount
 addToBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do
   new <- maybe amt (+ amt) <$> HT.lookup bals acc
   HT.insert bals acc new
   return new
 
--- | Stores a transaction in the transaction array in original parsing
+-- | Stores a transaction in the transaction array in original parsing order.
--- order.
 storeTransaction :: Transaction -> CurrentBalancesModifier s ()
 storeTransaction tx = liftModifier $ ($tx) . eStoreTx
 
--- | Helper function
+-- | Helper function.
 liftModifier :: (Env s -> ST s a) -> CurrentBalancesModifier s a
 liftModifier f = R.ask >>= lift . lift . f