balance: wide-char-aware multicolumn reports (#242)

hledger-lib/Text/Tabular/AsciiWide.hs

@@ -0,0 +1,75 @@
+-- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat
+-- wide characters as double width.
+
+module Text.Tabular.AsciiWide where
+
+import Data.List (intersperse, transpose)
+import Text.Tabular
+import Hledger.Utils.String
+
+-- | for simplicity, we assume that each cell is rendered
+--   on a single line
+render :: (rh -> String)
+       -> (ch -> String)
+       -> (a -> String)
+       -> Table rh ch a
+       -> String
+render fr fc f (Table rh ch cells) =
+  unlines $ [ bar SingleLine   -- +--------------------------------------+
+            , renderColumns sizes ch2
+            , bar DoubleLine   -- +======================================+
+            ] ++
+            (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++
+            [ bar SingleLine ] -- +--------------------------------------+
+ where
+  bar = concat . renderHLine 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
+                    [ Header h
+                    , fmap fst $ zipHeader "" (map f cs) ch]
+  rhStrings = map fr $ headerContents rh
+  -- maximum width for each column
+  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
+
+-- | We stop rendering on the shortest list!
+renderColumns :: [Int] -- ^ max width for each column
+              -> Header String
+              -> String
+renderColumns is h = "| " ++ coreLine ++ " |"
+ where
+  coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h
+  helper = either hsep (uncurry padLeftWide)
+  hsep :: Properties -> String
+  hsep NoLine     = " "
+  hsep SingleLine = " | "
+  hsep DoubleLine = " || "
+
+renderHLine :: [Int] -- ^ width specifications
+            -> Header String
+            -> Properties
+            -> [String]
+renderHLine _ _ NoLine = []
+renderHLine w h SingleLine = [renderHLine' w '-' h]
+renderHLine w h DoubleLine = [renderHLine' w '=' h]
+
+renderHLine' :: [Int] -> Char -> Header String -> String
+renderHLine' is sep h = [ '+', sep ] ++ coreLine ++ [sep, '+']
+ 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]
+
+-- padLeft :: Int -> String -> String
+-- padLeft l s = padding ++ s
+--  where padding = replicate (l - length s) ' '
+

hledger/Hledger/Cli/Balance.hs

@@ -250,7 +250,7 @@ import Text.CSV
 import Test.HUnit
 import Text.Printf (printf)
 import Text.Tabular as T
-import Text.Tabular.AsciiArt
+import Text.Tabular.AsciiWide
 
 import Hledger
 import Hledger.Cli.CliOptions
@@ -470,7 +470,7 @@ periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotal
    render id (" "++) showMixedAmountOneLineWithoutPrice $
     addtotalrow $
      Table
-     (T.Group NoLine $ map (Header . padright acctswidth) accts)
+     (T.Group NoLine $ map (Header . padRightWide acctswidth) accts)
      (T.Group NoLine $ map Header colheadings)
      (map rowvals items')
   where
@@ -484,7 +484,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 strWidth accts
     rowvals (_,as,rowtot,rowavg) = as
                                    ++ (if row_total_ opts then [rowtot] else [])
                                    ++ (if average_ opts then [rowavg] else [])
@@ -504,7 +504,7 @@ cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt
    render id (" "++) showMixedAmountOneLineWithoutPrice $
     addtotalrow $
      Table
-       (T.Group NoLine $ map (Header . padright acctswidth) accts)
+       (T.Group NoLine $ map (Header . padRightWide acctswidth) accts)
        (T.Group NoLine $ map Header colheadings)
        (map rowvals items)
   where
@@ -516,7 +516,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 strWidth accts
     rowvals (_,as,rowtot,rowavg) = as
                                    ++ (if row_total_ opts then [rowtot] else [])
                                    ++ (if average_ opts then [rowavg] else [])
@@ -536,7 +536,7 @@ historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (colt
    render id (" "++) showMixedAmountOneLineWithoutPrice $
     addtotalrow $
      Table
-       (T.Group NoLine $ map (Header . padright acctswidth) accts)
+       (T.Group NoLine $ map (Header . padRightWide acctswidth) accts)
        (T.Group NoLine $ map Header colheadings)
        (map rowvals items)
   where
@@ -548,7 +548,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 strWidth accts
     rowvals (_,as,rowtot,rowavg) = as
                              ++ (if row_total_ opts then [rowtot] else [])
                              ++ (if average_ opts then [rowavg] else [])