add a color argument to most amount show helpers, drop cshow variants

This is an API change, but it seems better than having additional colour-supporting variants and trying to avoid duplicated code. I stopped short of changing showAmount, so cshowAmount still exists.
2020-06-26 12:59:47 -07:00 · 2020-06-26 12:59:47 -07:00 · 44c3eb1904
commit 44c3eb1904
parent 2739a70a38
8 changed files with 49 additions and 89 deletions
--- a/hledger-lib/Hledger/Data/Amount.hs
+++ b/hledger-lib/Hledger/Data/Amount.hs
@ -122,9 +122,6 @@ module Hledger.Data.Amount (
  showMixedAmountWithoutPrice,
  showMixedAmountOneLineWithoutPrice,
  showMixedAmountElided,
-  cshowMixedAmountWithoutPrice,
-  cshowMixedAmountOneLineWithoutPrice,
-  cshowMixedAmountElided,
  showMixedAmountWithZeroCommodity,
  showMixedAmountWithPrecision,
  setMixedAmountPrecision,
@ -150,7 +147,6 @@ import Hledger.Data.Types
 import Hledger.Data.Commodity
 import Hledger.Utils

-
 deriving instance Show MarketPrice


@ -272,7 +268,7 @@ digits = "123456789" :: String
 -- | Does mixed amount appear to be zero when rendered with its
 -- display precision ?
 amountLooksZero :: Amount -> Bool
-amountLooksZero = not . any (`elem` digits) . showAmountWithoutPriceOrCommodity
+amountLooksZero = not . any (`elem` digits) . (showAmountWithoutPriceOrCommodity False)

 -- | Is this amount exactly zero, ignoring its display precision ?
 amountIsZero :: Amount -> Bool
@ -325,8 +321,11 @@ showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
 showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showAmountPriceDebug aprice) (show astyle)

 -- | Get the string representation of an amount, without any \@ price.
-showAmountWithoutPrice :: Amount -> String
-showAmountWithoutPrice a = showAmount a{aprice=Nothing}
+-- With a True argument, adds ANSI codes to show negative amounts in red.
+showAmountWithoutPrice :: Bool -> Amount -> String
+showAmountWithoutPrice c a = showamt a{aprice=Nothing}
+  where
+    showamt = if c then cshowAmount else showAmount

 -- | Set an amount's internal precision, ie rounds the Decimal representing
 -- the amount's quantity to some number of decimal places.
@ -353,13 +352,12 @@ setAmountDecimalPoint mc a@Amount{ astyle=s } = a{ astyle=s{asdecimalpoint=mc} }
 withDecimalPoint :: Amount -> Maybe Char -> Amount
 withDecimalPoint = flip setAmountDecimalPoint

-- | Colour version.
-cshowAmountWithoutPrice :: Amount -> String
-cshowAmountWithoutPrice a = cshowAmount a{aprice=Nothing}
-
 -- | Get the string representation of an amount, without any price or commodity symbol.
-showAmountWithoutPriceOrCommodity :: Amount -> String
-showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=Nothing}
+-- With a True argument, adds ANSI codes to show negative amounts in red.
+showAmountWithoutPriceOrCommodity :: Bool -> Amount -> String
+showAmountWithoutPriceOrCommodity c a = showamt a{acommodity="", aprice=Nothing}
+  where
+    showamt = if c then cshowAmount else showAmount

 showAmountPrice :: Maybe AmountPrice -> String
 showAmountPrice Nothing                = ""
@ -700,23 +698,14 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)"
 -- TODO these and related fns are comically complicated:

 -- | Get the string representation of a mixed amount, without showing any transaction prices.
-showMixedAmountWithoutPrice :: MixedAmount -> String
-showMixedAmountWithoutPrice m = intercalate "\n" $ map showamt as
-  where
-    Mixed as = normaliseMixedAmountSquashPricesForDisplay $ mixedAmountStripPrices m
-    showamt = printf (printf "%%%ds" width) . showAmountWithoutPrice
-      where
-        width = maximumDef 0 $ map (length . showAmount) as
-
-- | Colour version of showMixedAmountWithoutPrice. Any individual Amount
-- which is negative is wrapped in ANSI codes to make it display in red.
-cshowMixedAmountWithoutPrice :: MixedAmount -> String
-cshowMixedAmountWithoutPrice m = intercalate "\n" $ map showamt as
+-- With a True argument, adds ANSI codes to show negative amounts in red.
+showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String
+showMixedAmountWithoutPrice c m = intercalate "\n" $ map showamt as
  where
    Mixed as = normaliseMixedAmountSquashPricesForDisplay $ mixedAmountStripPrices m
    showamt a =
