diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 7ca7403ab..fd8732054 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 47a9f32ef..0a5828fab 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 675995d2a..5db8129ed 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] @@ -152,7 +153,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 d756eb57c..9cb9e9201 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] -renderHLine' :: [Int] -> Char -> Header String -> String -renderHLine' is sep h = [ '+', sep ] ++ coreLine ++ [sep, '+'] +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' :: 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 diff --git a/hledger/doc/balance.m4.md b/hledger/doc/balance.m4.md index 211470c7b..bff5fa224 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. diff --git a/tests/balance/pretty.test b/tests/balance/pretty.test new file mode 100644 index 000000000..480aef94d --- /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 diff --git a/tests/balancesheet/pretty.test b/tests/balancesheet/pretty.test new file mode 100644 index 000000000..d95eddf38 --- /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