Switch to table-layout for tabular layout

hledger-lib/Hledger/Data/Account.hs

@@ -52,8 +52,8 @@ instance Show Account where
                        aname
                        (if aboring then "y" else "n" :: String)
                        anumpostings
-                       (wbUnpack $ showMixedAmountB noColour aebalance)
-                       (wbUnpack $ showMixedAmountB noColour aibalance)
+                       (buildCell $ showMixedAmountB noColour aebalance :: String)
+                       (buildCell $ showMixedAmountB noColour aibalance :: String)
 
 instance Eq Account where
   (==) a b = aname a == aname b -- quick equality test for speed
@@ -303,6 +303,6 @@ showAccountsBoringFlag = unlines . map (show . aboring) . flattenAccounts
 
 showAccountDebug a = printf "%-25s %4s %4s %s"
                      (aname a)
-                     (wbUnpack . showMixedAmountB noColour $ aebalance a)
-                     (wbUnpack . showMixedAmountB noColour $ aibalance a)
+                     (buildCell . showMixedAmountB noColour $ aebalance a :: String)
+                     (buildCell . showMixedAmountB noColour $ aibalance a :: String)
                      (if aboring a then "b" else " " :: String)

hledger-lib/Hledger/Data/Posting.hs

@@ -72,21 +72,16 @@ module Hledger.Data.Posting (
 )
 where
 