-      (if isNegativeAmount a then color Dull Red else id) $
-      printf (printf "%%%ds" width) $ showAmountWithoutPrice a
+      (if c && isNegativeAmount a then color Dull Red else id) $
+      printf (printf "%%%ds" width) $ showAmountWithoutPrice c a
      where
        width = maximumDef 0 $ map (length . showAmount) as

@ -725,41 +714,21 @@ mixedAmountStripPrices (Mixed as) = Mixed $ map (\a -> a{aprice=Nothing}) as

 -- | Get the one-line string representation of a mixed amount, but without
 -- any \@ prices.
-showMixedAmountOneLineWithoutPrice :: MixedAmount -> String
-showMixedAmountOneLineWithoutPrice m = intercalate ", " $ map showAmountWithoutPrice as
-    where
-      (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m
-      stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing}
-
-- | Colour version.
-cshowMixedAmountOneLineWithoutPrice :: MixedAmount -> String
-cshowMixedAmountOneLineWithoutPrice m = intercalate ", " $ map cshowAmountWithoutPrice as
+-- With a True argument, adds ANSI codes to show negative amounts in red.
+showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String
+showMixedAmountOneLineWithoutPrice c m =
+  intercalate ", " $ map (showAmountWithoutPrice c) as
    where
      (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m
      stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing}

 -- | Like showMixedAmountOneLineWithoutPrice, but show at most two commodities,
 -- with a elision indicator if there are more.
-showMixedAmountElided :: MixedAmount -> String
-showMixedAmountElided m = intercalate ", " $ take 2 astrs ++ elisionstr
+-- With a True argument, adds ANSI codes to show negative amounts in red.
+showMixedAmountElided :: Bool -> MixedAmount -> String
+showMixedAmountElided c m = intercalate ", " $ take 2 astrs ++ elisionstr
  where
