lib: Use AmountDisplayOpts for showAmount*, reducing need for many different named functions.

hledger-lib/Hledger/Data/Amount.hs

@@ -40,7 +40,9 @@ exchange rates.
 
 -}
 
-{-# LANGUAGE StandaloneDeriving, RecordWildCards, OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RecordWildCards    #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 module Hledger.Data.Amount (
   -- * Amount
@@ -131,6 +133,7 @@ module Hledger.Data.Amount (
 
 import Control.Monad (foldM)
 import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
+import Data.Default (Default(..))
 import Data.Function (on)
 import Data.List (genericSplitAt, groupBy, intercalate, mapAccumL,
                   partition, sortBy)
@@ -151,6 +154,22 @@ import Hledger.Utils
 deriving instance Show MarketPrice
 
 
+data AmountDisplayOpts = AmountDisplayOpts
+  { displayPrice         :: Bool  -- ^ Whether to display the Price of an Amount.
+  , displayZeroCommodity :: Bool  -- ^ If the Amount rounds to 0, whether to display its commodity string.
+  , displayColour        :: Bool  -- ^ Whether to colourise negative Amounts.
+  , displayNormalised    :: Bool  -- ^ Whether to normalise MixedAmounts before displaying.
+  , displayOneLine       :: Bool  -- ^ Whether to display on one line.
+  } deriving (Show)
+
+instance Default AmountDisplayOpts where
+  def = AmountDisplayOpts { displayPrice         = True
+                          , displayColour        = True
+                          , displayZeroCommodity = False
+                          , displayNormalised    = True
+                          , displayOneLine       = False
+                          }
+
 -------------------------------------------------------------------------------
 -- Amount styles
 
@@ -328,9 +347,9 @@ withDecimalPoint :: Amount -> Maybe Char -> Amount
 withDecimalPoint = flip setAmountDecimalPoint
 
 showAmountPrice :: Maybe AmountPrice -> WideBuilder
-showAmountPrice Nothing                = mempty
-showAmountPrice (Just (UnitPrice pa))  = WideBuilder (TB.fromString " @ ")  3 <> showAmountHelper False pa
-showAmountPrice (Just (TotalPrice pa)) = WideBuilder (TB.fromString " @@ ") 4 <> showAmountHelper False pa
+showAmountPrice Nothing      = mempty
+showAmountPrice (Just (UnitPrice  pa)) = WideBuilder (TB.fromString " @ ")  3 <> showAmountB def{displayColour=False} pa
+showAmountPrice (Just (TotalPrice pa)) = WideBuilder (TB.fromString " @@ ") 4 <> showAmountB def{displayColour=False} pa
 
 showAmountPriceDebug :: Maybe AmountPrice -> String
 showAmountPriceDebug Nothing                = ""
@@ -362,40 +381,43 @@ amountUnstyled a = a{astyle=amountstyle}
 -- zero are converted to just \"0\". The special "missing" amount is
 -- displayed as the empty string.
 showAmount :: Amount -> String
-showAmount = wbUnpack . showAmountHelper False
+showAmount = wbUnpack . showAmountB def{displayColour=False}
+
+-- | Get the string representation of an amount, based on its
+-- commodity's display settings and the display options. The
+-- special "missing" amount is displayed as the empty string.
+showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder
+showAmountB _ Amount{acommodity="AUTO"} = mempty
+showAmountB opts a@Amount{astyle=style} =
+    color $ case ascommodityside style of
+      L -> c' <> space <> quantity' <> price
+      R -> quantity' <> space <> c' <> price
+  where
+    quantity = showamountquantity a
+    (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"")
+                   | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a)
+    space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty
+    c' = WideBuilder (TB.fromText c) (textWidth c)
+    price = if displayPrice opts then showAmountPrice (aprice a) else mempty
+    color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id
 
 -- | Colour version. For a negative amount, adds ANSI codes to change the colour,
 -- currently to hard-coded red.
 cshowAmount :: Amount -> String
-cshowAmount a = (if isNegativeAmount a then color Dull Red else id) . wbUnpack
-                $ showAmountHelper False a
+cshowAmount = wbUnpack . showAmountB def
 
 -- | Get the string representation of an amount, without any \@ price.
 showAmountWithoutPrice :: Amount -> String
-showAmountWithoutPrice a = showAmount a{aprice=Nothing}
+showAmountWithoutPrice = wbUnpack . showAmountB def{displayColour=False, displayPrice=False}
 
 -- | Get the string representation of an amount, based on its commodity's
 -- display settings except using the specified precision.
 showAmountWithPrecision :: AmountPrecision -> Amount -> String
 showAmountWithPrecision p = showAmount . setAmountPrecision p
 
-showAmountHelper :: Bool -> Amount -> WideBuilder
-showAmountHelper _ Amount{acommodity="AUTO"} = mempty
-showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=mp, astyle=AmountStyle{..}} =
-    case ascommodityside of
-      L -> c'' <> space <> quantity' <> price
-      R -> quantity' <> space <> c'' <> price
-    where
-      quantity = showamountquantity a
-      (quantity',c') | amountLooksZero a && not showzerocommodity = (WideBuilder (TB.singleton '0') 1,"")
-                     | otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
-      space = if not (T.null c') && ascommodityspaced then WideBuilder (TB.singleton ' ') 1 else mempty
-      c'' = WideBuilder (TB.fromText c') (textWidth c')
-      price = showAmountPrice mp
-
 -- | Like showAmount, but show a zero amount's commodity if it has one.
 showAmountWithZeroCommodity :: Amount -> String
-showAmountWithZeroCommodity = wbUnpack . showAmountHelper True
+showAmountWithZeroCommodity = wbUnpack . showAmountB def{displayColour=False, displayZeroCommodity=True}
 
 -- | Get a string representation of an amount for debugging,
 -- appropriate to the current debug level. 9 shows maximum detail.

hledger-lib/Hledger/Utils/Color.hs

@@ -6,12 +6,16 @@ module Hledger.Utils.Color
 (
   color,
   bgColor,
+  colorB,
+  bgColorB,
   Color(..),
   ColorIntensity(..)
 )
 where
 
+import qualified Data.Text.Lazy.Builder as TB
 import System.Console.ANSI
+import Hledger.Utils.Text (WideBuilder(..))
 
 
 -- | Wrap a string in ANSI codes to set and reset foreground colour.
@@ -21,3 +25,13 @@ color int col s = setSGRCode [SetColor Foreground int col] ++ s ++ setSGRCode []
 -- | Wrap a string in ANSI codes to set and reset background colour.
 bgColor :: ColorIntensity -> Color -> String -> String
 bgColor int col s = setSGRCode [SetColor Background int col] ++ s ++ setSGRCode []
+
+-- | Wrap a WideBuilder in ANSI codes to set and reset foreground colour.
+colorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
+colorB int col (WideBuilder s w) =
+    WideBuilder (TB.fromString (setSGRCode [SetColor Foreground int col]) <> s <> TB.fromString (setSGRCode [])) w
+
+-- | Wrap a WideBuilder in ANSI codes to set and reset background colour.
+bgColorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
+bgColorB int col (WideBuilder s w) =
+    WideBuilder (TB.fromString (setSGRCode [SetColor Background int col]) <> s <> TB.fromString (setSGRCode [])) w