ref!: tabular: Use ElidableList rather than home-grown functions.

showMixedAmountOneLineB will now return an ElidableList. This will be
padded or trimmed automagically when rendered with grid or
table-producing functions, or with the pad or trim functions.

The return types of showMixedAmount(|Lines|OneLine)B have changed, but
since the return types are still instances of Cell they can be treated
the same: just use buildCell to render as you will.

hledger-lib/Hledger/Data/Amount.hs

@@ -135,6 +135,7 @@ module Hledger.Data.Amount (
   showMixedAmountElided,
   showMixedAmountWithZeroCommodity,
   showMixedAmountB,
+  showMixedAmountOneLineB,
   showMixedAmountLinesB,
   buildCell,
   mixedAmountSetPrecision,
@@ -151,7 +152,7 @@ import Data.Char (isDigit)
 import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
 import Data.Default (Default(..))
 import Data.Foldable (toList)
-import Data.List (find, foldl', intercalate, intersperse, mapAccumL, partition)
+import Data.List (find, foldl', intercalate, intersperse)
 import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
@@ -160,16 +161,16 @@ import Data.Semigroup (Semigroup(..))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Word (Word8)
-import Safe (lastDef, lastMay)
 import System.Console.ANSI (Color(..),ColorIntensity(..))
+import Text.Layout.Table (right, singleCutMark)
+import Text.Layout.Table.Cell.ElidableList (ElidableList, elidableListR)
 
 import Test.Tasty (testGroup)
 import Test.Tasty.HUnit ((@?=), assertBool, testCase)
 
 import Hledger.Data.Types
 import Hledger.Utils
-  (Cell(..), RenderText, numDigitsInt, textQuoteIfNeeded, trace, colorB,
-  renderText, visibleLength)
+  (Cell(..), RenderText, textQuoteIfNeeded, trace, colorB, renderText, trim)
 
 
 -- A 'Commodity' is a symbol representing a currency or some other kind of
@@ -201,8 +202,6 @@ data AmountDisplayOpts = AmountDisplayOpts
   , displayThousandsSep  :: Bool       -- ^ Whether to display thousands separators.
   , displayColour        :: Bool       -- ^ Whether to colourise negative Amounts.
   , displayOneLine       :: Bool       -- ^ Whether to display on one line.
-  , displayMinWidth      :: Maybe Int  -- ^ Minimum width to pad to
-  , displayMaxWidth      :: Maybe Int  -- ^ Maximum width to clip to
   -- | Display amounts in this order (without the commodity symbol) and display
   -- a 0 in case a corresponding commodity does not exist
   , displayOrder         :: Maybe [CommoditySymbol]
@@ -218,8 +217,6 @@ noColour = AmountDisplayOpts { displayPrice         = True
                              , displayZeroCommodity = False
                              , displayThousandsSep  = True
                              , displayOneLine       = False
-                             , displayMinWidth      = Just 0
-                             , displayMaxWidth      = Nothing
                              , displayOrder         = Nothing
                              }
 
@@ -802,17 +799,17 @@ showMixedAmountWithoutPrice c = buildCell . showMixedAmountB noPrice{displayColo
 -- any \@ prices.
 -- With a True argument, adds ANSI codes to show negative amounts in red.
 --
--- > showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountB oneLine{displayColour=c}
+-- > showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountOneLineB noPrice{displayColour=c}
 showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String
-showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountB oneLine{displayColour=c}
+showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountB noPrice{displayColour=c}
 
 -- | Like showMixedAmountOneLineWithoutPrice, but show at most the given width,
 -- with an elision indicator if there are more.
 -- With a True argument, adds ANSI codes to show negative amounts in red.
 --
--- > showMixedAmountElided w c = buildCell . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}
+-- > showMixedAmountElided w c = trim right w . showMixedAmountOneLineB noPrice{displayColour=c}
 showMixedAmountElided :: Int -> Bool -> MixedAmount -> String
-showMixedAmountElided w c = buildCell . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}
+showMixedAmountElided w c = trim right (singleCutMark "..") w . showMixedAmountOneLineB noPrice{displayColour=c}
 
 -- | Get an unambiguous string representation of a mixed amount for debugging.
 showMixedAmountDebug :: MixedAmount -> String
@@ -831,10 +828,10 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)"
 --   exceed the requested maximum width.
 -- - If displayed on multiple lines, any Amounts longer than the
 --   maximum width will be elided.
-showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> RenderText
+showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> Either (ElidableList String RenderText) RenderText
 showMixedAmountB opts ma
-    | displayOneLine opts = showMixedAmountOneLineB opts ma
-    | otherwise           = mconcat $ intersperse sep lines
+    | displayOneLine opts = Left $ showMixedAmountOneLineB opts ma
+    | otherwise           = Right . mconcat $ intersperse sep lines
   where
     lines = showMixedAmountLinesB opts ma
     sep = "\n"
@@ -844,96 +841,21 @@ showMixedAmountB opts ma
 -- width. This does not honour displayOneLine: all amounts will be displayed as if
 -- displayOneLine were False.
 showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [RenderText]
-showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =
-    map (adBuilder . pad) elided
-  where
-    astrs = amtDisplayList 0 (showAmountB opts) . orderedAmounts opts $
-              if displayPrice opts then ma else mixedAmountStripPrices ma
-    width = maximum $ map (visibleLength . adBuilder) elided
-
-    pad amt
-      | Just mw <- mmin =
-          let w = (max width mw) - visibleLength (adBuilder amt)
-           in amt{ adBuilder = renderText (T.replicate w " ") <> adBuilder amt }
-      | otherwise = amt
-
-    elided = maybe id elideTo mmax astrs
-    elideTo m xs = maybeAppend elisionStr short
-      where
-        elisionStr = elisionDisplay (Just m) 0 (length long) $ lastDef nullAmountDisplay short
-        (short, long) = partition ((m>=) . visibleLength . adBuilder) xs
+showMixedAmountLinesB opts =
+    map (showAmountB opts) . orderedAmounts opts
+    . if displayPrice opts then id else mixedAmountStripPrices
 
 -- | Helper for showMixedAmountB to deal with single line displays. This does not
 -- honour displayOneLine: all amounts will be displayed as if displayOneLine
 -- were True.
-showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> RenderText
-showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =
-    pad . mconcat . intersperse sep $ map adBuilder elided
-  where
-    width  = maybe 0 adTotal $ lastMay elided
-    astrs  = amtDisplayList (visibleLength sep) (showAmountB opts) . orderedAmounts opts $
-               if displayPrice opts then ma else mixedAmountStripPrices ma
-    sep    = ", "
-    n      = length astrs
-
-    pad = (renderText (T.replicate (fromMaybe 0 mmin - width) " ") <>)
-
-    elided = maybe id elideTo mmax astrs
-    elideTo m = addElide . takeFitting m . withElided
-    -- Add the last elision string to the end of the display list
-    addElide [] = []
-    addElide xs = maybeAppend (snd $ last xs) $ map fst xs
-    -- Return the elements of the display list which fit within the maximum width
-    -- (including their elision strings). Always display at least one amount,
-    -- regardless of width.
-    takeFitting _ []     = []
-    takeFitting m (x:xs) = x : dropWhileRev (\(a,e) -> m < adTotal (fromMaybe a e)) xs
-    dropWhileRev p = foldr (\x xs -> if null xs && p x then [] else x:xs) []
-
-    -- Add the elision strings (if any) to each amount
-    withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (visibleLength sep) num amt)) [n-1,n-2..0]
+showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> ElidableList String RenderText
+showMixedAmountOneLineB opts = elidableListR (\n -> show n ++ " more..") ", " . showMixedAmountLinesB opts
 
 orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]
 orderedAmounts dopts = maybe id (mapM pad) (displayOrder dopts) . amounts
   where
     pad c = fromMaybe (amountWithCommodity c nullamt) . find ((c==) . acommodity)
 
