Skip to content

Commit 2f41a1b

Browse files
committed
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.
1 parent 2d16503 commit 2f41a1b

File tree

12 files changed

+145
-215
lines changed

12 files changed

+145
-215
lines changed

hledger-lib/Hledger/Data/Amount.hs

Lines changed: 17 additions & 95 deletions
Original file line numberDiff line numberDiff line change
@@ -135,6 +135,7 @@ module Hledger.Data.Amount (
135135
showMixedAmountElided,
136136
showMixedAmountWithZeroCommodity,
137137
showMixedAmountB,
138+
showMixedAmountOneLineB,
138139
showMixedAmountLinesB,
139140
buildCell,
140141
mixedAmountSetPrecision,
@@ -151,7 +152,7 @@ import Data.Char (isDigit)
151152
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
152153
import Data.Default (Default(..))
153154
import Data.Foldable (toList)
154-
import Data.List (find, foldl', intercalate, intersperse, mapAccumL, partition)
155+
import Data.List (find, foldl', intercalate, intersperse)
155156
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
156157
import qualified Data.Map.Strict as M
157158
import qualified Data.Set as S
@@ -160,16 +161,16 @@ import Data.Semigroup (Semigroup(..))
160161
import Data.Text (Text)
161162
import qualified Data.Text as T
162163
import Data.Word (Word8)
163-
import Safe (lastDef, lastMay)
164164
import System.Console.ANSI (Color(..),ColorIntensity(..))
165+
import Text.Layout.Table (right, singleCutMark)
166+
import Text.Layout.Table.Cell.ElidableList (ElidableList, elidableListR)
165167

166168
import Test.Tasty (testGroup)
167169
import Test.Tasty.HUnit ((@?=), assertBool, testCase)
168170

169171
import Hledger.Data.Types
170172
import Hledger.Utils
171-
(Cell(..), RenderText, numDigitsInt, textQuoteIfNeeded, trace, colorB,
172-
renderText, visibleLength)
173+
(Cell(..), RenderText, textQuoteIfNeeded, trace, colorB, renderText, trim)
173174

174175

175176
-- A 'Commodity' is a symbol representing a currency or some other kind of
@@ -201,8 +202,6 @@ data AmountDisplayOpts = AmountDisplayOpts
201202
, displayThousandsSep :: Bool -- ^ Whether to display thousands separators.
202203
, displayColour :: Bool -- ^ Whether to colourise negative Amounts.
203204
, displayOneLine :: Bool -- ^ Whether to display on one line.
204-
, displayMinWidth :: Maybe Int -- ^ Minimum width to pad to
205-
, displayMaxWidth :: Maybe Int -- ^ Maximum width to clip to
206205
-- | Display amounts in this order (without the commodity symbol) and display
207206
-- a 0 in case a corresponding commodity does not exist
208207
, displayOrder :: Maybe [CommoditySymbol]
@@ -218,8 +217,6 @@ noColour = AmountDisplayOpts { displayPrice = True
218217
, displayZeroCommodity = False
219218
, displayThousandsSep = True
220219
, displayOneLine = False
221-
, displayMinWidth = Just 0
222-
, displayMaxWidth = Nothing
223220
, displayOrder = Nothing
224221
}
225222

@@ -802,17 +799,17 @@ showMixedAmountWithoutPrice c = buildCell . showMixedAmountB noPrice{displayColo
802799
-- any \@ prices.
803800
-- With a True argument, adds ANSI codes to show negative amounts in red.
804801
--
805-
-- > showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountB oneLine{displayColour=c}
802+
-- > showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountOneLineB noPrice{displayColour=c}
806803
showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String
807-
showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountB oneLine{displayColour=c}
804+
showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountB noPrice{displayColour=c}
808805

809806
-- | Like showMixedAmountOneLineWithoutPrice, but show at most the given width,
810807
-- with an elision indicator if there are more.
811808
-- With a True argument, adds ANSI codes to show negative amounts in red.
812809
--
813-
-- > showMixedAmountElided w c = buildCell . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}
810+
-- > showMixedAmountElided w c = trim right w . showMixedAmountOneLineB noPrice{displayColour=c}
814811
showMixedAmountElided :: Int -> Bool -> MixedAmount -> String
815-
showMixedAmountElided w c = buildCell . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w}
812+
showMixedAmountElided w c = trim right (singleCutMark "..") w . showMixedAmountOneLineB noPrice{displayColour=c}
816813

817814
-- | Get an unambiguous string representation of a mixed amount for debugging.
818815
showMixedAmountDebug :: MixedAmount -> String
@@ -831,10 +828,10 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)"
831828
-- exceed the requested maximum width.
832829
-- - If displayed on multiple lines, any Amounts longer than the
833830
-- maximum width will be elided.
834-
showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> RenderText
831+
showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> Either (ElidableList String RenderText) RenderText
835832
showMixedAmountB opts ma
836-
| displayOneLine opts = showMixedAmountOneLineB opts ma
837-
| otherwise = mconcat $ intersperse sep lines
833+
| displayOneLine opts = Left $ showMixedAmountOneLineB opts ma
834+
| otherwise = Right . mconcat $ intersperse sep lines
838835
where
839836
lines = showMixedAmountLinesB opts ma
840837
sep = "\n"
@@ -844,96 +841,21 @@ showMixedAmountB opts ma
844841
-- width. This does not honour displayOneLine: all amounts will be displayed as if
845842
-- displayOneLine were False.
846843
showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [RenderText]
847-
showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =
848-
map (adBuilder . pad) elided
849-
where
850-
astrs = amtDisplayList 0 (showAmountB opts) . orderedAmounts opts $
851-
if displayPrice opts then ma else mixedAmountStripPrices ma
852-
width = maximum $ map (visibleLength . adBuilder) elided
853-
854-
pad amt
855-
| Just mw <- mmin =
856-
let w = (max width mw) - visibleLength (adBuilder amt)
857-
in amt{ adBuilder = renderText (T.replicate w " ") <> adBuilder amt }
858-
| otherwise = amt
859-
860-
elided = maybe id elideTo mmax astrs
861-
elideTo m xs = maybeAppend elisionStr short
862-
where
863-
elisionStr = elisionDisplay (Just m) 0 (length long) $ lastDef nullAmountDisplay short
864-
(short, long) = partition ((m>=) . visibleLength . adBuilder) xs
844+
showMixedAmountLinesB opts =
845+
map (showAmountB opts) . orderedAmounts opts
846+
. if displayPrice opts then id else mixedAmountStripPrices
865847

866848
-- | Helper for showMixedAmountB to deal with single line displays. This does not
867849
-- honour displayOneLine: all amounts will be displayed as if displayOneLine
868850
-- were True.
869-
showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> RenderText
870-
showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =
871-
pad . mconcat . intersperse sep $ map adBuilder elided
872-
where
873-
width = maybe 0 adTotal $ lastMay elided
874-
astrs = amtDisplayList (visibleLength sep) (showAmountB opts) . orderedAmounts opts $
875-
if displayPrice opts then ma else mixedAmountStripPrices ma
876-
sep = ", "
877-
n = length astrs
878-
879-
pad = (renderText (T.replicate (fromMaybe 0 mmin - width) " ") <>)
880-
881-
elided = maybe id elideTo mmax astrs
882-
elideTo m = addElide . takeFitting m . withElided
883-
-- Add the last elision string to the end of the display list
884-
addElide [] = []
885-
addElide xs = maybeAppend (snd $ last xs) $ map fst xs
886-
-- Return the elements of the display list which fit within the maximum width
887-
-- (including their elision strings). Always display at least one amount,
888-
-- regardless of width.
889-
takeFitting _ [] = []
890-
takeFitting m (x:xs) = x : dropWhileRev (\(a,e) -> m < adTotal (fromMaybe a e)) xs
891-
dropWhileRev p = foldr (\x xs -> if null xs && p x then [] else x:xs) []
892-
893-
-- Add the elision strings (if any) to each amount
894-
withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (visibleLength sep) num amt)) [n-1,n-2..0]
851+
showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> ElidableList String RenderText
852+
showMixedAmountOneLineB opts = elidableListR (\n -> show n ++ " more..") ", " . showMixedAmountLinesB opts
895853

