lib!: modifyTransactions now takes a Map of commodity styles, and will

style amounts according to that argument. journalAddForecast and
journalTransform now return an Either String Journal.

This improves efficiency, as we no longer have to restyle all amounts in
the journal after generating auto postings or periodic transactions.
Changing the return type of journalAddForecast and journalTransform
reduces partiality.

To get the previous behaviour for modifyTransaction, use modifyTransaction mempty.

hledger-lib/Hledger/Data/Journal.hs

@@ -723,9 +723,9 @@ journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{
 -- relative dates in transaction modifier queries.
 journalModifyTransactions :: Day -> Journal -> Either String Journal
 journalModifyTransactions d j =
-  case modifyTransactions d (jtxnmodifiers j) (jtxns j) of
-    Right ts -> Right j{jtxns=ts}
-    Left err -> Left err
+    case modifyTransactions (journalCommodityStyles j) d (jtxnmodifiers j) (jtxns j) of
+      Right ts -> Right j{jtxns=ts}
+      Left err -> Left err
 
 -- | Check any balance assertions in the journal and return an error message
 -- if any of them fail (or if the transaction balancing they require fails).
@@ -1066,20 +1066,12 @@ checkBalanceAssignmentUnassignableAccountB p = do
 -- amounts in each commodity (see journalCommodityStyles).
 -- Can return an error message eg if inconsistent number formats are found.
 journalApplyCommodityStyles :: Journal -> Either String Journal
-journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} =
-  case journalInferCommodityStyles j of
-    Left e   -> Left e
-    Right j' -> Right j''
+journalApplyCommodityStyles = fmap fixjournal . journalInferCommodityStyles
+  where
+    fixjournal j@Journal{jpricedirectives=pds} =
+        journalMapPostings (postingApplyCommodityStyles styles) j{jpricedirectives=map fixpricedirective pds}
       where
-        styles = journalCommodityStyles j'
-        j'' = j'{jtxns=map fixtransaction ts
-                ,jpricedirectives=map fixpricedirective pds
-                }
-        fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
-        fixposting p = p{pamount=styleMixedAmount styles $ pamount p
-                        ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
-        -- balance assertion amounts are always displayed (by print) at full precision, per docs
-        fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba}
+        styles = journalCommodityStyles j
         fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a}
 
 -- | Get the canonical amount styles for this journal, whether (in order of precedence):

hledger-lib/Hledger/Data/Posting.hs

@@ -38,6 +38,7 @@ module Hledger.Data.Posting (
   relatedPostings,
   postingStripPrices,
   postingApplyAliases,
+  postingApplyCommodityStyles,
   -- * date operations
   postingDate,
   postingDate2,
@@ -298,6 +299,14 @@ postingApplyAliases aliases p@Posting{paccount} =
         err = "problem while applying account aliases:\n" ++ pshow aliases 
           ++ "\n to account name: "++T.unpack paccount++"\n "++e
 
+-- | Choose and apply a consistent display style to the posting
+-- amounts in each commodity (see journalCommodityStyles).
+postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
+postingApplyCommodityStyles styles p = p{pamount=styleMixedAmount styles $ pamount p
+                                        ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
+  where
+    fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba}
+
 -- | Rewrite an account name using all matching aliases from the given list, in sequence.
 -- Each alias sees the result of applying the previous aliases.
 -- Or, return any error arising from a bad regular expression in the aliases.

hledger-lib/Hledger/Data/TransactionModifier.hs

@@ -13,6 +13,7 @@ module Hledger.Data.TransactionModifier (
 where
 
 import Control.Applicative ((<|>), liftA2)
+import qualified Data.Map as M
 import Data.Maybe (catMaybes)
 import qualified Data.Text as T
 import Data.Time.Calendar (Day)
@@ -22,7 +23,7 @@ import Hledger.Data.Amount
 import Hledger.Data.Transaction (txnTieKnot)
 import Hledger.Query (Query, filterQuery, matchesAmount, matchesPosting,
                       parseQuery, queryIsAmt, queryIsSym, simplifyQuery)
-import Hledger.Data.Posting (commentJoin, commentAddTag)
+import Hledger.Data.Posting (commentJoin, commentAddTag, postingApplyCommodityStyles)
 import Hledger.Utils (dbg6, wrap)
 
 -- $setup
@@ -35,9 +36,9 @@ import Hledger.Utils (dbg6, wrap)
 -- Or if any of them fails to be parsed, return the first error. A reference
 -- date is provided to help interpret relative dates in transaction modifier
 -- queries.
-modifyTransactions :: Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction]
-modifyTransactions d tmods ts = do
-  fs <- mapM (transactionModifierToFunction d) tmods  -- convert modifiers to functions, or return a parse error
+modifyTransactions :: M.Map CommoditySymbol AmountStyle -> Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction]
+modifyTransactions styles d tmods ts = do
+  fs <- mapM (transactionModifierToFunction styles d) tmods  -- convert modifiers to functions, or return a parse error
   let
     modifytxn t = t''
       where
