lib: renderTable can now receive alignment and width specifications on all cells, and has an option to display the outer border.

This gives renderTable a little more customisation. Before any of the
commits of this PR, render would just receive a string to display in
each cell. After the second commit of this PR it would also receive a
width of the string (in place of stripping ANSI sequences and then
calculating the width). After this commit, it now also takes an
alignment, so you can make cells left or right aligned. The function
render calls renderTable with appropriate options to give the same
behaviour as before. Also, previously render would always put a border
around the table. We would take this output, and would sometimes strip
the border by dropping the first and last rows, and first and last
characters of every row. I've just added an option to control whether
to put the border in, so we can just not add it in the first place,
rather than stripping it later. Note that this is again just defining
helper functions; this extra power is not yet used anywhere.

hledger-lib/Hledger/Reports/BudgetReport.hs

@@ -44,6 +44,7 @@ import qualified Data.Text as T
 --import Lucid as L
 import Text.Printf (printf)
 import Text.Tabular as T
+import Text.Tabular.AsciiWide as T
 
 import Hledger.Data
 import Hledger.Utils
@@ -209,8 +210,9 @@ combineBudgetAndActual ropts j
 -- | Render a budget report as plain text suitable for console output.
 budgetReportAsText :: ReportOpts -> BudgetReport -> String
 budgetReportAsText ropts@ReportOpts{..} budgetr =
-  title ++ "\n\n" ++
+    title ++ "\n\n" ++
-  tableAsText ropts showcell (maybetranspose $ budgetReportAsTable ropts budgetr)
+    renderTable False pretty_tables_ leftCell rightCell showcell
+      (maybetranspose $ budgetReportAsTable ropts budgetr)
   where
     multiperiod = interval_ /= NoInterval
     title = printf "Budget performance in %s%s:"
@@ -232,8 +234,8 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
       where
         amountWidth = maybe 0 (length . showMixedAmountElided False)
     -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells
-    showcell :: BudgetCell -> String
+    showcell :: BudgetCell -> CellSpec
-    showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr
+    showcell (mactual, mbudget) = rightCell $ actualstr ++ " " ++ budgetstr
       where
         percentwidth = 4
         actual = fromMaybe 0 mactual

hledger-lib/Hledger/Reports/MultiBalanceReport.hs

