From cc98ee39f7126536816c3961de02925d4e573180 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 19 Aug 2015 20:28:24 -0700 Subject: [PATCH] balance, lib: --format/StringFormat improvements The balance command's --format option (in single-column mode) can now adjust the rendering of multi-line strings, such as amounts with multiple commodities. To control this, begin the format string with one of: %_ - renders on multiple lines, bottom-aligned (the default) %^ - renders on multiple lines, top-aligned %, - render on one line, comma-separated Also the final total (and the line above it) now adapt themselves to a custom format. --- doc/manual.md | 23 +++- hledger-lib/Hledger/Data.hs | 4 + hledger-lib/Hledger/Data/StringFormat.hs | 166 +++++++++++++---------- hledger-lib/Hledger/Utils.hs | 5 + hledger-lib/Hledger/Utils/String.hs | 30 +++- hledger/Hledger/Cli/Balance.hs | 101 ++++++++------ hledger/Hledger/Cli/Options.hs | 3 +- tests/balance/format.test | 4 +- tests/misc/amount-rendering.test | 2 +- 9 files changed, 215 insertions(+), 123 deletions(-) diff --git a/doc/manual.md b/doc/manual.md index b57f2b368..57122312d 100644 --- a/doc/manual.md +++ b/doc/manual.md @@ -1612,12 +1612,29 @@ must be enclosed in parentheses. Three are available: - `account` - the account's name - `total` - the account's balance/sum of postings -Some examples: +When the total has multiple commodities, by default each commodity is +displayed on a separate line, and the report item will be bottom +aligned. You can change how such multi-line values are rendered by +beginning the format with a special prefix: + +- `%_` - render on multiple lines, bottom-aligned (the default) +- `%^` - render on multiple lines, top-aligned +- `%,` - render on one line, with multi-line values comma-separated + +There are some quirks: + +- In one-line mode, `%(depth_spacer)` has no effect, instead `%(account)` has indentation built in. +- Consistent column widths are not well enforced, causing ragged edges unless you set suitable widths. +- Beware of specifying a maximum width; it will clip account names and amounts that are too wide, with no visible indication. + +Some experimentation may be needed to get pleasing output. + +Examples: - `%(total)` - the account's total - `%-20.20(account)` - the account's name, left justified, padded to 20 characters and clipped at 20 characters - -The balance command's default format is `%20(total) %2(depth_spacer)%-(account)`. +- `%20(total) %2(depth_spacer)%-(account)` - default format for the single-column balance report +- `%,%-50(account) %25(total)` - account name padded to 50 characters, total padded to 20 characters, with multiple commodities rendered on one line ##### Output destination diff --git a/hledger-lib/Hledger/Data.hs b/hledger-lib/Hledger/Data.hs index bd498add6..fcedc9824 100644 --- a/hledger-lib/Hledger/Data.hs +++ b/hledger-lib/Hledger/Data.hs @@ -17,6 +17,7 @@ module Hledger.Data ( module Hledger.Data.Ledger, module Hledger.Data.Posting, module Hledger.Data.RawOptions, + module Hledger.Data.StringFormat, module Hledger.Data.TimeLog, module Hledger.Data.Transaction, module Hledger.Data.Types, @@ -34,6 +35,7 @@ import Hledger.Data.Journal import Hledger.Data.Ledger import Hledger.Data.Posting import Hledger.Data.RawOptions +import Hledger.Data.StringFormat import Hledger.Data.TimeLog import Hledger.Data.Transaction import Hledger.Data.Types @@ -49,6 +51,8 @@ tests_Hledger_Data = TestList ,tests_Hledger_Data_Journal ,tests_Hledger_Data_Ledger ,tests_Hledger_Data_Posting + -- ,tests_Hledger_Data_RawOptions + -- ,tests_Hledger_Data_StringFormat ,tests_Hledger_Data_TimeLog ,tests_Hledger_Data_Transaction -- ,tests_Hledger_Data_Types diff --git a/hledger-lib/Hledger/Data/StringFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs index f1482c18b..c594d56df 100644 --- a/hledger-lib/Hledger/Data/StringFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -1,16 +1,15 @@ -- | Parse format strings provided by --format, with awareness of --- hledger's report item fields. Also provides a string formatting --- helper. +-- hledger's report item fields. The formats are used by +-- report-specific renderers like renderBalanceReportItem. {-# LANGUAGE FlexibleContexts #-} module Hledger.Data.StringFormat ( parseStringFormat - , formatString - , StringFormat + , defaultStringFormatStyle + , StringFormat(..) , StringFormatComponent(..) , ReportItemField(..) - -- , stringformatp , tests ) where @@ -21,42 +20,56 @@ import Data.Char (isPrint) import Data.Maybe import Test.HUnit import Text.Parsec -import Text.Printf (printf) +import Hledger.Utils.String (formatString) --- | A format specification/template to use when rendering report line items as text. --- (Currently supported by the balance command in single-column mode). -type StringFormat = [StringFormatComponent] - -data StringFormatComponent = - FormatLiteral String - | FormatField Bool -- Left justified ? - (Maybe Int) -- Min width - (Maybe Int) -- Max width - ReportItemField -- Field name +-- | A format specification/template to use when rendering a report line item as text. +-- +-- 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 +-- either single-line or a top or bottom-aligned multi-line string +-- depending on the StringFormat variant used. +-- +-- Currently this is only used in the balance command's single-column +-- mode, which provides a limited StringFormat renderer. +-- +data StringFormat = + 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 = + FormatLiteral String -- ^ Literal text to be rendered as-is + | FormatField Bool -- ^ Left justified if true, right justified if false + (Maybe Int) -- ^ Minimum width; will be space-padded if narrower than this + (Maybe Int) -- ^ Maximum width; will be clipped if wider than this + ReportItemField -- ^ One of several standard hledger report item fields to interpolate + deriving (Show, Eq) -- | An id identifying which report item field to interpolate. These -- are drawn from several hledger report types, so are not all -- applicable for a given report. data ReportItemField = - AccountField - | DefaultDateField - | DescriptionField - | TotalField - | DepthSpacerField - | FieldNo Int + AccountField -- ^ A posting or balance report item's account name + | DefaultDateField -- ^ A posting or register or entry report item's date + | DescriptionField -- ^ A posting or register or entry report item's description + | TotalField -- ^ A balance or posting report item's balance or running total + | DepthSpacerField -- ^ A balance report item's indent level (which may be different from the account name depth). + -- Rendered as this number of spaces, multiplied by the minimum width spec if any. + | FieldNo Int -- ^ A report item's nth field. May be unimplemented. deriving (Show, Eq) --- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it. -formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String -formatString leftJustified min max s = printf fmt s - where - l = if leftJustified then "-" else "" - min' = maybe "" show min - max' = maybe "" (\i -> "." ++ (show i)) max - fmt = "%" ++ l ++ min' ++ max' ++ "s" +---------------------------------------------------------------------- + +-- renderStringFormat :: StringFormat -> Map String String -> String +-- renderStringFormat fmt params = + +---------------------------------------------------------------------- -- | Parse a string format specification, or return a parse error. parseStringFormat :: String -> Either String StringFormat @@ -64,34 +77,24 @@ parseStringFormat input = case (runParser (stringformatp <* eof) () "(unknown)") Left y -> Left $ show y Right x -> Right x ----------------------------------------------------------------------- +defaultStringFormatStyle = BottomAligned -field :: Stream [Char] m Char => ParsecT [Char] st m ReportItemField -field = do - try (string "account" >> return AccountField) - <|> try (string "depth_spacer" >> return DepthSpacerField) - <|> try (string "date" >> return DescriptionField) - <|> try (string "description" >> return DescriptionField) - <|> try (string "total" >> return TotalField) - <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s)) +stringformatp :: Stream [Char] m Char => ParsecT [Char] st m StringFormat +stringformatp = do + alignspec <- optionMaybe (try $ char '%' >> oneOf "^_,") + let constructor = + case alignspec of + Just '^' -> TopAligned + Just '_' -> BottomAligned + Just ',' -> OneLine + _ -> defaultStringFormatStyle + constructor <$> many componentp -formatField :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent -formatField = do - char '%' - leftJustified <- optionMaybe (char '-') - minWidth <- optionMaybe (many1 $ digit) - maxWidth <- optionMaybe (do char '.'; many1 $ digit) -- TODO: Can this be (char '1') *> (many1 digit) - char '(' - f <- field - char ')' - return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f - where - parseDec s = case s of - Just text -> Just m where ((m,_):_) = readDec text - _ -> Nothing +componentp :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent +componentp = formatliteralp <|> formatfieldp -formatLiteral :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent -formatLiteral = do +formatliteralp :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent +formatliteralp = do s <- many1 c return $ FormatLiteral s where @@ -99,13 +102,29 @@ formatLiteral = do c = (satisfy isPrintableButNotPercentage "printable character") <|> try (string "%%" >> return '%') -formatp :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent -formatp = - formatField - <|> formatLiteral +formatfieldp :: Stream [Char] m Char => ParsecT [Char] st m StringFormatComponent +formatfieldp = do + char '%' + leftJustified <- optionMaybe (char '-') + minWidth <- optionMaybe (many1 $ digit) + maxWidth <- optionMaybe (do char '.'; many1 $ digit) -- TODO: Can this be (char '1') *> (many1 digit) + char '(' + f <- fieldp + char ')' + return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f + where + parseDec s = case s of + Just text -> Just m where ((m,_):_) = readDec text + _ -> Nothing -stringformatp :: Stream [Char] m Char => ParsecT [Char] st m StringFormat -stringformatp = many formatp +fieldp :: Stream [Char] m Char => ParsecT [Char] st m ReportItemField +fieldp = do + try (string "account" >> return AccountField) + <|> try (string "depth_spacer" >> return DepthSpacerField) + <|> try (string "date" >> return DescriptionField) + <|> try (string "description" >> return DescriptionField) + <|> try (string "total" >> return TotalField) + <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s)) ---------------------------------------------------------------------- @@ -135,18 +154,21 @@ formattingTests = [ ] parserTests = [ - testParser "" [] - , testParser "D" [FormatLiteral "D"] - , testParser "%(date)" [FormatField False Nothing Nothing DescriptionField] - , testParser "%(total)" [FormatField False Nothing Nothing TotalField] - , testParser "Hello %(date)!" [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"] - , testParser "%-(date)" [FormatField True Nothing Nothing DescriptionField] - , testParser "%20(date)" [FormatField False (Just 20) Nothing DescriptionField] - , testParser "%.10(date)" [FormatField False Nothing (Just 10) DescriptionField] - , testParser "%20.10(date)" [FormatField False (Just 20) (Just 10) DescriptionField] - , testParser "%20(account) %.10(total)\n" [ FormatField False (Just 20) Nothing AccountField + testParser "" (defaultStringFormatStyle []) + , testParser "D" (defaultStringFormatStyle [FormatLiteral "D"]) + , testParser "%(date)" (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField]) + , testParser "%(total)" (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField]) + , testParser "^%(total)" (TopAligned [FormatField False Nothing Nothing TotalField]) + , testParser "_%(total)" (BottomAligned [FormatField False Nothing Nothing TotalField]) + , testParser ",%(total)" (OneLine [FormatField False Nothing Nothing TotalField]) + , testParser "Hello %(date)!" (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]) + , testParser "%-(date)" (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField]) + , testParser "%20(date)" (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField]) + , testParser "%.10(date)" (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField]) + , testParser "%20.10(date)" (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField]) + , testParser "%20(account) %.10(total)\n" (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField , FormatLiteral " " , FormatField False Nothing (Just 10) TotalField , FormatLiteral "\n" - ] + ]) ] diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index aebb4c617..88f39f74c 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -127,3 +127,8 @@ readFile' name = do h <- openFile name ReadMode hSetNewlineMode h universalNewlineMode hGetContents h + +-- | Total version of maximum, for integral types, giving 0 for an empty list. +maximum' :: Integral a => [a] -> a +maximum' [] = 0 +maximum' xs = maximum xs diff --git a/hledger-lib/Hledger/Utils/String.hs b/hledger-lib/Hledger/Utils/String.hs index 8efce1b0b..41382e7fc 100644 --- a/hledger-lib/Hledger/Utils/String.hs +++ b/hledger-lib/Hledger/Utils/String.hs @@ -26,9 +26,12 @@ module Hledger.Utils.String ( chomp, elideLeft, elideRight, + formatString, -- * multi-line layout concatTopPadded, concatBottomPadded, + concatOneLine, + vConcatLeftAligned, vConcatRightAligned, padtop, padbottom, @@ -42,7 +45,7 @@ module Hledger.Utils.String ( import Data.Char import Data.List import Text.Parsec -import Text.Printf +import Text.Printf (printf) import Hledger.Utils.Parse import Hledger.Utils.Regex @@ -78,6 +81,16 @@ elideRight :: Int -> String -> String elideRight width s = if length s > width then take (width - 2) s ++ ".." else s +-- | 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). +formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String +formatString leftJustified minwidth maxwidth s = intercalate "\n" $ map (printf fmt) $ lines s + where + justify = if leftJustified then "-" else "" + minwidth' = maybe "" show minwidth + maxwidth' = maybe "" (("."++).show) maxwidth + fmt = "%" ++ justify ++ minwidth' ++ maxwidth' ++ "s" + underline :: String -> String underline s = s' ++ replicate (length s) '-' ++ "\n" where s' @@ -171,7 +184,20 @@ concatBottomPadded strs = intercalate "\n" $ map concat $ transpose padded | otherwise = maximum $ map length ls padded = map (xpad . ypad) lss --- | Compose strings vertically and right-aligned. + +-- | Join multi-line strings horizontally, after compressing each of +-- them to a single line with a comma and space between each original line. +concatOneLine :: [String] -> String +concatOneLine strs = concat $ map ((intercalate ", ").lines) strs + +-- | Join strings vertically, left-aligned and right-padded. +vConcatLeftAligned :: [String] -> String +vConcatLeftAligned ss = intercalate "\n" $ map showfixedwidth ss + where + showfixedwidth = printf (printf "%%-%ds" width) + width = maximum $ map length ss + +-- | Join strings vertically, right-aligned and left-padded. vConcatRightAligned :: [String] -> String vConcatRightAligned ss = intercalate "\n" $ map showfixedwidth ss where diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 7073d85d8..ba9f7fc8d 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -242,9 +242,9 @@ module Hledger.Cli.Balance ( ,tests_Hledger_Cli_Balance ) where -import Data.List (sort) +import Data.List (intercalate, sort) import Data.Time.Calendar (Day) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import System.Console.CmdArgs.Explicit as C import Text.CSV import Test.HUnit @@ -253,7 +253,6 @@ import Text.Tabular as T import Text.Tabular.AsciiArt import Hledger -import Hledger.Data.StringFormat import Hledger.Cli.Options import Hledger.Cli.Utils @@ -373,15 +372,26 @@ balanceReportAsCsv opts (items, total) = balanceReportAsText :: ReportOpts -> BalanceReport -> String balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t where - lines = case lineFormatFromOpts opts of + fmt = lineFormatFromOpts opts + lines = case fmt of Right fmt -> map (balanceReportItemAsText opts fmt) items Left err -> [[err]] t = if no_total_ opts then [] - else ["--------------------" - -- TODO: This must use the format somehow - ,padleft 20 $ showMixedAmountWithoutPrice total - ] + else + case fmt of + Right fmt -> + let + -- abuse renderBalanceReportItem to render the total with similar format + acctcolwidth = maximum' [length fullname | ((fullname, _, _), _) <- items] + totallines = map rstrip $ renderBalanceReportItem fmt (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 + | otherwise = 20 + overline = replicate overlinewidth '-' + in overline : totallines + Left _ -> [] tests_balanceReportAsText = [ "balanceReportAsText" ~: do @@ -409,45 +419,54 @@ This implementation turned out to be a bit convoluted but implements the followi b USD -1 ; Account 'b' has two amounts. The account name is printed on the last line. -} -- | Render one balance report line item as plain text suitable for console output (or --- whatever string format is specified). +-- 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 -> StringFormat -> BalanceReportItem -> [String] balanceReportItemAsText opts fmt ((_, accountName, depth), amt) = - let - accountName' = maybeAccountNameDrop opts accountName - -- 'amounts' could contain several quantities of the same commodity with different price. - -- In order to combine them into single value (which is expected) we take the first price and - -- use it for the whole mixed amount. This could be suboptimal. XXX - amt' = normaliseMixedAmountSquashPricesForDisplay amt - in - formatBalanceReportItem fmt (accountName', depth, amt') + renderBalanceReportItem fmt ( + maybeAccountNameDrop opts accountName, + depth, + normaliseMixedAmountSquashPricesForDisplay amt + ) -- | Render a balance report item using the given StringFormat, generating one or more lines of text. -formatBalanceReportItem :: StringFormat -> (AccountName, Int, MixedAmount) -> [String] -formatBalanceReportItem [] _ = [""] -formatBalanceReportItem fmt (acctname, depth, Mixed amts) = - case amts of - [] -> [] - [a] -> [formatLine fmt (Just acctname, depth, a)] - (a:as) -> [formatLine fmt (Just acctname, depth, a)] ++ - [formatLine fmt (Nothing, depth, a) | a <- as] +renderBalanceReportItem :: StringFormat -> (AccountName, Int, MixedAmount) -> [String] +renderBalanceReportItem 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)) --- | Render one line of a balance report item using the given StringFormat, maybe omitting the account name. -formatLine :: StringFormat -> (Maybe AccountName, Int, Amount) -> String -formatLine [] _ = "" -formatLine (fmt:fmts) (macctname, depth, amount) = - formatComponent fmt (macctname, depth, amount) ++ - formatLine fmts (macctname, depth, amount) - --- | Render one StringFormat component of one line of a balance report item. -formatComponent :: StringFormatComponent -> (Maybe AccountName, Int, Amount) -> String -formatComponent (FormatLiteral s) _ = s -formatComponent (FormatField ljust min max field) (macctname, depth, total) = case field of +-- | 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 DepthSpacerField -> formatString ljust Nothing max $ replicate d ' ' where d = case min of Just m -> depth * m Nothing -> depth - AccountField -> formatString ljust min max $ fromMaybe "" macctname - TotalField -> formatString ljust min max $ showAmountWithoutPrice total + AccountField -> formatString ljust min max acctname + TotalField -> formatString ljust min max $ showMixedAmountWithoutPrice 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 :: (AccountName, Int, MixedAmount) -> StringFormatComponent -> String +renderComponent1 _ (FormatLiteral s) = s +renderComponent1 (acctname, depth, total) (FormatField ljust min max field) = case field of + AccountField -> formatString ljust min max ((intercalate ", " . 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 = ((replicate (depth*2) ' ')++) + TotalField -> formatString ljust min max $ ((intercalate ", " . map strip . lines) (showMixedAmountWithoutPrice total)) _ -> "" -- multi-column balance reports @@ -511,7 +530,7 @@ periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotal renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum $ map length $ accts + acctswidth = maximum' $ map length $ accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else []) @@ -543,7 +562,7 @@ cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum $ map length $ accts + acctswidth = maximum' $ map length $ accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else []) @@ -575,7 +594,7 @@ historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a - acctswidth = maximum $ map length $ accts + acctswidth = maximum' $ map length $ accts rowvals (_,as,rowtot,rowavg) = as ++ (if row_total_ opts then [rowtot] else []) ++ (if average_ opts then [rowavg] else []) diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index df29e954b..0619a1ebf 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -81,7 +81,6 @@ import Test.HUnit import Text.Parsec import Hledger -import Hledger.Data.StringFormat as StringFormat import Hledger.Cli.Version @@ -472,7 +471,7 @@ lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . -- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)" defaultBalanceLineFormat :: StringFormat -defaultBalanceLineFormat = [ +defaultBalanceLineFormat = BottomAligned [ FormatField False (Just 20) Nothing TotalField , FormatLiteral " " , FormatField True (Just 2) Nothing DepthSpacerField diff --git a/tests/balance/format.test b/tests/balance/format.test index cd79a823b..bee3a52c9 100644 --- a/tests/balance/format.test +++ b/tests/balance/format.test @@ -10,6 +10,6 @@ hledger -f sample.journal balance --format="%30(account) %-.20(total)" gifts $-1 salary $-1 liabilities:debts $1 --------------------- - 0 +---------------------------------- + 0 >>>= 0 diff --git a/tests/misc/amount-rendering.test b/tests/misc/amount-rendering.test index 160e17da3..dc13dfd04 100644 --- a/tests/misc/amount-rendering.test +++ b/tests/misc/amount-rendering.test @@ -40,7 +40,7 @@ hledger -f - balance >>> EUR 1 a USD 1 b - EUR -1 + EUR -1 USD -1 c -------------------- 0