Add an option to use unicode in balance tables (#528)

* Add an option to use unicode in balance tables

fixes #522

* Add a test for unicode tables

* Document --pretty-tables

* Support --pretty-tables in BalanceView

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.

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)

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

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

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.
 

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

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