From f47df6716704d75a8acc46fbf261a23c436ea140 Mon Sep 17 00:00:00 2001
From: Justin Le <justin@jle.im>
Date: Sat, 4 Feb 2017 00:08:00 -0800
Subject: [PATCH] mapping function over journal amounts

---
 hledger-lib/Hledger/Data/Journal.hs          | 32 ++++++++++++++++----
 hledger-lib/Hledger/Reports/BalanceReport.hs |  1 +
 2 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs
index aea6fe9de..4aa57d37b 100644
--- a/hledger-lib/Hledger/Data/Journal.hs
+++ b/hledger-lib/Hledger/Data/Journal.hs
@@ -32,6 +32,8 @@ module Hledger.Data.Journal (
   journalAccountNamesUsed,
   -- journalAmountAndPriceCommodities,
   journalAmounts,
+  overJournalAmounts,
+  traverseJournalAmounts,
   -- journalCanonicalCommodities,
   journalDateSpan,
   journalDescriptions,
@@ -62,12 +64,14 @@ module Hledger.Data.Journal (
   tests_Hledger_Data_Journal,
 )
 where
+import Control.Applicative (Const(..))
 import Control.Arrow
 import Control.Monad
 import Control.Monad.Except
 import qualified Control.Monad.Reader as R
 import Control.Monad.ST
 import Data.Array.ST
+import Data.Functor.Identity (Identity(..))
 import qualified Data.HashTable.ST.Cuckoo as HT
 import Data.List
 -- import Data.Map (findWithDefault)
@@ -826,12 +830,28 @@ journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
 -- Amounts in posting prices are not used for canonicalisation.
 --
 journalAmounts :: Journal -> [Amount]
-journalAmounts j =
-  concat
-   [map mpamount $ jmarketprices j
-   ,concatMap flatten $ map pamount $ journalPostings j
-   ]
-  where flatten (Mixed as) = as
+journalAmounts = getConst . traverseJournalAmounts (Const . (:[]))
+
+-- | Maps over all of the amounts in the journal
+overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal
+overJournalAmounts f = runIdentity . traverseJournalAmounts (Identity . f)
+
+-- | Traverses over all ofthe amounts in the journal, in the order
+-- indicated by 'journalAmounts'.
+traverseJournalAmounts
+    :: Applicative f
+    => (Amount -> f Amount)
+    -> Journal -> f Journal
+traverseJournalAmounts f j =
+    recombine <$> (traverse . mpa) f (jmarketprices j)
+              <*> (traverse . tp . traverse . pamt . maa . traverse) f (jtxns j)
+  where
+    recombine mps txns = j { jmarketprices = mps, jtxns = txns }
+    -- a bunch of traversals
+    mpa  g mp = (\amt -> mp { mpamount  = amt }) <$> g (mpamount mp)
+    tp   g t  = (\ps  -> t  { tpostings = ps  }) <$> g (tpostings t)
+    pamt g p  = (\amt -> p  { pamount   = amt }) <$> g (pamount p)
+    maa  g (Mixed as) = Mixed <$> g as
 
 -- | The fully specified date span enclosing the dates (primary or secondary)
 -- of all this journal's transactions and postings, or DateSpan Nothing Nothing
diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs
index 515191f19..5869472aa 100644
--- a/hledger-lib/Hledger/Reports/BalanceReport.hs
+++ b/hledger-lib/Hledger/Reports/BalanceReport.hs
@@ -19,6 +19,7 @@ module Hledger.Reports.BalanceReport (
   balanceReport,
   balanceReportValue,
   mixedAmountValue,
+  amountValue,
   flatShowsExclusiveBalance,
 
   -- * Tests