-import Data.Default (def)
 import Data.Foldable (asum)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.List (foldl', sort, union)
 import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Builder as TB
 import Data.Time.Calendar (Day)
 import Safe (maximumBound)
-import Text.DocLayout (realLength)
-
-import Text.Tabular.AsciiWide
+import Text.Layout.Table
 
 import Hledger.Utils
 import Hledger.Data.Types
@@ -159,13 +154,12 @@ balassertTotInc :: Amount -> Maybe BalanceAssertion
 balassertTotInc amt = Just $ nullassertion{baamount=amt, batotal=True, bainclusive=True}
 
 -- | Render a balance assertion, as the =[=][*] symbol and expected amount.
-showBalanceAssertion :: BalanceAssertion -> WideBuilder
+showBalanceAssertion :: BalanceAssertion -> RenderText
 showBalanceAssertion ba =
-    singleton '=' <> eq <> ast <> singleton ' ' <> showAmountB def{displayZeroCommodity=True} (baamount ba)
+    "=" <> eq <> ast <> " " <> showAmountB def{displayZeroCommodity=True} (baamount ba)
   where
-    eq  = if batotal ba     then singleton '=' else mempty
-    ast = if bainclusive ba then singleton '*' else mempty
-    singleton c = WideBuilder (TB.singleton c) 1
+    eq  = if batotal ba     then "=" else ""
+    ast = if bainclusive ba then "*" else ""
 
 -- Get the original posting, if any.
 originalPosting :: Posting -> Posting
@@ -236,22 +230,17 @@ postingAsLines elideamount onelineamounts acctwidth amtwidth p =
     -- is whether there are trailing spaces in print (and related) reports. This
     -- could be removed and we could just keep everything as a Text Builder, but
     -- would require adding trailing spaces to 42 failing tests.
-    postingblocks = [map T.stripEnd . T.lines . TL.toStrict $
-                       render [ textCell BottomLeft statusandaccount
-                              , textCell BottomLeft "  "
-                              , Cell BottomLeft [pad amt]
-                              , Cell BottomLeft [assertion]
-                              , textCell BottomLeft samelinecomment
-                              ]
-                    | amt <- shownAmounts]
-    render = renderRow def{tableBorders=False, borderSpaces=False} . Group NoLine . map Header
-    pad amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt
-      where w = max 12 amtwidth - wbWidth amt  -- min. 12 for backwards compatibility
-
-    assertion = maybe mempty ((WideBuilder (TB.singleton ' ') 1 <>).showBalanceAssertion) $ pbalanceassertion p
+    postingblocks = map (map T.stripEnd . T.lines) . gridLinesB colSpec $
+        case showBalanceAssertion <$> pbalanceassertion p of
+          Nothing   -> [ [statusandaccount, "", amt, renderText $ T.drop 1 samelinecomment] | amt <- shownAmounts ]
+          Just asst -> [ [statusandaccount, "", amt, asst, renderText $ T.drop 1 samelinecomment] | amt <- shownAmounts ]
+      where
+        colSpec = [col left expand, col left expand, col right . fixedUntil $ max 12 amtwidth, col left expand, col left expand]
+        col pos len = column len pos noAlign noCutMark
+
     -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned
-    statusandaccount = lineIndent . fitText (Just $ 2 + acctwidth) Nothing False True $ pstatusandacct p
-    thisacctwidth = realLength $ pacctstr p
+    statusandaccount = renderText . lineIndent . fitText (Just $ 2 + acctwidth) Nothing False True $ pstatusandacct p
+    thisacctwidth = visibleLength . renderText $ pacctstr p
 
     pacctstr p' = showAccountName Nothing (ptype p') (paccount p')
     pstatusandacct p' = pstatusprefix p' <> pacctstr p'
@@ -266,7 +255,7 @@ postingAsLines elideamount onelineamounts acctwidth amtwidth p =
     shownAmounts
       | elideamount = [mempty]
       | otherwise   = showMixedAmountLinesB noColour{displayOneLine=onelineamounts} $ pamount p
-    thisamtwidth = maximumBound 0 $ map wbWidth shownAmounts
+    thisamtwidth = maximumBound 0 $ map visibleLength shownAmounts
 
     (samelinecomment, newlinecomments) =
       case renderCommentLines (pcomment p) of []   -> ("",[])

hledger-lib/Hledger/Read/CsvReader.hs

@@ -1006,7 +1006,7 @@ getAmount rules record currency p1IsVirtual n =
         ] ++
         ["rule \"" <> f <> " " <>
           fromMaybe "" (hledgerField rules record f) <>
-          "\" assigned value \"" <> wbToText (showMixedAmountB noColour a) <> "\"" -- XXX not sure this is showing all the right info
+          "\" assigned value \"" <> buildCell (showMixedAmountB noColour a) <> "\"" -- XXX not sure this is showing all the right info
           | (f,a) <- fs
         ] ++
         [""

hledger-lib/Hledger/Reports/BudgetReport.hs

@@ -26,7 +26,7 @@ import Data.Decimal (roundTo)
 import Data.Function (on)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HM
-import Data.List (find, partition, transpose, foldl', maximumBy)
+import Data.List (find, intersperse, partition, transpose, foldl', maximumBy)
 import Data.List.Extra (nubSort)
 import Data.Maybe (fromMaybe, catMaybes, isJust)
 import Data.Map (Map)
@@ -37,9 +37,9 @@ import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TB
 import Safe (minimumDef)
+import Text.Layout.Table
 --import System.Console.CmdArgs.Explicit as C
 --import Lucid as L
-import qualified Text.Tabular.AsciiWide as Tab
 
 import Hledger.Data
 import Hledger.Utils
@@ -59,9 +59,9 @@ type BudgetCell = (Maybe Change, Maybe BudgetGoal)
 type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell
 type BudgetReport    = PeriodicReport    DisplayName BudgetCell
 
-type BudgetDisplayCell = (WideBuilder, Maybe (WideBuilder, Maybe WideBuilder))
+type BudgetDisplayCell = (RenderText, Maybe (RenderText, Maybe (RenderText)))
 type BudgetDisplayRow  = [BudgetDisplayCell]
-type BudgetShowMixed   = MixedAmount -> [WideBuilder]
+type BudgetShowMixed   = MixedAmount -> [RenderText]
 type BudgetPercBudget  = Change -> BudgetGoal -> [Maybe Percentage]
 
 -- | Calculate per-account, per-period budget (balance change) goals
@@ -256,7 +256,7 @@ combineBudgetAndActual ropts j
 budgetReportAsText :: ReportOpts -> BudgetReport -> TL.Text
 budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
     TB.fromText title <> TB.fromText "\n\n" <>
-      balanceReportTableAsText ropts (budgetReportAsTable ropts budgetr)
+      balanceReportTableAsText ropts (Right <$> budgetReportAsTable ropts budgetr)
   where
     title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
            <> (case conversionop_ of
@@ -271,21 +271,25 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
            <> ":"
 
 -- | Build a 'Table' from a multi-column balance report.
-budgetReportAsTable :: ReportOpts -> BudgetReport -> Tab.Table Text Text WideBuilder
+budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text (RenderText)
 budgetReportAsTable
   ReportOpts{..}
   (PeriodicReport spans items tr) =
     maybetransposetable $
     addtotalrow $
-    Tab.Table
-      (Tab.Group Tab.NoLine $ map Tab.Header accts)
-      (Tab.Group Tab.NoLine $ map Tab.Header colheadings)
+    Table
+      (makeHeader (if transpose_ then right else left) accts)
+      datesHeader
       rows
   where
-    colheadings = ["Commodity" | layout_ == LayoutBare]
-                  ++ map (reportPeriodName balanceaccum_ spans) spans
-                  ++ ["  Total" | row_total_]
-                  ++ ["Average" | average_]
+    datesHeader = case layout_ of
+      LayoutBare -> groupH NoLine [headerH (headerColumn left Nothing) "Commodity", colheadings]
+      _          -> colheadings
+    colheadings = makeHeader (if transpose_ then left else right) $
+                    map (reportPeriodName balanceaccum_ spans) spans
+                    ++ ["  Total" | row_total_]
+                    ++ ["Average" | average_]
+    makeHeader pos = fullSepH NoLine (repeat $ headerColumn pos Nothing)
 
     -- FIXME. Have to check explicitly for which to render here, since
     -- budgetReport sets accountlistmode to ALTree. Find a principled way to do
@@ -296,25 +300,25 @@ budgetReportAsTable
 
     addtotalrow
       | no_total_ = id
-      | otherwise = let rh = Tab.Group Tab.NoLine . replicate (length totalrows) $ Tab.Header ""
-                        ch = Tab.Header [] -- ignored
-                     in (flip (Tab.concatTables Tab.SingleLine) $ Tab.Table rh ch totalrows)
+      | otherwise = let rh = fullSepH NoLine (repeat $ headerColumn left Nothing) $ replicate (length totalrows) ""
+                        ch = noneH  -- ignored
+                     in (flip (concatTables SingleLine) $ Table rh ch totalrows)
 
     maybetranspose
       | transpose_ = transpose
       | otherwise  = id
 
     maybetransposetable
-      | transpose_ = \(Tab.Table rh ch vals) -> Tab.Table ch rh (transpose vals)
+      | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)
       | otherwise  = id
 
     (accts, rows, totalrows) = (accts, prependcs itemscs (padcells texts), prependcs trcs (padtr trtexts))
       where
-        shownitems :: [[(AccountName, WideBuilder, BudgetDisplayRow)]]
+        shownitems :: [[(AccountName, RenderText, BudgetDisplayRow)]]
         shownitems = (fmap (\i -> fmap (\(cs, cvals) -> (renderacct i, cs, cvals)) . showrow $ rowToBudgetCells i) items)
         (accts, itemscs, texts) = unzip3 $ concat shownitems
 
-        showntr    :: [[(WideBuilder, BudgetDisplayRow)]]
+        showntr    :: [[(RenderText, BudgetDisplayRow)]]
         showntr    = [showrow $ rowToBudgetCells tr]
         (trcs, trtexts)         = unzip  $ concat showntr
         trwidths
@@ -336,17 +340,19 @@ budgetReportAsTable
     -- functions for displaying budget cells depending on `commodity-layout_` option
     rowfuncs :: [CommoditySymbol] -> (BudgetShowMixed, BudgetPercBudget)
     rowfuncs cs = case layout_ of
-      LayoutWide width ->
-           ( pure . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=width}
-           , \a -> pure . percentage a)
-      _ -> ( showMixedAmountLinesB noPrice{displayOrder=Just cs, displayMinWidth=Nothing, displayColour=color_}
-           , \a b -> fmap (percentage' a b) cs)
+        -- For budget reports we do not use ElidableList, since we need to keep the budget goals displayed nicely
+        LayoutWide _ -> ( pure . mconcat . intersperse ", " . showMixedAmountLinesB dopts
+                        , \a -> pure . percentage a)
+        _ ->            ( showMixedAmountLinesB dopts{displayOrder=Just cs}
+                        , \a b -> fmap (percentage' a b) cs)
+      where
+        dopts = noPrice{displayColour=color_}
 
-    showrow :: [BudgetCell] -> [(WideBuilder, BudgetDisplayRow)]
+    showrow :: [BudgetCell] -> [(RenderText, BudgetDisplayRow)]
     showrow row =
       let cs = budgetCellsCommodities row
           (showmixed, percbudget) = rowfuncs cs
-       in   zip (fmap wbFromText cs)
+       in   zip (fmap renderText cs)
           . transpose
           . fmap (showcell showmixed percbudget)
           $ row
@@ -356,22 +362,21 @@ budgetReportAsTable
     budgetCellCommodities (am, bm) = f am `S.union` f bm
       where f = maybe mempty maCommodities
 
-    cellswidth :: [BudgetCell] -> [[(Int, Int, Int)]]
+    cellswidth :: [BudgetCell] -> [[(Int, Int)]]
     cellswidth row =
       let cs = budgetCellsCommodities row
           (showmixed, percbudget) = rowfuncs cs
           disp = showcell showmixed percbudget
-          budgetpercwidth = wbWidth *** maybe 0 wbWidth
-          cellwidth (am, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (wbWidth am, bw, pw)
+          budgetpercwidth = visibleLength *** maybe 0 visibleLength
+          cellwidth (_, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (bw, pw)
        in fmap (fmap cellwidth . disp) row
 
     -- build a list of widths for each column. In the case of transposed budget
     -- reports, the total 'row' must be included in this list
-    widths = zip3 actualwidths budgetwidths percentwidths
+    widths = zip budgetwidths percentwidths
       where
-        actualwidths  = map (maximum' . map first3 ) $ cols
-        budgetwidths  = map (maximum' . map second3) $ cols
-        percentwidths = map (maximum' . map third3 ) $ cols
+        budgetwidths  = map (maximum' . map fst) cols
+        percentwidths = map (maximum' . map snd) cols
         catcolumnwidths = foldl' (zipWith (++)) $ repeat []
         cols = maybetranspose $ catcolumnwidths $ map (cellswidth . rowToBudgetCells) items ++ [cellswidth $ rowToBudgetCells tr]
 
@@ -380,22 +385,14 @@ budgetReportAsTable
     showcell showmixed percbudget (actual, mbudget) = zip (showmixed actual') full
       where
         actual' = fromMaybe nullmixedamt actual
+        budgetAndPerc b = zip (showmixed b) (fmap (renderText . T.pack . show . roundTo 0) <$> percbudget actual' b)
 
-        budgetAndPerc b = uncurry zip
-          ( showmixed b
-          , fmap (wbFromText . T.pack . show . roundTo 0) <$> percbudget actual' b
-          )
-
-        full
-          | Just b <- mbudget = Just <$> budgetAndPerc b
-          | otherwise         = repeat Nothing
+        full | Just b <- mbudget = Just <$> budgetAndPerc b
+             | otherwise         = repeat Nothing
 
-    paddisplaycell :: (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder
-    paddisplaycell (actualwidth, budgetwidth, percentwidth) (actual, mbudget) = full
+    paddisplaycell :: (Int, Int) -> BudgetDisplayCell -> RenderText
+    paddisplaycell (budgetwidth, percentwidth) (actual, mbudget) = full
       where
-        toPadded (WideBuilder b w) =
-            (TB.fromText . flip T.replicate " " $ actualwidth - w) <> b
-
         (totalpercentwidth, totalbudgetwidth) =
           let totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5
            in ( totalpercentwidth
@@ -405,14 +402,13 @@ budgetReportAsTable
         -- | Display a padded budget string
         budgetb (budget, perc) =
           let perct = case perc of
-                Nothing  -> T.replicate totalpercentwidth " "
-                Just pct -> T.replicate (percentwidth - wbWidth pct) " " <> wbToText pct <> "% of "
-           in TB.fromText $ " [" <> perct <> T.replicate (budgetwidth - wbWidth budget) " " <> wbToText budget <> "]"
+                Nothing  -> renderText $ T.replicate totalpercentwidth " "
+                Just pct -> renderText (T.replicate (percentwidth - visibleLength pct) " ") <> pct <> "% of "
+           in " [" <> perct <> renderText (T.replicate (budgetwidth - visibleLength budget) " ") <> budget <> "]"
 
-        emptyBudget = TB.fromText $ T.replicate totalbudgetwidth " "
+        emptyBudget = renderText $ T.replicate totalbudgetwidth " "
 
-        full = flip WideBuilder (actualwidth + totalbudgetwidth) $
-            toPadded actual <> maybe emptyBudget budgetb mbudget
+        full = actual <> maybe emptyBudget budgetb mbudget
 
     -- | Calculate the percentage of actual change to budget goal to show, if any.
     -- If valuing at cost, both amounts are converted to cost before comparing.
@@ -462,7 +458,7 @@ budgetReportAsCsv
 
   where
     flattentuples abs = concat [[a,b] | (a,b) <- abs]
-    showNorm = maybe "" (wbToText . showMixedAmountB oneLine)
+    showNorm = maybe "" (buildCell . showMixedAmountB oneLine)
 
     rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text)
                -> PeriodicReportRow a BudgetCell
@@ -472,7 +468,7 @@ budgetReportAsCsv
       | otherwise =
             joinNames . zipWith (:) cs  -- add symbols and names
           . transpose                   -- each row becomes a list of Text quantities
-          . fmap (fmap wbToText . showMixedAmountLinesB oneLine{displayOrder=Just cs, displayMinWidth=Nothing}
+          . map (map buildCell . showMixedAmountLinesB oneLine{displayOrder=Just cs}
                  .fromMaybe nullmixedamt)
           $ all
       where

hledger-lib/Hledger/Reports/MultiBalanceReport.hs

@@ -51,11 +51,11 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Time.Calendar (fromGregorian)
 import Safe (lastDef, minimumMay)
+import Text.Layout.Table
+import Text.Layout.Table.Cell.ElidableList (ElidableList)
 
-import Data.Default (def)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy.Builder as TB
-import qualified Text.Tabular.AsciiWide as Tab
 
 import Hledger.Data
 import Hledger.Query
@@ -589,21 +589,19 @@ cumulativeSum start = snd . M.mapAccum (\a b -> let s = sumAcct a b in (s, s)) s
 -- made using 'balanceReportAsTable'), render it in a format suitable for
 -- console output. Amounts with more than two commodities will be elided
 -- unless --no-elide is used.
-balanceReportTableAsText :: ReportOpts -> Tab.Table T.Text T.Text WideBuilder -> TB.Builder
-balanceReportTableAsText ReportOpts{..} =
-    Tab.renderTableByRowsB def{Tab.tableBorders=False, Tab.prettyTable=pretty_} renderCh renderRow
+balanceReportTableAsText :: ReportOpts -> Table T.Text T.Text (Either (ElidableList String RenderText) RenderText) -> TB.Builder
+balanceReportTableAsText ReportOpts{..} (Table rh ch cells) =
+    tableStringB colSpec style rowHeader colHeader (map rowG cells) <> TB.singleton '\n'
   where
-    renderCh
-      | layout_ /= LayoutBare || transpose_ = fmap (Tab.textCell Tab.TopRight)
-      | otherwise = zipWith ($) (Tab.textCell Tab.TopLeft : repeat (Tab.textCell Tab.TopRight))
-
-    renderRow (rh, row)
-      | layout_ /= LayoutBare || transpose_ =
-          (Tab.textCell Tab.TopLeft rh, fmap (Tab.Cell Tab.TopRight . pure) row)
-      | otherwise =
-          (Tab.textCell Tab.TopLeft rh, zipWith ($) (Tab.Cell Tab.TopLeft : repeat (Tab.Cell Tab.TopRight)) (fmap pure row))
-
-
+    colSpec = case layout_ of
+        LayoutBare | not transpose_ -> col left Nothing : repeat (col right Nothing)
+        LayoutWide width            -> repeat (col right width)
+        _                           -> repeat (col right Nothing)
+      where
+        col pos width = column (maybe expand expandUntil width) pos noAlign noCutMark
+    style = if pretty_ then hledgerPrettyStyle else hledgerStyle
+    rowHeader = renderText <$> rh
+    colHeader = renderText <$> ch
 
 -- tests