@@ -61,7 +62,7 @@ modifyTransactions d tmods ts = do
 -- >>> import qualified Data.Text.IO as T
 -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}
 -- >>> tmpost acc amt = TMPostingRule (acc `post` amt) False
--- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate
+-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction mempty nulldate
 -- >>> test $ TransactionModifier "" ["pong" `tmpost` usd 2]
 -- 0000-01-01
 --     ping           $1.00
@@ -77,11 +78,11 @@ modifyTransactions d tmods ts = do
 --     pong           $3.00  ; generated-posting: = ping
 -- <BLANKLINE>
 --
-transactionModifierToFunction :: Day -> TransactionModifier -> Either String (Transaction -> Transaction)
-transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingrules} = do
+transactionModifierToFunction :: M.Map CommoditySymbol AmountStyle -> Day -> TransactionModifier -> Either String (Transaction -> Transaction)
+transactionModifierToFunction styles refdate TransactionModifier{tmquerytxt, tmpostingrules} = do
   q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt
   let
-    fs = map (tmPostingRuleToFunction q tmquerytxt) tmpostingrules
+    fs = map (tmPostingRuleToFunction styles q tmquerytxt) tmpostingrules
     generatePostings ps = concatMap (\p -> p : map ($p) (if q `matchesPosting` p then fs else [])) ps
   Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps}
 
@@ -93,9 +94,9 @@ transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingr
 -- and a hidden _generated-posting: tag which does not.
 -- The TransactionModifier's query text is also provided, and saved
 -- as the tags' value.
-tmPostingRuleToFunction :: Query -> T.Text -> TMPostingRule -> (Posting -> Posting)
-tmPostingRuleToFunction query querytxt tmpr =
-  \p -> renderPostingCommentDates $ pr
+tmPostingRuleToFunction :: M.Map CommoditySymbol AmountStyle -> Query -> T.Text -> TMPostingRule -> (Posting -> Posting)
+tmPostingRuleToFunction styles query querytxt tmpr =
+  \p -> postingApplyCommodityStyles styles . renderPostingCommentDates $ pr
       { pdate    = pdate  pr <|> pdate  p
       , pdate2   = pdate2 pr <|> pdate2 p
       , pamount  = amount' p

hledger-lib/Hledger/Read/Common.hs

@@ -362,8 +362,6 @@ journalFinalise InputOpts{auto_,balancingopts_,strict_} f txt pj' = do
           -- (Note adding auto postings after balancing means #893b fails;
           -- adding them before balancing probably means #893a, #928, #938 fail.)
           >>= journalModifyTransactions d
-          -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?)
-          >>= journalApplyCommodityStyles
           -- then check balance assertions.
           >>= journalBalanceTransactions balancingopts_
 

hledger-web/Hledger/Web/Test.hs

@@ -88,7 +88,7 @@ hledgerWebTest = do
             Right rs -> rs
     copts = defcliopts{reportspec_=rspec, file_=[""]}  -- non-empty, see file_ note above
     wopts = defwebopts{cliopts_=copts}
-  j <- fmap (journalTransform copts) $ readJournal' (T.pack $ unlines  -- PARTIAL: readJournal' should not fail
+  j <- fmap (either error id . journalTransform copts) $ readJournal' (T.pack $ unlines  -- PARTIAL: readJournal' should not fail
     ["~ monthly"
     ,"    assets    10"
     ,"    income"

hledger/Hledger/Cli/Commands/Rewrite.hs

@@ -41,7 +41,7 @@ rewrite opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j@Journal{jtxns=ts} = d
   -- rewrite matched transactions
   d <- getCurrentDay
   let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j
-  let j' = j{jtxns=either error' id $ modifyTransactions d modifiers ts}  -- PARTIAL:
+  let j' = j{jtxns=either error' id $ modifyTransactions mempty d modifiers ts}  -- PARTIAL:
   -- run the print command, showing all transactions, or show diffs
   printOrDiff rawopts opts{reportspec_=rspec{_rsQuery=Any}} j j'
 