-
-data AmountDisplay = AmountDisplay
-  { adBuilder :: !RenderText  -- ^ String representation of the Amount
-  , adTotal   :: !Int         -- ^ Cumulative length of MixedAmount this Amount is part of, including separators
-  } deriving (Show)
-
-nullAmountDisplay :: AmountDisplay
-nullAmountDisplay = AmountDisplay mempty 0
-
-amtDisplayList :: Int -> (Amount -> RenderText) -> [Amount] -> [AmountDisplay]
-amtDisplayList sep showamt = snd . mapAccumL display (-sep)
-  where
-    display tot amt = (tot', AmountDisplay str tot')
-      where
-        str  = showamt amt
-        tot' = tot + (visibleLength str) + sep
-
--- The string "m more", added to the previous running total
-elisionDisplay :: Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
-elisionDisplay mmax sep n lastAmt
-  | n > 0     = Just $ AmountDisplay str (adTotal lastAmt + len)
-  | otherwise = Nothing
-  where
-    fullString = T.pack $ show n ++ " more.."
-    -- sep from the separator, 7 from " more..", numDigits n from number
-    fullLength = sep + 7 + numDigitsInt n
-
-    str | Just m <- mmax, fullLength > m = renderText $ T.take (m - 2) fullString <> ".."
-        | otherwise                      = renderText fullString
-    len = case mmax of Nothing -> fullLength
-                       Just m  -> max 2 $ min m fullLength
-
-maybeAppend :: Maybe a -> [a] -> [a]
-maybeAppend Nothing  = id
-maybeAppend (Just a) = (++[a])
-
 -- | Compact labelled trace of a mixed amount, for debugging.
 ltraceamount :: String -> MixedAmount -> MixedAmount
 ltraceamount s a = trace (s ++ ": " ++ showMixedAmount a) a

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)
@@ -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
@@ -340,11 +340,13 @@ 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] -> [(RenderText, BudgetDisplayRow)]
     showrow row =