-    astrs = map showAmountWithoutPrice as
-      where
-        (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m
-          where
-            stripPrices (Mixed as) = Mixed $ map stripprice as
-              where
-                stripprice a = a{aprice=Nothing}
-    elisionstr | n > 2     = [show (n - 2) ++ " more.."]
-               | otherwise = []
-      where
-        n = length astrs
-
-- | Colour version.
-cshowMixedAmountElided :: MixedAmount -> String
-cshowMixedAmountElided m = intercalate ", " $ take 2 astrs ++ elisionstr
-  where
-    astrs = map cshowAmountWithoutPrice as
+    astrs = map (showAmountWithoutPrice c) as
      where
        (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m
          where
@ -846,8 +815,8 @@ tests_Amount = tests "Amount" [

    ,test "showMixedAmountWithoutPrice" $ do
      let a = usd 1 `at` eur 2
-      showMixedAmountWithoutPrice (Mixed [a]) @?= "$1.00"
-      showMixedAmountWithoutPrice (Mixed [a, -a]) @?= "0"
+      showMixedAmountWithoutPrice False (Mixed [a]) @?= "$1.00"
+      showMixedAmountWithoutPrice False (Mixed [a, -a]) @?= "0"

    ,tests "normaliseMixedAmount" [
       test "a missing amount overrides any other amounts" $
--- a/hledger-lib/Hledger/Reports/BudgetReport.hs
+++ b/hledger-lib/Hledger/Reports/BudgetReport.hs
@ -263,7 +263,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
    budgetwidth = maximum' $ map snd amountsAndGoals
    amountsAndGoals = map (\(a,g) -> (amountLength a, amountLength g))
                    . concatMap prrAmounts $ prRows budgetr
-      where amountLength = maybe 0 (length . showMixedAmountOneLineWithoutPrice)
+      where amountLength = maybe 0 (length . showMixedAmountOneLineWithoutPrice False)
    -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells
    showcell :: BudgetCell -> String
    showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr
@ -296,12 +296,10 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
               Nothing
      where
        maybecost = if valuationTypeIsCost ropts then mixedAmountCost else id
-    showamt :: MixedAmount -> String
-    showamt | color_    = cshowMixedAmountOneLineWithoutPrice
-            | otherwise = showMixedAmountOneLineWithoutPrice
+    showamt = showMixedAmountOneLineWithoutPrice color_

-    -- don't show the budget amount in color, it messes up alignment
-    showbudgetamt = showMixedAmountOneLineWithoutPrice
+    -- don't show the budget amount in color, it messes up alignment (XXX)
+    showbudgetamt = showMixedAmountOneLineWithoutPrice False

    maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)
                   | otherwise  = id
--- a/hledger-ui/Hledger/UI/AccountsScreen.hs
+++ b/hledger-ui/Hledger/UI/AccountsScreen.hs
@ -108,7 +108,7 @@ asInit d reset ui@UIState{
      AccountsScreenItem{asItemIndentLevel        = indent
                        ,asItemAccountName        = fullacct
                        ,asItemDisplayAccountName = replaceHiddenAccountsNameWith "All" $ if tree_ ropts' then shortacct else fullacct
-                        ,asItemRenderedAmounts    = map showAmountWithoutPrice amts -- like showMixedAmountOneLineWithoutPrice
+                        ,asItemRenderedAmounts    = map (showAmountWithoutPrice False) amts
                        }
      where
        Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal
--- a/hledger-ui/Hledger/UI/RegisterScreen.hs
+++ b/hledger-ui/Hledger/UI/RegisterScreen.hs
@ -95,8 +95,8 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts
                                                     [s] -> s
                                                     ss  -> intercalate ", " ss
                                                     -- _   -> "<split>"  -- should do this if accounts field width < 30
-                            ,rsItemChangeAmount  = showMixedAmountOneLineWithoutPrice change
-                            ,rsItemBalanceAmount = showMixedAmountOneLineWithoutPrice bal
+                            ,rsItemChangeAmount  = showMixedAmountOneLineWithoutPrice False change
+                            ,rsItemBalanceAmount = showMixedAmountOneLineWithoutPrice False bal
                            ,rsItemTransaction   = t
                            }
    -- blank items are added to allow more control of scroll position; we won't allow movement over these
--- a/hledger-web/Hledger/Web/Widget/Common.hs
+++ b/hledger-web/Hledger/Web/Widget/Common.hs
@ -102,7 +102,7 @@ accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced

 mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
 mixedAmountAsHtml b _ =
-  for_ (lines (showMixedAmountWithoutPrice b)) $ \t -> do
+  for_ (lines (showMixedAmountWithoutPrice False b)) $ \t -> do
    H.span ! A.class_ c $ toHtml t
    H.br
  where
--- a/hledger/Hledger/Cli/Commands/Balance.hs
+++ b/hledger/Hledger/Cli/Commands/Balance.hs
@ -349,11 +349,11 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
 balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
 balanceReportAsCsv opts (items, total) =
  ["account","balance"] :
-  [[T.unpack a, showMixedAmountOneLineWithoutPrice b] | (a, _, _, b) <- items]
+  [[T.unpack a, showMixedAmountOneLineWithoutPrice False b] | (a, _, _, b) <- items]
  ++
  if no_total_ opts
  then []
-  else [["total", showMixedAmountOneLineWithoutPrice total]]
+  else [["total", showMixedAmountOneLineWithoutPrice False total]]

 -- | Render a single-column balance report as plain text.
 balanceReportAsText :: ReportOpts -> BalanceReport -> String
@ -426,10 +426,7 @@ renderComponent opts (acctname, depth, total) (FormatField ljust min max field)
                                 Just m  -> depth * m
                                 Nothing -> depth
  AccountField     -> formatString ljust min max (T.unpack acctname)
-  TotalField       -> fitStringMulti min max True False $ showamt total
-    where
-      showamt | color_ opts = cshowMixedAmountWithoutPrice
-              | otherwise   = showMixedAmountWithoutPrice
+  TotalField       -> fitStringMulti min max True False $ showMixedAmountWithoutPrice (color_ opts) total
  _                -> ""

 -- | Render one StringFormat component for a balance report item.
@ -446,8 +443,7 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field)
                        indented = ((replicate (depth*2) ' ')++)
  TotalField       -> fitStringMulti min max True False $ ((intercalate ", " . map strip . lines) (showamt total))
    where
-      showamt | color_ opts = cshowMixedAmountWithoutPrice
-              | otherwise   = showMixedAmountWithoutPrice
+      showamt = showMixedAmountWithoutPrice (color_ opts)
  _                -> ""

 -- rendering multi-column balance reports
@ -464,7 +460,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
   ++ ["Average" | average_]
  ) :
  [T.unpack (displayFull a) :
-   map showMixedAmountOneLineWithoutPrice
+   map (showMixedAmountOneLineWithoutPrice False)
   (amts
    ++ [rowtot | row_total_]
    ++ [rowavg | average_])
@ -473,7 +469,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
  if no_total_ opts
  then []
  else ["Total:" :
-        map showMixedAmountOneLineWithoutPrice (
+        map (showMixedAmountOneLineWithoutPrice False) (
          coltotals
          ++ [tot | row_total_]
          ++ [avg | average_]
@ -635,10 +631,8 @@ balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> Str
 balanceReportTableAsText ropts@ReportOpts{..} = tableAsText ropts showamt
  where
    showamt
-      | no_elide_ && color_ = cshowMixedAmountOneLineWithoutPrice
-      | no_elide_           =  showMixedAmountOneLineWithoutPrice
-      | color_              = cshowMixedAmountElided
-      | otherwise           =  showMixedAmountElided
+      | no_elide_ = showMixedAmountOneLineWithoutPrice color_
+      | otherwise = showMixedAmountElided color_


 tests_Balance = tests "Balance" [
--- a/hledger/Hledger/Cli/Commands/Register.hs
+++ b/hledger/Hledger/Cli/Commands/Register.hs
@ -86,8 +86,8 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal
                             BalancedVirtualPosting -> (\s -> "["++s++"]")
                             VirtualPosting -> (\s -> "("++s++")")
                             _ -> id
-    amt = showMixedAmountOneLineWithoutPrice $ pamount p
-    bal = showMixedAmountOneLineWithoutPrice b
+    amt = showMixedAmountOneLineWithoutPrice False $ pamount p
+    bal = showMixedAmountOneLineWithoutPrice False b

 -- | Render a register report as plain text suitable for console output.
 postingsReportAsText :: CliOpts -> PostingsReport -> String
@ -179,8 +179,7 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
              BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2)
              VirtualPosting         -> (\s -> "("++s++")", acctwidth-2)
              _                      -> (id,acctwidth)
-      showamt | color_ (reportopts_ opts) = cshowMixedAmountWithoutPrice
-              | otherwise                 = showMixedAmountWithoutPrice
+      showamt = showMixedAmountWithoutPrice (color_ $ reportopts_ opts)
      amt = showamt $ pamount p
      bal = showamt b
      -- alternate behaviour, show null amounts as 0 instead of blank
--- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs
+++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs
@ -262,7 +262,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor
      | no_total_ ropts || length subreports == 1 = id
      | otherwise = (++
          ["Net:" :
-           map showMixedAmountOneLineWithoutPrice (
+           map (showMixedAmountOneLineWithoutPrice False) (
             coltotals
             ++ (if row_total_ ropts then [grandtotal] else [])
             ++ (if average_ ropts   then [grandavg]   else [])
@ -309,9 +309,9 @@ compoundBalanceReportAsHtml ropts cbr =
                  in
                    [tr_ $ mconcat $
                         th_ [class_ "", style_ "text-align:left"] "Net:"
-                       : [th_ [class_ "amount coltotal", defstyle] (toHtml $ showMixedAmountOneLineWithoutPrice a) | a <- coltotals]
-                      ++ (if row_total_ ropts then [th_ [class_ "amount coltotal", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice $ grandtotal] else [])
-                      ++ (if average_ ropts   then [th_ [class_ "amount colaverage", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice $ grandavg] else [])
+                       : [th_ [class_ "amount coltotal", defstyle] (toHtml $ showMixedAmountOneLineWithoutPrice False a) | a <- coltotals]
+                      ++ (if row_total_ ropts then [th_ [class_ "amount coltotal", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice False grandtotal] else [])
+                      ++ (if average_ ropts   then [th_ [class_ "amount colaverage", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice False grandavg] else [])
                    ]

  in do