From 6d080168ad8b6a49f65d80a054aafdbef066a3a2 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Tue, 28 Mar 2017 22:22:11 +0200 Subject: [PATCH 1/4] Add an option to use unicode in balance tables fixes #522 --- hledger-lib/Hledger/Reports/ReportOptions.hs | 3 + hledger/Hledger/Cli/Balance.hs | 9 +-- hledger/Hledger/Cli/BalanceView.hs | 2 +- hledger/Text/Tabular/AsciiWide.hs | 72 +++++++++++++++----- 4 files changed, 63 insertions(+), 23 deletions(-) diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 9c438dbec93..f7a9f1a644a 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -91,6 +91,7 @@ data ReportOpts = ReportOpts { ,row_total_ :: Bool ,no_total_ :: Bool ,value_ :: Bool + ,pretty_tables_ :: Bool } deriving (Show, Data, Typeable) instance Default ReportOpts where def = defreportopts @@ -118,6 +119,7 @@ defreportopts = ReportOpts def def def + def rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = checkReportOpts <$> do @@ -144,6 +146,7 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do ,row_total_ = boolopt "row-total" rawopts' ,no_total_ = boolopt "no-total" rawopts' ,value_ = boolopt "value" rawopts' + ,pretty_tables_ = boolopt "pretty-tables" rawopts' } -- | 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 47a9f32ef99..0a5828fabc5 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -280,6 +280,7 @@ balancemode = (defCommandMode $ ["balance"] ++ aliases) { -- also accept but don ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "omit N leading account name parts (in flat mode)" ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "don't squash boring parent accounts (in tree mode)" ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)" + ,flagNone ["pretty-tables"] (\opts -> setboolopt "pretty-tables" opts) "use unicode when displaying tables" ] ++ outputflags ,groupHidden = [] @@ -475,7 +476,7 @@ multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String multiBalanceReportAsText opts r = printf "%s in %s:" typeStr (showDateSpan $ multiBalanceReportSpan r) ++ "\n" - ++ renderBalanceReportTable tabl + ++ renderBalanceReportTable opts tabl where tabl = balanceReportAsTable opts r typeStr :: String @@ -487,9 +488,9 @@ multiBalanceReportAsText opts r = -- | Given a table representing a multi-column balance report (for example, -- made using 'balanceReportAsTable'), render it in a format suitable for -- console output. -renderBalanceReportTable :: Table String String MixedAmount -> String -renderBalanceReportTable = unlines . trimborder . lines - . render id (" " ++) showMixedAmountOneLineWithoutPrice +renderBalanceReportTable :: ReportOpts -> Table String String MixedAmount -> String +renderBalanceReportTable (ReportOpts { pretty_tables_ = pretty }) = unlines . trimborder . lines + . render pretty id (" " ++) showMixedAmountOneLineWithoutPrice . align where trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init) diff --git a/hledger/Hledger/Cli/BalanceView.hs b/hledger/Hledger/Cli/BalanceView.hs index 675995d2a94..6af98a6c126 100644 --- a/hledger/Hledger/Cli/BalanceView.hs +++ b/hledger/Hledger/Cli/BalanceView.hs @@ -152,7 +152,7 @@ balanceviewReport BalanceView{..} CliOpts{reportopts_=ropts, rawopts_=raw} j = d ) putStrLn bvtitle mapM_ putStrLn balanceclarification - putStrLn $ renderBalanceReportTable totTabl + putStrLn $ renderBalanceReportTable ropts totTabl where overwriteBalanceType = case reverse $ filter (`elem` ["change","cumulative","historical"]) $ map fst raw of diff --git a/hledger/Text/Tabular/AsciiWide.hs b/hledger/Text/Tabular/AsciiWide.hs index d756eb57c0e..9cb9e9201e3 100644 --- a/hledger/Text/Tabular/AsciiWide.hs +++ b/hledger/Text/Tabular/AsciiWide.hs @@ -9,26 +9,27 @@ import Hledger.Utils.String -- | for simplicity, we assume that each cell is rendered -- on a single line -render :: (rh -> String) +render :: Bool -- ^ pretty tables + -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String -render fr fc f (Table rh ch cells) = +render pretty fr fc f (Table rh ch cells) = unlines $ [ bar SingleLine -- +--------------------------------------+ - , renderColumns sizes ch2 + , renderColumns pretty sizes ch2 , bar DoubleLine -- +======================================+ ] ++ (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++ [ bar SingleLine ] -- +--------------------------------------+ where - bar = concat . renderHLine sizes ch2 + bar = concat . renderHLine pretty sizes ch2 -- ch2 and cell2 include the row and column labels ch2 = Group DoubleLine [Header "", fmap fc ch] cells2 = headerContents ch2 : zipWith (\h cs -> h : map f cs) rhStrings cells -- - renderR (cs,h) = renderColumns sizes $ Group DoubleLine + renderR (cs,h) = renderColumns pretty sizes $ Group DoubleLine [ Header h , fmap fst $ zipHeader "" (map f cs) ch] rhStrings = map fr $ headerContents rh @@ -36,38 +37,73 @@ render fr fc f (Table rh ch cells) = sizes = map (maximum . map strWidth) . transpose $ cells2 renderRs (Header s) = [s] renderRs (Group p hs) = concat . intersperse sep . map renderRs $ hs - where sep = renderHLine sizes ch2 p + where sep = renderHLine pretty sizes ch2 p + +verticalBar :: Bool -> Char +verticalBar pretty = if pretty then '│' else '|' + +leftBar :: Bool -> String +leftBar pretty = verticalBar pretty : " " + +rightBar :: Bool -> String +rightBar pretty = " " ++ [verticalBar pretty] + +midBar :: Bool -> String +midBar pretty = " " ++ verticalBar pretty : " " + +doubleMidBar :: Bool -> String +doubleMidBar pretty = if pretty then " ║ " else " || " + +horizontalBar :: Bool -> Char +horizontalBar pretty = if pretty then '─' else '-' + +doubleHorizontalBar :: Bool -> Char +doubleHorizontalBar pretty = if pretty then '═' else '=' -- | We stop rendering on the shortest list! -renderColumns :: [Int] -- ^ max width for each column +renderColumns :: Bool -- ^ pretty + -> [Int] -- ^ max width for each column -> Header String -> String -renderColumns is h = "| " ++ coreLine ++ " |" +renderColumns pretty is h = leftBar pretty ++ coreLine ++ rightBar pretty where coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h helper = either hsep (uncurry padLeftWide) hsep :: Properties -> String hsep NoLine = " " - hsep SingleLine = " | " - hsep DoubleLine = " || " + hsep SingleLine = midBar pretty + hsep DoubleLine = doubleMidBar pretty -renderHLine :: [Int] -- ^ width specifications +renderHLine :: Bool -- ^ pretty + -> [Int] -- ^ width specifications -> Header String -> Properties -> [String] -renderHLine _ _ NoLine = [] -renderHLine w h SingleLine = [renderHLine' w '-' h] -renderHLine w h DoubleLine = [renderHLine' w '=' h] +renderHLine _ _ _ NoLine = [] +renderHLine pretty w h SingleLine = [renderHLine' pretty SingleLine w (horizontalBar pretty) h] +renderHLine pretty w h DoubleLine = [renderHLine' pretty DoubleLine w (doubleHorizontalBar pretty) h] + +doubleCross :: Bool -> String +doubleCross pretty = if pretty then "╬" else "++" + +doubleVerticalCross :: Bool -> String +doubleVerticalCross pretty = if pretty then "╫" else "++" + +cross :: Bool -> Char +cross pretty = if pretty then '┼' else '+' -renderHLine' :: [Int] -> Char -> Header String -> String -renderHLine' is sep h = [ '+', sep ] ++ coreLine ++ [sep, '+'] +renderHLine' :: Bool -> Properties -> [Int] -> Char -> Header String -> String +renderHLine' pretty prop is sep h = [ cross pretty, sep ] ++ coreLine ++ [sep, cross pretty] where coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h helper = either vsep dashes dashes (i,_) = replicate i sep vsep NoLine = [sep] - vsep SingleLine = sep : "+" ++ [sep] - vsep DoubleLine = sep : "++" ++ [sep] + vsep SingleLine = sep : cross pretty : [sep] + vsep DoubleLine = sep : cross' ++ [sep] + cross' = case prop of + DoubleLine -> doubleCross pretty + _ -> doubleVerticalCross pretty -- padLeft :: Int -> String -> String -- padLeft l s = padding ++ s From 578f5923d8caaaac3e838bf01b8bc0477f2bff81 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Wed, 29 Mar 2017 19:44:08 +0200 Subject: [PATCH 2/4] Add a test for unicode tables --- tests/balance/pretty.test | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 tests/balance/pretty.test diff --git a/tests/balance/pretty.test b/tests/balance/pretty.test new file mode 100644 index 00000000000..480aef94d14 --- /dev/null +++ b/tests/balance/pretty.test @@ -0,0 +1,13 @@ +hledger -f balance-multicol.journal balance --pretty-tables -M +>>> +Balance changes in 2012/12/01-2013/03/31: + + ║ 2012/12 2013/01 2013/02 2013/03 +═════════════════╬═════════════════════════════════════ + assets ║ 0 0 1 0 + assets:cash ║ 0 0 1 0 + assets:checking ║ 10 0 0 1 +─────────────────╫───────────────────────────────────── + ║ 10 0 2 1 + +>>>=0 From 8af41cecf7dd8ef582dbe8b8320c16d3688c2d45 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Wed, 29 Mar 2017 19:46:08 +0200 Subject: [PATCH 3/4] Document --pretty-tables --- hledger/doc/balance.m4.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/hledger/doc/balance.m4.md b/hledger/doc/balance.m4.md index 211470c7bbb..bff5fa22432 100644 --- a/hledger/doc/balance.m4.md +++ b/hledger/doc/balance.m4.md @@ -41,6 +41,9 @@ txt, csv. `-o FILE --output-file=FILE` : write output to FILE. A file extension matching one of the above formats selects that format. +`--pretty-tables` +: Use unicode to display prettier tables. + The balance command displays accounts and balances. It is hledger's most featureful and most useful command. From 7b5074f79964e3d0c64cac0153a61ac01e51ccd5 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Wed, 29 Mar 2017 19:54:18 +0200 Subject: [PATCH 4/4] Support --pretty-tables in BalanceView --- hledger/Hledger/Cli/BalanceView.hs | 1 + tests/balancesheet/pretty.test | 27 +++++++++++++++++++++++++++ 2 files changed, 28 insertions(+) create mode 100644 tests/balancesheet/pretty.test diff --git a/hledger/Hledger/Cli/BalanceView.hs b/hledger/Hledger/Cli/BalanceView.hs index 6af98a6c126..5db8129edfe 100644 --- a/hledger/Hledger/Cli/BalanceView.hs +++ b/hledger/Hledger/Cli/BalanceView.hs @@ -60,6 +60,7 @@ balanceviewmode BalanceView{..} = (defCommandMode $ bvmode : bvaliases) { ,flagNone ["row-total","T"] (\opts -> setboolopt "row-total" opts) "show a row total column (in multicolumn reports)" ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "don't squash boring parent accounts (in tree mode)" ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)" + ,flagNone ["pretty-tables"] (\opts -> setboolopt "pretty-tables" opts) "use unicode when displaying tables" ] ,groupHidden = [] ,groupNamed = [generalflagsgroup1] diff --git a/tests/balancesheet/pretty.test b/tests/balancesheet/pretty.test new file mode 100644 index 00000000000..d95eddf38d1 --- /dev/null +++ b/tests/balancesheet/pretty.test @@ -0,0 +1,27 @@ +# 1. +hledger -f - balancesheet -M --pretty-tables +<<< +2016/1/1 + assets 1 + b +>>> +Balance Sheet + + ║ 2016/01/31 +═════════════╬═════════════ + Assets ║ +─────────────╫───────────── + assets ║ 1 +─────────────╫───────────── + ║ 1 +═════════════╬═════════════ + Liabilities ║ +─────────────╫───────────── +─────────────╫───────────── + ║ +═════════════╬═════════════ + Total ║ + + +>>>2 +>>>= 0