From 10d85bedecb925c25869b7bc9c1915f5929e9386 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 25 Apr 2017 18:34:09 -0700 Subject: [PATCH] bal: show negative amounts in red The balance command now shows negative amounts in red, when it thinks ANSI codes are supported, ie when TERM is not "dumb" and stdout is not being redirected or piped somewhere. --- hledger-lib/Hledger/Data/Amount.hs | 32 ++++++++++++ hledger-lib/Hledger/Reports/ReportOptions.hs | 8 ++- hledger/Hledger/Cli/Balance.hs | 51 ++++++++++++++------ hledger/hledger.cabal | 4 ++ hledger/package.yaml | 1 + 5 files changed, 79 insertions(+), 17 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index c4f6615d3..0679d4461 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -61,6 +61,7 @@ module Hledger.Data.Amount ( -- ** rendering amountstyle, showAmount, + cshowAmount, showAmountWithZeroCommodity, showAmountDebug, showAmountWithoutPrice, @@ -95,6 +96,8 @@ module Hledger.Data.Amount ( showMixedAmountDebug, showMixedAmountWithoutPrice, showMixedAmountOneLineWithoutPrice, + cshowMixedAmountWithoutPrice, + cshowMixedAmountOneLineWithoutPrice, showMixedAmountWithZeroCommodity, showMixedAmountWithPrecision, setMixedAmountPrecision, @@ -239,6 +242,10 @@ showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice showAmountWithoutPrice :: Amount -> String showAmountWithoutPrice a = showAmount a{aprice=NoPrice} +-- | Colour version. +cshowAmountWithoutPrice :: Amount -> String +cshowAmountWithoutPrice a = cshowAmount a{aprice=NoPrice} + -- | Get the string representation of an amount, without any price or commodity symbol. showAmountWithoutPriceOrCommodity :: Amount -> String showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice} @@ -260,6 +267,13 @@ showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa showAmount :: Amount -> String showAmount = showAmountHelper False +-- | 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) $ + showAmountHelper False a + showAmountHelper :: Bool -> Amount -> String showAmountHelper _ Amount{acommodity="AUTO"} = "" showAmountHelper showzerocommodity a@(Amount{acommodity=c, aprice=p, astyle=AmountStyle{..}}) = @@ -559,6 +573,17 @@ showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth a width = maximum $ map (length . showAmount) as showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice +-- | Colour version. +cshowMixedAmountWithoutPrice :: MixedAmount -> String +cshowMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showamt as + where + (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m + stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} + width = maximum $ map (length . showAmount) as + showamt a = + (if isNegativeAmount a then color Dull Red else id) $ + printf (printf "%%%ds" width) $ showAmountWithoutPrice a + -- | Get the one-line string representation of a mixed amount, but without -- any \@ prices. showMixedAmountOneLineWithoutPrice :: MixedAmount -> String @@ -567,6 +592,13 @@ showMixedAmountOneLineWithoutPrice m = concat $ intersperse ", " $ map showAmoun (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} +-- | Colour version. +cshowMixedAmountOneLineWithoutPrice :: MixedAmount -> String +cshowMixedAmountOneLineWithoutPrice m = concat $ intersperse ", " $ map cshowAmountWithoutPrice as + where + (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m + stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} + -- | Canonicalise a mixed amount's display styles using the provided commodity style map. canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index fd8732054..dc14ca64f 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -40,6 +40,8 @@ import Data.Typeable (Typeable) import Data.Time.Calendar import Data.Default import Safe +import System.Console.ANSI (hSupportsANSI) +import System.IO (stdout) import Test.HUnit import Text.Megaparsec.Error @@ -92,6 +94,7 @@ data ReportOpts = ReportOpts { ,no_total_ :: Bool ,value_ :: Bool ,pretty_tables_ :: Bool + ,color_ :: Bool } deriving (Show, Data, Typeable) instance Default ReportOpts where def = defreportopts @@ -120,11 +123,13 @@ defreportopts = ReportOpts def def def + def rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = checkReportOpts <$> do - d <- getCurrentDay let rawopts' = checkRawOpts rawopts + d <- getCurrentDay + color <- hSupportsANSI stdout return defreportopts{ period_ = periodFromRawOpts d rawopts' ,interval_ = intervalFromRawOpts rawopts' @@ -147,6 +152,7 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do ,no_total_ = boolopt "no-total" rawopts' ,value_ = boolopt "value" rawopts' ,pretty_tables_ = boolopt "pretty-tables" rawopts' + ,color_ = color } -- | Do extra validation of raw option values, raising an error if there's a problem. diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 0a5828fab..3b15bacfa 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -358,7 +358,7 @@ balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t let -- abuse renderBalanceReportItem to render the total with similar format acctcolwidth = maximum' [T.length fullname | (fullname, _, _, _) <- items] - totallines = map rstrip $ renderBalanceReportItem fmt (T.replicate (acctcolwidth+1) " ", 0, total) + totallines = map rstrip $ renderBalanceReportItem opts fmt (T.replicate (acctcolwidth+1) " ", 0, total) -- with a custom format, extend the line to the full report width; -- otherwise show the usual 20-char line for compatibility overlinewidth | isJust (format_ opts) = maximum' $ map length $ concat lines @@ -399,52 +399,69 @@ This implementation turned out to be a bit convoluted but implements the followi -- The output will be one or more lines depending on the format and number of commodities. balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [String] balanceReportItemAsText opts fmt (_, accountName, depth, amt) = - renderBalanceReportItem fmt ( + renderBalanceReportItem opts fmt ( maybeAccountNameDrop opts accountName, depth, normaliseMixedAmountSquashPricesForDisplay amt ) -- | Render a balance report item using the given StringFormat, generating one or more lines of text. -renderBalanceReportItem :: StringFormat -> (AccountName, Int, MixedAmount) -> [String] -renderBalanceReportItem fmt (acctname, depth, total) = +renderBalanceReportItem :: ReportOpts -> StringFormat -> (AccountName, Int, MixedAmount) -> [String] +renderBalanceReportItem opts fmt (acctname, depth, total) = lines $ case fmt of OneLine comps -> concatOneLine $ render1 comps TopAligned comps -> concatBottomPadded $ render comps BottomAligned comps -> concatTopPadded $ render comps where - render1 = map (renderComponent1 (acctname, depth, total)) - render = map (renderComponent (acctname, depth, total)) + render1 = map (renderComponent1 opts (acctname, depth, total)) + render = map (renderComponent opts (acctname, depth, total)) defaultTotalFieldWidth = 20 -- | Render one StringFormat component for a balance report item. -renderComponent :: (AccountName, Int, MixedAmount) -> StringFormatComponent -> String -renderComponent _ (FormatLiteral s) = s -renderComponent (acctname, depth, total) (FormatField ljust min max field) = case field of +renderComponent :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> String +renderComponent _ _ (FormatLiteral s) = s +renderComponent opts (acctname, depth, total) (FormatField ljust min max field) = case field of DepthSpacerField -> formatString ljust Nothing max $ replicate d ' ' where d = case min of Just m -> depth * m Nothing -> depth AccountField -> formatString ljust min max (T.unpack acctname) - TotalField -> fitStringMulti min max True False $ showMixedAmountWithoutPrice total + TotalField -> + -- TODO: does not color multicommodity amounts +-- setamtcolor $ fitStringMulti min max True False $ showMixedAmountWithoutPrice total + fitStringMulti min max True False $ showamt total _ -> "" + where + showamt | color_ opts = cshowMixedAmountWithoutPrice + | otherwise = showMixedAmountWithoutPrice +-- setamtcolor +-- | color_ opts && isNegativeMixedAmount total == Just True = color Dull Red +-- | otherwise = id -- | Render one StringFormat component for a balance report item. -- This variant is for use with OneLine string formats; it squashes -- any multi-line rendered values onto one line, comma-and-space separated, -- while still complying with the width spec. -renderComponent1 :: (AccountName, Int, MixedAmount) -> StringFormatComponent -> String -renderComponent1 _ (FormatLiteral s) = s -renderComponent1 (acctname, depth, total) (FormatField ljust min max field) = case field of +renderComponent1 :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> String +renderComponent1 _ _ (FormatLiteral s) = s +renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field) = case field of AccountField -> formatString ljust min max ((intercalate ", " . lines) (indented (T.unpack acctname))) where -- better to indent the account name here rather than use a DepthField component -- so that it complies with width spec. Uses a fixed indent step size. indented = ((replicate (depth*2) ' ')++) - TotalField -> fitStringMulti min max True False $ ((intercalate ", " . map strip . lines) (showMixedAmountWithoutPrice total)) + TotalField -> +-- setamtcolor $ fitStringMulti min max True False $ ((intercalate ", " . map strip . lines) (showMixedAmountWithoutPrice total)) + fitStringMulti min max True False $ ((intercalate ", " . map strip . lines) (showamt total)) _ -> "" + where + showamt | color_ opts = cshowMixedAmountWithoutPrice + | otherwise = showMixedAmountWithoutPrice +-- setamtcolor +-- | color_ opts && isNegativeMixedAmount total == Just True = color Dull Red +-- | otherwise = id -- multi-column balance reports @@ -489,8 +506,8 @@ multiBalanceReportAsText opts r = -- made using 'balanceReportAsTable'), render it in a format suitable for -- console output. renderBalanceReportTable :: ReportOpts -> Table String String MixedAmount -> String -renderBalanceReportTable (ReportOpts { pretty_tables_ = pretty }) = unlines . trimborder . lines - . render pretty id (" " ++) showMixedAmountOneLineWithoutPrice +renderBalanceReportTable (ReportOpts { pretty_tables_ = pretty, color_=usecolor }) = unlines . trimborder . lines + . render pretty id (" " ++) showamt . align where trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init) @@ -498,6 +515,8 @@ renderBalanceReportTable (ReportOpts { pretty_tables_ = pretty }) = unlines . tr where acctswidth = maximum' $ map strWidth (headerContents l) l' = padRightWide acctswidth <$> l + showamt | usecolor = cshowMixedAmountOneLineWithoutPrice + | otherwise = showMixedAmountOneLineWithoutPrice -- | Build a 'Table' from a multi-column balance report. balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 378aee111..4593ef6a0 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -84,6 +84,7 @@ library build-depends: base >=4.8 && <5 , base-compat >=0.8.1 + , ansi-terminal >= 0.6.2.3 && < 0.7 , directory , file-embed >=0.0.10 && <0.1 , filepath @@ -169,6 +170,7 @@ executable hledger build-depends: base >=4.8 && <5 , base-compat >=0.8.1 + , ansi-terminal >= 0.6.2.3 && < 0.7 , directory , file-embed >=0.0.10 && <0.1 , filepath @@ -231,6 +233,7 @@ test-suite test build-depends: base >=4.8 && <5 , base-compat >=0.8.1 + , ansi-terminal >= 0.6.2.3 && < 0.7 , directory , file-embed >=0.0.10 && <0.1 , filepath @@ -292,6 +295,7 @@ benchmark bench build-depends: base >=4.8 && <5 , base-compat >=0.8.1 + , ansi-terminal >= 0.6.2.3 && < 0.7 , directory , file-embed >=0.0.10 && <0.1 , filepath diff --git a/hledger/package.yaml b/hledger/package.yaml index 09721d95d..fc844aba5 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -65,6 +65,7 @@ flags: dependencies: - base >=4.8 && <5 - base-compat >=0.8.1 +- ansi-terminal >= 0.6.2.3 && < 0.7 - directory - file-embed >=0.0.10 && <0.1 - filepath