896854
orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]
897855
orderedAmounts dopts = maybe id (mapM pad) (displayOrder dopts) . amounts
898856
where
899857
pad c = fromMaybe (amountWithCommodity c nullamt) . find ((c==) . acommodity)
900858

901-
902-
data AmountDisplay = AmountDisplay
903-
{ adBuilder :: !RenderText -- ^ String representation of the Amount
904-
, adTotal :: !Int -- ^ Cumulative length of MixedAmount this Amount is part of, including separators
905-
} deriving (Show)
906-
907-
nullAmountDisplay :: AmountDisplay
908-
nullAmountDisplay = AmountDisplay mempty 0
909-
910-
amtDisplayList :: Int -> (Amount -> RenderText) -> [Amount] -> [AmountDisplay]
911-
amtDisplayList sep showamt = snd . mapAccumL display (-sep)
912-
where
913-
display tot amt = (tot', AmountDisplay str tot')
914-
where
915-
str = showamt amt
916-
tot' = tot + (visibleLength str) + sep
917-
918-
-- The string "m more", added to the previous running total
919-
elisionDisplay :: Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
920-
elisionDisplay mmax sep n lastAmt
921-
| n > 0 = Just $ AmountDisplay str (adTotal lastAmt + len)
922-
| otherwise = Nothing
923-
where
924-
fullString = T.pack $ show n ++ " more.."
925-
-- sep from the separator, 7 from " more..", numDigits n from number
926-
fullLength = sep + 7 + numDigitsInt n
927-
928-
str | Just m <- mmax, fullLength > m = renderText $ T.take (m - 2) fullString <> ".."
929-
| otherwise = renderText fullString
930-
len = case mmax of Nothing -> fullLength
931-
Just m -> max 2 $ min m fullLength
932-
933-
maybeAppend :: Maybe a -> [a] -> [a]
934-
maybeAppend Nothing = id
935-
maybeAppend (Just a) = (++[a])
936-
937859
-- | Compact labelled trace of a mixed amount, for debugging.
938860
ltraceamount :: String -> MixedAmount -> MixedAmount
939861
ltraceamount s a = trace (s ++ ": " ++ showMixedAmount a) a