@@ -19,10 +19,6 @@ module Hledger.Reports.MultiBalanceReport (
   compoundBalanceReport,
   compoundBalanceReportWith,
 
-  tableAsText,
-  trimBorder,
-  leftAlignRowHeaders,
-
   sortRows,
   sortRowsLike,
 
@@ -56,8 +52,6 @@ import Data.Semigroup ((<>))
 import Data.Semigroup (sconcat)
 import Data.Time.Calendar (Day, addDays, fromGregorian)
 import Safe (headMay, lastDef, lastMay)
-import Text.Tabular as T
-import Text.Tabular.AsciiWide (render)
 
 import Hledger.Data
 import Hledger.Query
@@ -596,22 +590,6 @@ dbg'  s = let p = "multiBalanceReport" in Hledger.Utils.dbg4 (p++" "++s)
 dbg'' s = let p = "multiBalanceReport" in Hledger.Utils.dbg5 (p++" "++s)
 -- dbg = const id  -- exclude this function from debug output
 
--- common rendering helper, XXX here for now
-tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String
-tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
-  trimBorder
-  . render pretty id id showcell
-  . leftAlignRowHeaders
-
-trimBorder :: String -> String
-trimBorder = unlines . map (drop 1 . init) . drop 1 . init . lines
-
-leftAlignRowHeaders :: Table String ch a -> Table String ch a
-leftAlignRowHeaders (Table l t d) = Table l' t d
-  where
-    acctswidth = maximum' $ map strWidth (headerContents l)
-    l'         = padRightWide acctswidth <$> l
-
 -- tests
 
 tests_MultiBalanceReport = tests "MultiBalanceReport" [

hledger-lib/Text/Tabular/AsciiWide.hs

@@ -8,38 +8,60 @@ import Text.Tabular
 import Hledger.Utils.String
 
 
+-- | Render a table according to common options, for backwards compatibility
 render :: Bool -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String
-render pretty fr fc f = renderTable pretty fr fc (\a -> let str = f a in (str, strWidth str))
+render pretty fr fc f = renderTable True pretty (rightCell . fr) (rightCell . fc) (rightCell . f)
 
-renderTable :: Bool -- ^ pretty tables
+-- | Render a table according to various cell specifications
-            -> (rh -> String)
+renderTable :: Bool              -- ^ Whether to display the outer borders
-            -> (ch -> String)
+            -> Bool              -- ^ Pretty tables
-            -> (a -> (String, Int))  -- ^ Function determining the string and width of a cell
+            -> (rh -> CellSpec)  -- ^ Rendering function for row headers
+            -> (ch -> CellSpec)  -- ^ Rendering function for column headers
+            -> (a -> CellSpec)   -- ^ Function determining the string and width of a cell
             -> Table rh ch a
             -> String
-renderTable pretty fr fc f (Table rh ch cells) =
+renderTable borders pretty fr fc f (Table rh ch cells) =
-  unlines $ [ bar VT SingleLine   -- +--------------------------------------+
+  unlines . addBorders $
-            , renderColumns pretty sizes ch2
+    [ renderColumns borders pretty sizes ch2
-            , bar VM DoubleLine   -- +======================================+
+    , bar VM DoubleLine   -- +======================================+
-            ] ++
+    ] ++
-            (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++
+    (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh)
-            [ bar VB SingleLine ] -- +--------------------------------------+
  where
-  bar vpos prop = concat (renderHLine vpos pretty sizes ch2 prop)
+  bar vpos prop = concat $ renderHLine vpos borders pretty sizes ch2 prop
   -- ch2 and cell2 include the row and column labels
-  ch2 = Group DoubleLine [Header "", fmap fc ch]
+  ch2 = Group DoubleLine [Header emptyCell, fmap fc ch]
-  cells2 = map (\h -> (h, strWidth h)) (headerContents ch2)
+  cells2 = headerContents ch2
-         : zipWith (\h cs -> (h, strWidth h) : map f cs) rhStrings cells
+         : zipWith (\h cs -> h : map f cs) rhStrings cells
   --
-  renderR (cs,h) = renderColumns pretty sizes $ Group DoubleLine
+  renderR (cs,h) = renderColumns borders pretty sizes $ Group DoubleLine
                     [ Header h
-                    , fmap fst $ zipHeader "" (map (fst . f) cs) ch]
+                    , fmap fst $ zipHeader emptyCell (map f cs) ch]
   rhStrings = map fr $ headerContents rh
   -- maximum width for each column
-  sizes   = map (maximum . map snd) $ transpose cells2
+  sizes   = map (maximum . map csWidth) $ transpose cells2
   renderRs (Header s)   = [s]
   renderRs (Group p hs) = concat . intersperse sep $ map renderRs hs
-    where sep = renderHLine VM pretty sizes ch2 p
+    where sep = renderHLine VM borders pretty sizes ch2 p
+  addBorders xs = if borders then bar VT SingleLine : xs ++ [bar VB SingleLine] else xs
+
+
+data CellSpec = CellSpec
+    { csString :: String
+    , csAlign  :: Align
+    , csWidth  :: Int
+    }
+
+emptyCell :: CellSpec
+emptyCell = CellSpec "" AlignRight 0
+
+rightCell :: String -> CellSpec
+rightCell x = CellSpec x AlignRight (strWidth x)
+
+leftCell :: String -> CellSpec
+leftCell x = CellSpec x AlignLeft (strWidth x)
+
+data Align = AlignLeft | AlignRight
+
 
 verticalBar :: Bool -> Char
 verticalBar pretty = if pretty then '│' else '|'
@@ -57,31 +79,38 @@ doubleMidBar :: Bool -> String
 doubleMidBar pretty = if pretty then " ║ " else " || "
 
 -- | We stop rendering on the shortest list!
-renderColumns :: Bool -- ^ pretty
+renderColumns :: Bool   -- ^ show outer borders
-              -> [Int] -- ^ max width for each column
+              -> Bool   -- ^ pretty
-              -> Header String
+              -> [Int]  -- ^ max width for each column
+              -> Header CellSpec
               -> String
-renderColumns pretty is h = leftBar pretty ++ coreLine ++ rightBar pretty
+renderColumns borders pretty is h = addBorders coreLine
  where
+  addBorders xs = if borders then leftBar pretty ++ xs ++ rightBar pretty else ' ' : xs ++ " "
   coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h
-  helper = either hsep (uncurry padLeftWide)
+  helper = either hsep (\(w, cs) -> case csAlign cs of
+                            AlignLeft  -> padRightWide w (csString cs)
+                            AlignRight -> padLeftWide  w (csString cs)
+                        )
   hsep :: Properties -> String
   hsep NoLine     = "  "
   hsep SingleLine = midBar pretty
   hsep DoubleLine = doubleMidBar pretty
 
 renderHLine :: VPos
+            -> Bool  -- ^ show outer borders
             -> Bool -- ^ pretty
             -> [Int] -- ^ width specifications
-            -> Header String
+            -> Header a
             -> Properties
             -> [String]
-renderHLine _ _ _ _ NoLine = []
+renderHLine _ _ _ _ _ NoLine = []
-renderHLine vpos pretty w h prop = [renderHLine' vpos pretty prop w h]
+renderHLine vpos borders pretty w h prop = [renderHLine' vpos borders pretty prop w h]
 
-renderHLine' :: VPos -> Bool -> Properties -> [Int] -> Header String -> String
+renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> String
-renderHLine' vpos pretty prop is h = edge HL ++ sep ++ coreLine ++ sep ++ edge HR
+renderHLine' vpos borders pretty prop is h = addBorders $ sep ++ coreLine ++ sep
  where
+  addBorders xs   = if borders then edge HL ++ xs ++ edge HR else xs
   edge hpos       = boxchar vpos hpos SingleLine prop pretty
   coreLine        = concatMap helper $ flattenHeader $ zipHeader 0 is h
   helper          = either vsep dashes

hledger/Hledger/Cli/Commands/Balance.hs

@@ -263,7 +263,7 @@ import System.Console.CmdArgs.Explicit as C
 import Lucid as L
 import Text.Printf (printf)
 import Text.Tabular as T
-import Text.Tabular.AsciiWide (renderWidth)
+import Text.Tabular.AsciiWide as T
 
 import Hledger
 import Hledger.Cli.CliOptions
@@ -610,9 +610,10 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
 -- unless --no-elide is used.
 balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String
 balanceReportTableAsText ReportOpts{..} =
-    trimBorder . renderWidth pretty_tables_ id id showamt . leftAlignRowHeaders
+    T.renderTable False pretty_tables_ T.leftCell T.rightCell showamt
   where
-    showamt = showMixedOneLine showAmountWithoutPrice Nothing mmax color_
+    showamt a = CellSpec str AlignRight w
+      where (str, w) = showMixedOneLine showAmountWithoutPrice Nothing mmax color_ a
     mmax = if no_elide_ then Nothing else Just 22