@@ -360,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 = visibleLength *** maybe 0 visibleLength
-          cellwidth (am, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (visibleLength am, bw, pw)
+          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]
 
@@ -384,21 +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 (renderText . 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 -> RenderText
-    paddisplaycell (actualwidth, budgetwidth, percentwidth) (actual, mbudget) = full
+    paddisplaycell :: (Int, Int) -> BudgetDisplayCell -> RenderText
+    paddisplaycell (budgetwidth, percentwidth) (actual, mbudget) = full
       where
-        toPadded s = renderText (T.replicate (actualwidth - visibleLength s) " ") <> s
-
         (totalpercentwidth, totalbudgetwidth) =
           let totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5
            in ( totalpercentwidth
@@ -414,7 +408,7 @@ budgetReportAsTable
 
         emptyBudget = renderText $ T.replicate totalbudgetwidth " "
 
-        full = 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.
@@ -474,7 +468,7 @@ budgetReportAsCsv
       | otherwise =
             joinNames . zipWith (:) cs  -- add symbols and names
           . transpose                   -- each row becomes a list of Text quantities
-          . map (map buildCell . 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

@@ -52,6 +52,7 @@ 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 qualified Data.Text as T
 import qualified Data.Text.Lazy.Builder as TB
@@ -588,15 +589,16 @@ 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 -> Table T.Text T.Text RenderText -> TB.Builder
+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
     colSpec = case layout_ of
-        LayoutBare | not transpose_ -> col left : repeat (col right)
-        _                           -> repeat (col right)
+        LayoutBare | not transpose_ -> col left Nothing : repeat (col right Nothing)
+        LayoutWide width            -> repeat (col right width)
+        _                           -> repeat (col right Nothing)
       where
-        col pos = column expand pos noAlign noCutMark
+        col pos width = column (maybe expand expandUntil width) pos noAlign noCutMark
     style = if pretty_ then hledgerPrettyStyle else hledgerStyle
     rowHeader = renderText <$> rh
     colHeader = renderText <$> ch

hledger-lib/Hledger/Utils/Text.hs

@@ -1,6 +1,7 @@
 -- | Text formatting helpers, ported from String as needed.
 -- There may be better alternatives out there.
 
+{-# LANGUAGE DeriveFunctor     #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Hledger.Utils.Text
@@ -209,23 +210,20 @@ textConcatBottomPadded = concatLines . map mconcat . gridB (repeat def)
 -- It clips and pads on the right when the fourth argument is true, otherwise on the left.
 -- It treats wide characters as double width.
 fitText :: Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
-fitText mminwidth mmaxwidth ellipsify rightside =
-    maybe id clip' mmaxwidth . maybe buildCell pad' mminwidth . WideText
+fitText mminwidth mmaxwidth ellipsify rightside = case (mminwidth, mmaxwidth) of
+    (Nothing, Nothing) -> id
+    (Just m,  Nothing) -> pad pos m . WideText
+    (Nothing, Just n ) -> trim pos cm n . WideText
+    (Just m,  Just n ) -> trimOrPadBetween pos cm m n . WideText
   where
-    clip' = trimIfWider ellipsify rightside
-    pad'  = pad (if rightside then left else right)
-
--- | Trim a piece of text if it is wider than given.
-trimIfWider :: Bool -> Bool -> Int -> Text -> Text
-trimIfWider ellipsify rightside w t
-  | visibleLength (WideText t) > w = trim (if rightside then left else right) (if ellipsify then singleCutMark ".." else noCutMark) w $ WideText t
-  | otherwise = t
+    pos = if rightside then left else right
+    cm = if ellipsify then singleCutMark ".." else noCutMark
 
 -- | Double-width-character-aware string truncation. Take as many
 -- characters as possible from a string without exceeding the
 -- specified width. Eg textTakeWidth 3 "りんご" = "り".
 textTakeWidth :: Int -> Text -> Text
-textTakeWidth = trimIfWider False True
+textTakeWidth n = trim left noCutMark n . WideText
 
 -- | Add a prefix to each line of a string.
 linesPrepend :: Text -> Text -> Text
@@ -253,14 +251,15 @@ unlinesB = foldMap (<> TB.singleton '\n')
 
 -- | A Table contains information about the row and column headers, as well as a table of data.
 data Table rh ch a = Table (HeaderSpec LineStyle rh) (HeaderSpec LineStyle ch) [[a]]
+  deriving (Functor)
 
 -- | Add the second table below the first, discarding its column headings.
-concatTables :: Monoid a => LineStyle -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
+concatTables :: Cell a => LineStyle -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
 concatTables prop (Table hLeft hTop dat) (Table hLeft' _ dat') =
     Table (groupH prop [hLeft, hLeft']) hTop (map padRow $ dat ++ dat')
   where
     numCols = length $ headerContents hTop
-    padRow r = replicate (numCols - length r) mempty ++ r
+    padRow r = replicate (numCols - length r) emptyCell ++ r
 
 -- | An alias for formatted text measured by display length.
 type RenderText = Formatted WideText