diff --git a/hledger-lib/Hledger/Data/StringFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs index 6fed40b74..3282bdc45 100644 --- a/hledger-lib/Hledger/Data/StringFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -13,7 +13,6 @@ module Hledger.Data.StringFormat ( , StringFormat(..) , StringFormatComponent(..) , ReportItemField(..) - , overlineWidth , defaultBalanceLineFormat , tests_StringFormat ) where @@ -35,12 +34,9 @@ import Hledger.Utils.Test -- | A format specification/template to use when rendering a report line item as text. -- --- A format is an optional width, along with a sequence of components; --- each is either a literal string, or a hledger report item field with --- specified width and justification whose value will be interpolated --- at render time. The optional width determines the length of the --- overline to draw above the totals row; if it is Nothing, then the --- maximum width of all lines is used. +-- A format is a sequence of components; each is either a literal +-- string, or a hledger report item field with specified width and +-- justification whose value will be interpolated at render time. -- -- A component's value may be a multi-line string (or a -- multi-commodity amount), in which case the final string will be @@ -51,9 +47,9 @@ import Hledger.Utils.Test -- mode, which provides a limited StringFormat renderer. -- data StringFormat = - OneLine (Maybe Int) [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated - | TopAligned (Maybe Int) [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height) - | BottomAligned (Maybe Int) [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded) + OneLine [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated + | TopAligned [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height) + | BottomAligned [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded) deriving (Show, Eq) data StringFormatComponent = @@ -85,14 +81,9 @@ data ReportItemField = instance Default StringFormat where def = defaultBalanceLineFormat -overlineWidth :: StringFormat -> Maybe Int -overlineWidth (OneLine w _) = w -overlineWidth (TopAligned w _) = w -overlineWidth (BottomAligned w _) = w - -- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)" defaultBalanceLineFormat :: StringFormat -defaultBalanceLineFormat = BottomAligned (Just 20) [ +defaultBalanceLineFormat = BottomAligned [ FormatField False (Just 20) Nothing TotalField , FormatLiteral " " , FormatField True (Just 2) Nothing DepthSpacerField @@ -118,10 +109,10 @@ stringformatp = do alignspec <- optional (try $ char '%' >> oneOf ("^_,"::String)) let constructor = case alignspec of - Just '^' -> TopAligned Nothing - Just '_' -> BottomAligned Nothing - Just ',' -> OneLine Nothing - _ -> defaultStringFormatStyle Nothing + Just '^' -> TopAligned + Just '_' -> BottomAligned + Just ',' -> OneLine + _ -> defaultStringFormatStyle constructor <$> many componentp componentp :: SimpleTextParser StringFormatComponent @@ -182,23 +173,23 @@ tests_StringFormat = tests "StringFormat" [ ,let s `gives` expected = test s $ parseStringFormat (T.pack s) @?= Right expected in tests "parseStringFormat" [ - "" `gives` (defaultStringFormatStyle Nothing []) - , "D" `gives` (defaultStringFormatStyle Nothing [FormatLiteral "D"]) - , "%(date)" `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing DescriptionField]) - , "%(total)" `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing Nothing TotalField]) + "" `gives` (defaultStringFormatStyle []) + , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"]) + , "%(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField]) + , "%(total)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField]) -- TODO -- , "^%(total)" `gives` (TopAligned [FormatField False Nothing Nothing TotalField]) -- , "_%(total)" `gives` (BottomAligned [FormatField False Nothing Nothing TotalField]) -- , ",%(total)" `gives` (OneLine [FormatField False Nothing Nothing TotalField]) - , "Hello %(date)!" `gives` (defaultStringFormatStyle Nothing [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]) - , "%-(date)" `gives` (defaultStringFormatStyle Nothing [FormatField True Nothing Nothing DescriptionField]) - , "%20(date)" `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing DescriptionField]) - , "%.10(date)" `gives` (defaultStringFormatStyle Nothing [FormatField False Nothing (Just 10) DescriptionField]) - , "%20.10(date)" `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) (Just 10) DescriptionField]) - , "%20(account) %.10(total)" `gives` (defaultStringFormatStyle Nothing [FormatField False (Just 20) Nothing AccountField - ,FormatLiteral " " - ,FormatField False Nothing (Just 10) TotalField - ]) + , "Hello %(date)!" `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]) + , "%-(date)" `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField]) + , "%20(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField]) + , "%.10(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField]) + , "%20.10(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField]) + , "%20(account) %.10(total)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField + ,FormatLiteral " " + ,FormatField False Nothing (Just 10) TotalField + ]) , test "newline not parsed" $ assertLeft $ parseStringFormat "\n" ] ] diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index a7617af93..d38a8a8de 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -100,8 +100,8 @@ textChomp = T.dropWhileEnd (`elem` ['\r', '\n']) -- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it. -- Works on multi-line strings too (but will rewrite non-unix line endings). formatText :: Bool -> Maybe Int -> Maybe Int -> Text -> Text -formatText leftJustified minwidth maxwidth = - T.intercalate "\n" . map (pad . clip) . T.lines +formatText leftJustified minwidth maxwidth t = + T.intercalate "\n" . map (pad . clip) $ if T.null t then [""] else T.lines t where pad = maybe id justify minwidth clip = maybe id T.take maxwidth diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index b63ca440d..cb82d9e7b 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -254,6 +254,7 @@ module Hledger.Cli.Commands.Balance ( ,tests_Balance ) where +import Control.Arrow (first) import Data.Default (def) import Data.List (intersperse, transpose) import Data.Maybe (fromMaybe, maybeToList) @@ -366,18 +367,22 @@ balanceReportAsCsv opts (items, total) = -- | Render a single-column balance report as plain text. balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder balanceReportAsText opts ((items, total)) = - unlinesB lines <> unlinesB (if no_total_ opts then [] else [overline, totallines]) + unlinesB lines + <> unlinesB (if no_total_ opts then [] else [overline, totalLines]) where unlinesB [] = mempty unlinesB xs = mconcat (intersperse (TB.singleton '\n') xs) <> TB.singleton '\n' - lines = map (balanceReportItemAsText opts) items + (lines, sizes) = unzip $ map (balanceReportItemAsText opts) items -- abuse renderBalanceReportItem to render the total with similar format - totallines = renderBalanceReportItem opts ("", 0, total) + (totalLines, _) = renderBalanceReportItem opts ("",0,total) -- with a custom format, extend the line to the full report width; -- otherwise show the usual 20-char line for compatibility - overlinewidth = fromMaybe 22 . overlineWidth $ format_ opts - --overlinewidth = fromMaybe (maximum' . map length $ concat lines) . overlineWidth $ format_ opts + overlinewidth = case format_ opts of + OneLine ((FormatField _ _ _ TotalField):_) -> 20 + TopAligned ((FormatField _ _ _ TotalField):_) -> 20 + BottomAligned ((FormatField _ _ _ TotalField):_) -> 20 + _ -> sum (map maximum' $ transpose sizes) overline = TB.fromText $ T.replicate overlinewidth "-" {- @@ -395,7 +400,7 @@ This implementation turned out to be a bit convoluted but implements the followi -- whatever string format is specified). Note, prices will not be rendered, and -- differently-priced quantities of the same commodity will appear merged. -- The output will be one or more lines depending on the format and number of commodities. -balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> TB.Builder +balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> (TB.Builder, [Int]) balanceReportItemAsText opts (_, accountName, depth, amt) = renderBalanceReportItem opts ( accountName, @@ -404,46 +409,36 @@ balanceReportItemAsText opts (_, accountName, depth, amt) = ) -- | Render a balance report item using the given StringFormat, generating one or more lines of text. -renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> TB.Builder +renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> (TB.Builder, [Int]) renderBalanceReportItem opts (acctname, depth, total) = case format_ opts of - OneLine _ comps -> foldMap (TB.fromText . T.intercalate ", ") $ render1 comps - TopAligned _ comps -> renderRow' TopLeft $ render comps - BottomAligned _ comps -> renderRow' BottomLeft $ render comps + OneLine comps -> renderRow' $ render True True comps + TopAligned comps -> renderRow' $ render True False comps + BottomAligned comps -> renderRow' $ render False False comps where - renderRow' align = renderRowB def{tableBorders=False, borderSpaces=False} - . Tab.Group NoLine . map (Header . cell) - where cell = Cell align . map (\x -> (x, textWidth x)) + renderRow' is = ( renderRowB def{tableBorders=False, borderSpaces=False} + . Tab.Group NoLine $ map Header is + , map cellWidth is ) + + render topaligned oneline = map (maybeConcat . renderComponent topaligned opts (acctname, depth, total)) + where maybeConcat (Cell a xs) = if oneline then Cell a [(T.intercalate ", " strs, width)] + else Cell a xs + where + (strs, ws) = unzip xs + width = sumStrict (map (+2) ws) -2 - render1 = map (T.lines . renderComponent1 opts (acctname, depth, total)) - render = map (T.lines . renderComponent opts (acctname, depth, total)) -- | Render one StringFormat component for a balance report item. -renderComponent :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> T.Text -renderComponent _ _ (FormatLiteral s) = s -renderComponent opts (acctname, depth, total) (FormatField ljust min max field) = case field of - DepthSpacerField -> formatText ljust Nothing max $ T.replicate d " " - where d = case min of - Just m -> depth * m - Nothing -> depth - AccountField -> formatText ljust min max acctname - TotalField -> T.pack . fst $ showMixed showAmountWithoutPrice min max (color_ opts) total - _ -> "" - --- | 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 :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> T.Text -renderComponent1 _ _ (FormatLiteral s) = s -renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field) = case field of - AccountField -> formatText ljust min max . T.intercalate ", " . T.lines $ indented 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 = ((T.replicate (depth*2) " ")<>) - TotalField -> T.pack . fst $ showMixedOneLine showAmountWithoutPrice min max (color_ opts) total - _ -> "" +renderComponent :: Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell +renderComponent _ _ _ (FormatLiteral s) = Cell TopLeft . map (\x -> (x, textWidth x)) $ T.lines s +renderComponent topaligned opts (acctname, depth, total) (FormatField ljust mmin mmax field) = case field of + DepthSpacerField -> Cell align [(T.replicate d " ", d)] + where d = maybe id min mmax $ depth * fromMaybe 1 mmin + AccountField -> Cell align [(t, textWidth t)] where t = formatText ljust mmin mmax acctname + TotalField -> Cell align . pure . first T.pack $ showMixed showAmountWithoutPrice mmin mmax (color_ opts) total + _ -> Cell align [("", 0)] + where align = if topaligned then (if ljust then TopLeft else TopRight) + else (if ljust then BottomLeft else BottomRight) -- rendering multi-column balance reports diff --git a/hledger/test/amount-rendering.test b/hledger/test/amount-rendering.test index 3b6905307..fd3f27117 100644 --- a/hledger/test/amount-rendering.test +++ b/hledger/test/amount-rendering.test @@ -40,7 +40,7 @@ hledger -f - balance -N >>> EUR 1 a USD 1 b - EUR -1 + EUR -1 USD -1 c >>>=0 diff --git a/hledger/test/balance/bcexample.test b/hledger/test/balance/bcexample.test index 955e0b67c..0c45f4d7e 100644 --- a/hledger/test/balance/bcexample.test +++ b/hledger/test/balance/bcexample.test @@ -3,27 +3,27 @@ $ hledger -f bcexample.hledger bal -t -1 --color=always > - 70.00 GLD - 17.00 ITOT -489.957000000000 RGAGX - 5716.53 USD - 337.26 VACHR -309.950000000000 VBMPX - 36.00 VEA + 70.00 GLD + 17.00 ITOT +489.957000000000 RGAGX + 5716.53 USD + 337.26 VACHR +309.950000000000 VBMPX + 36.00 VEA 294.00 VHT Assets -3077.70 USD Equity - 52000.00 IRAUSD + 52000.00 IRAUSD 260911.70 USD Expenses - -52000.00 IRAUSD - -365071.44 USD + -52000.00 IRAUSD + -365071.44 USD -337.26 VACHR Income -2891.85 USD Liabilities -------------------- - 70.00 GLD - 17.00 ITOT -489.957000000000 RGAGX - -104412.76 USD -309.950000000000 VBMPX - 36.00 VEA - 294.00 VHT + 70.00 GLD + 17.00 ITOT +489.957000000000 RGAGX + -104412.76 USD +309.950000000000 VBMPX + 36.00 VEA + 294.00 VHT >=0 diff --git a/hledger/test/journal/scientific.test b/hledger/test/journal/scientific.test index 62fbe82b1..3010f9a1e 100644 --- a/hledger/test/journal/scientific.test +++ b/hledger/test/journal/scientific.test @@ -68,7 +68,7 @@ hledger -f - bal --no-total (a) 1.00005e (a) 2.00003E >>> - 2.00003E + 2.00003E 1.00005e a >>>=0 diff --git a/hledger/test/journal/transaction-prices.test b/hledger/test/journal/transaction-prices.test index 12a38d58b..eff5c3be4 100644 --- a/hledger/test/journal/transaction-prices.test +++ b/hledger/test/journal/transaction-prices.test @@ -122,7 +122,7 @@ hledger -f - balance -10£ a 16$ b -------------------- - 16$ + 16$ -10£ >>>=0