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.
This commit is contained in:
Simon Michael 2015-08-19 20:28:24 -07:00
parent 7aecbac851
commit cc98ee39f7
9 changed files with 215 additions and 123 deletions

View File

@ -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

View File

@ -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

View File

@ -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"
]
])
]

View File

@ -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

View File

@ -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

View File

@ -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 [])

View File

@ -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

View File

@ -10,6 +10,6 @@ hledger -f sample.journal balance --format="%30(account) %-.20(total)"
gifts $-1
salary $-1
liabilities:debts $1
--------------------
0
----------------------------------
0
>>>= 0

View File

@ -40,7 +40,7 @@ hledger -f - balance
>>>
EUR 1 a
USD 1 b
EUR -1
EUR -1
USD -1 c
--------------------
0