hledger-lib/Hledger/Reports/BudgetReport.hs

Lines changed: 21 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ import Data.Decimal (roundTo)
2626
import Data.Function (on)
2727
import Data.HashMap.Strict (HashMap)
2828
import qualified Data.HashMap.Strict as HM
29-
import Data.List (find, partition, transpose, foldl', maximumBy)
29+
import Data.List (find, intersperse, partition, transpose, foldl', maximumBy)
3030
import Data.List.Extra (nubSort)
3131
import Data.Maybe (fromMaybe, catMaybes, isJust)
3232
import Data.Map (Map)
@@ -256,7 +256,7 @@ combineBudgetAndActual ropts j
256256
budgetReportAsText :: ReportOpts -> BudgetReport -> TL.Text
257257
budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
258258
TB.fromText title <> TB.fromText "\n\n" <>
259-
balanceReportTableAsText ropts (budgetReportAsTable ropts budgetr)
259+
balanceReportTableAsText ropts (Right <$> budgetReportAsTable ropts budgetr)
260260
where
261261
title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
262262
<> (case conversionop_ of
@@ -340,11 +340,13 @@ budgetReportAsTable
340340
-- functions for displaying budget cells depending on `commodity-layout_` option
341341
rowfuncs :: [CommoditySymbol] -> (BudgetShowMixed, BudgetPercBudget)
342342
rowfuncs cs = case layout_ of
343-
LayoutWide width ->
344-
( pure . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=width}
345-
, \a -> pure . percentage a)
346-
_ -> ( showMixedAmountLinesB noPrice{displayOrder=Just cs, displayMinWidth=Nothing, displayColour=color_}
347-
, \a b -> fmap (percentage' a b) cs)
343+
-- For budget reports we do not use ElidableList, since we need to keep the budget goals displayed nicely
344+
LayoutWide _ -> ( pure . mconcat . intersperse ", " . showMixedAmountLinesB dopts
345+
, \a -> pure . percentage a)
346+
_ -> ( showMixedAmountLinesB dopts{displayOrder=Just cs}
347+
, \a b -> fmap (percentage' a b) cs)
348+
where
349+
dopts = noPrice{displayColour=color_}
348350

349351
showrow :: [BudgetCell] -> [(RenderText, BudgetDisplayRow)]
350352
showrow row =
@@ -360,22 +362,21 @@ budgetReportAsTable
360362
budgetCellCommodities (am, bm) = f am `S.union` f bm
361363
where f = maybe mempty maCommodities
362364

363-
cellswidth :: [BudgetCell] -> [[(Int, Int, Int)]]
365+
cellswidth :: [BudgetCell] -> [[(Int, Int)]]
364366
cellswidth row =
365367
let cs = budgetCellsCommodities row
366368
(showmixed, percbudget) = rowfuncs cs
367369
disp = showcell showmixed percbudget
368370
budgetpercwidth = visibleLength *** maybe 0 visibleLength
369-
cellwidth (am, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (visibleLength am, bw, pw)
371+
cellwidth (_, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (bw, pw)
370372
in fmap (fmap cellwidth . disp) row
371373

372374
-- build a list of widths for each column. In the case of transposed budget
373375
-- reports, the total 'row' must be included in this list
374-
widths = zip3 actualwidths budgetwidths percentwidths
376+
widths = zip budgetwidths percentwidths
375377
where
376-
actualwidths = map (maximum' . map first3 ) $ cols
377-
budgetwidths = map (maximum' . map second3) $ cols
378-
percentwidths = map (maximum' . map third3 ) $ cols
378+
budgetwidths = map (maximum' . map fst) cols
379+
percentwidths = map (maximum' . map snd) cols
379380
catcolumnwidths = foldl' (zipWith (++)) $ repeat []
380381
cols = maybetranspose $ catcolumnwidths $ map (cellswidth . rowToBudgetCells) items ++ [cellswidth $ rowToBudgetCells tr]
381382

@@ -384,21 +385,14 @@ budgetReportAsTable
384385
showcell showmixed percbudget (actual, mbudget) = zip (showmixed actual') full
385386
where
386387
actual' = fromMaybe nullmixedamt actual
388+
budgetAndPerc b = zip (showmixed b) (fmap (renderText . T.pack . show . roundTo 0) <$> percbudget actual' b)
387389

388-
budgetAndPerc b = uncurry zip
389-
( showmixed b
390-
, fmap (renderText . T.pack . show . roundTo 0) <$> percbudget actual' b
391-
)
392-
393-
full
394-
| Just b <- mbudget = Just <$> budgetAndPerc b
395-
| otherwise = repeat Nothing
390+
full | Just b <- mbudget = Just <$> budgetAndPerc b
391+
| otherwise = repeat Nothing
396392

397-
paddisplaycell :: (Int, Int, Int) -> BudgetDisplayCell -> RenderText
398-
paddisplaycell (actualwidth, budgetwidth, percentwidth) (actual, mbudget) = full
393+
paddisplaycell :: (Int, Int) -> BudgetDisplayCell -> RenderText
394+
paddisplaycell (budgetwidth, percentwidth) (actual, mbudget) = full
399395
where
400-
toPadded s = renderText (T.replicate (actualwidth - visibleLength s) " ") <> s
401-
402396
(totalpercentwidth, totalbudgetwidth) =
403397
let totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5
404398
in ( totalpercentwidth
@@ -414,7 +408,7 @@ budgetReportAsTable
414408

415409
emptyBudget = renderText $ T.replicate totalbudgetwidth " "
416410

417-
full = toPadded actual <> maybe emptyBudget budgetb mbudget
411+
full = actual <> maybe emptyBudget budgetb mbudget
418412

419413
-- | Calculate the percentage of actual change to budget goal to show, if any.
420414
-- If valuing at cost, both amounts are converted to cost before comparing.
@@ -474,7 +468,7 @@ budgetReportAsCsv
474468
| otherwise =
475469
joinNames . zipWith (:) cs -- add symbols and names
476470
. transpose -- each row becomes a list of Text quantities
477-
. map (map buildCell . showMixedAmountLinesB oneLine{displayOrder=Just cs, displayMinWidth=Nothing}
471+
. map (map buildCell . showMixedAmountLinesB oneLine{displayOrder=Just cs}
478472
.fromMaybe nullmixedamt)
479473
$ all
480474
where

hledger-lib/Hledger/Reports/MultiBalanceReport.hs

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,7 @@ import qualified Data.Set as Set
5252
import Data.Time.Calendar (fromGregorian)
5353
import Safe (lastDef, minimumMay)
5454
import Text.Layout.Table
55+
import Text.Layout.Table.Cell.ElidableList (ElidableList)
5556

5657
import qualified Data.Text as T
5758
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
588589
-- made using 'balanceReportAsTable'), render it in a format suitable for
589590
-- console output. Amounts with more than two commodities will be elided
590591
-- unless --no-elide is used.
591-
balanceReportTableAsText :: ReportOpts -> Table T.Text T.Text RenderText -> TB.Builder
592+
balanceReportTableAsText :: ReportOpts -> Table T.Text T.Text (Either (ElidableList String RenderText) RenderText) -> TB.Builder
592593
balanceReportTableAsText ReportOpts{..} (Table rh ch cells) =
593594
tableStringB colSpec style rowHeader colHeader (map rowG cells) <> TB.singleton '\n'
594595
where
595596
colSpec = case layout_ of
596-
LayoutBare | not transpose_ -> col left : repeat (col right)
597-
_ -> repeat (col right)
597+
LayoutBare | not transpose_ -> col left Nothing : repeat (col right Nothing)
598+
LayoutWide width -> repeat (col right width)
599+
_ -> repeat (col right Nothing)
598600
where
599-
col pos = column expand pos noAlign noCutMark
601+
col pos width = column (maybe expand expandUntil width) pos noAlign noCutMark
600602
style = if pretty_ then hledgerPrettyStyle else hledgerStyle
601603
rowHeader = renderText <$> rh
602604
colHeader = renderText <$> ch

hledger-lib/Hledger/Utils/Text.hs

Lines changed: 12 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
-- | Text formatting helpers, ported from String as needed.
22
-- There may be better alternatives out there.
33

4+
{-# LANGUAGE DeriveFunctor #-}
45
{-# LANGUAGE OverloadedStrings #-}
56

67
module Hledger.Utils.Text
@@ -209,23 +210,20 @@ textConcatBottomPadded = concatLines . map mconcat . gridB (repeat def)
209210
-- It clips and pads on the right when the fourth argument is true, otherwise on the left.
210211
-- It treats wide characters as double width.
211212
fitText :: Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
212-
fitText mminwidth mmaxwidth ellipsify rightside =
213-
maybe id clip' mmaxwidth . maybe buildCell pad' mminwidth . WideText
213+
fitText mminwidth mmaxwidth ellipsify rightside = case (mminwidth, mmaxwidth) of
214+
(Nothing, Nothing) -> id
215+
(Just m, Nothing) -> pad pos m . WideText
216+
(Nothing, Just n ) -> trim pos cm n . WideText
217+
(Just m, Just n ) -> trimOrPadBetween pos cm m n . WideText
214218
where
215-
clip' = trimIfWider ellipsify rightside
216-
pad' = pad (if rightside then left else right)
217-
218-
-- | Trim a piece of text if it is wider than given.
219-
trimIfWider :: Bool -> Bool -> Int -> Text -> Text
220-
trimIfWider ellipsify rightside w t
221-
| visibleLength (WideText t) > w = trim (if rightside then left else right) (if ellipsify then singleCutMark ".." else noCutMark) w $ WideText t
222-
| otherwise = t
219+
pos = if rightside then left else right
220+
cm = if ellipsify then singleCutMark ".." else noCutMark
223221

224222
-- | Double-width-character-aware string truncation. Take as many
225223
-- characters as possible from a string without exceeding the
226224
-- specified width. Eg textTakeWidth 3 "りんご" = "り".
227225
textTakeWidth :: Int -> Text -> Text
228-
textTakeWidth = trimIfWider False True
226+
textTakeWidth n = trim left noCutMark n . WideText
229227

230228
-- | Add a prefix to each line of a string.
231229
linesPrepend :: Text -> Text -> Text
@@ -253,14 +251,15 @@ unlinesB = foldMap (<> TB.singleton '\n')
253251

254252
-- | A Table contains information about the row and column headers, as well as a table of data.
255253
data Table rh ch a = Table (HeaderSpec LineStyle rh) (HeaderSpec LineStyle ch) [[a]]
254+
deriving (Functor)
256255

257256
-- | Add the second table below the first, discarding its column headings.
258-
concatTables :: Monoid a => LineStyle -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
257+
concatTables :: Cell a => LineStyle -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
259258
concatTables prop (Table hLeft hTop dat) (Table hLeft' _ dat') =
260259
Table (groupH prop [hLeft, hLeft']) hTop (map padRow $ dat ++ dat')
261260
where
262261
numCols = length $ headerContents hTop
263-
padRow r = replicate (numCols - length r) mempty ++ r
262+
padRow r = replicate (numCols - length r) emptyCell ++ r
264263

265264
-- | An alias for formatted text measured by display length.
266265
type RenderText = Formatted WideText

0 commit comments

Comments
 (0)