hledger/Hledger/Cli/Utils.hs

@@ -75,7 +75,7 @@ withJournalDo opts cmd = do
   -- to let the add command work.
   journalpaths <- journalFilePathFromOpts opts
   files <- readJournalFiles (inputopts_ opts) journalpaths
-  let transformed = journalTransform opts <$> files
+  let transformed = journalTransform opts =<< files
   either error' cmd transformed  -- PARTIAL:
 
 -- | Apply some extra post-parse transformations to the journal, if
@@ -86,12 +86,14 @@ withJournalDo opts cmd = do
 -- - pivoting account names (--pivot)
 -- - anonymising (--anonymise).
 --
-journalTransform :: CliOpts -> Journal -> Journal
+-- This will return an error message if the query in any auto posting rule fails
+-- to parse, or the generated transactions are not balanced.
+journalTransform :: CliOpts -> Journal -> Either String Journal
 journalTransform opts =
-    anonymiseByOpts opts
+    fmap (anonymiseByOpts opts)
   -- - converting amounts to market value (--value)
   -- . journalApplyValue ropts
-  . pivotByOpts opts
+  . fmap (pivotByOpts opts)
   . journalAddForecast opts
 
 -- | Apply the pivot transformation on a journal, if option is present.
@@ -113,26 +115,28 @@ anonymiseByOpts opts =
 --
 -- When --auto is active, auto posting rules will be applied to the
 -- generated transactions. If the query in any auto posting rule fails
--- to parse, this function will raise an error.
+-- to parse, or the generated transactions are not balanced, this function will
+-- return an error message.
 --
 -- The start & end date for generated periodic transactions are determined in
 -- a somewhat complicated way; see the hledger manual -> Periodic transactions.
 --
-journalAddForecast :: CliOpts -> Journal -> Journal
+journalAddForecast :: CliOpts -> Journal -> Either String Journal
 journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j =
     case forecast_ ropts of
-        Nothing -> j
-        Just _  -> either error id $ do  -- PARTIAL:
+        Nothing -> return j
+        Just _  -> do
             forecasttxns <- addAutoTxns =<< mapM (balanceTransaction (balancingopts_ iopts))
-                [ txnTieKnot t | pt <- jperiodictxns j
-                               , t <- runPeriodicTransaction pt forecastspan
-                               , spanContainsDate forecastspan (tdate t)
-                               ]
+                [ txnTieKnot $ transactionTransformPostings (postingApplyCommodityStyles styles) t
+                | pt <- jperiodictxns j
+                , t <- runPeriodicTransaction pt forecastspan
+                , spanContainsDate forecastspan (tdate t)
+                ]
             journalBalanceTransactions (balancingopts_ iopts) j{ jtxns = concat [jtxns j, forecasttxns] }
-              >>= journalApplyCommodityStyles
   where
     today = _rsDay rspec
     ropts = _rsReportOpts rspec
+    styles = journalCommodityStyles j
 
     -- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)."
     mjournalend   = dbg2 "journalEndDate" $ journalEndDate False j  -- ignore secondary dates
@@ -147,7 +151,7 @@ journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j =
         (fromMaybe nulldatespan $ dbg2 "forecastspan flag" $ forecast_ ropts)
         (DateSpan (Just forecastbeginDefault) (Just forecastendDefault))
 
-    addAutoTxns = if auto_ iopts then modifyTransactions today (jtxnmodifiers j) else return
+    addAutoTxns = if auto_ iopts then modifyTransactions styles today (jtxnmodifiers j) else return
 
 -- | Write some output to stdout or to a file selected by --output-file.
 -- If the file exists it will be overwritten.
@@ -196,7 +200,7 @@ journalReload :: CliOpts -> IO (Either String Journal)
 journalReload opts = do
   journalpaths <- dbg6 "reloading files" <$> journalFilePathFromOpts opts
   files <- readJournalFiles (inputopts_ opts) journalpaths
-  return $ journalTransform opts <$> files
+  return $ journalTransform opts =<< files
 
 -- | Has the specified file changed since the journal was last read ?
 -- Typically this is one of the journal's journalFilePaths. These are