From 4f489974ab5095ac559723b0ab721bf044fadf03 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 26 Apr 2022 01:32:01 +1000 Subject: [PATCH] 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 | 112 +++-------------- hledger-lib/Hledger/Reports/BudgetReport.hs | 48 ++++---- .../Hledger/Reports/MultiBalanceReport.hs | 10 +- hledger-lib/Hledger/Utils/Text.hs | 25 ++-- hledger-ui/Hledger/UI/AccountsScreen.hs | 7 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 17 +-- hledger-ui/Hledger/UI/UITypes.hs | 15 +-- hledger-ui/hledger-ui.cabal | 3 +- hledger-ui/package.yaml | 1 + hledger/Hledger/Cli/Commands/Balance.hs | 113 +++++++++--------- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 7 +- hledger/test/balance/format.test | 2 +- .../test/check-balancednoautoconversion.test | 2 +- .../test/errors/balancednoautoconversion.test | 4 +- 14 files changed, 148 insertions(+), 218 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 45184ecf76e..31ceaa65a1b 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/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 diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 6d17e392820..830af511c45 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/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') +import Data.List (find, intersperse, partition, transpose, foldl') import Data.List.Extra (nubSort) import Data.Maybe (fromMaybe, catMaybes) import Data.Map (Map) @@ -217,7 +217,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 @@ -301,11 +301,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 = @@ -321,22 +323,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] @@ -345,21 +346,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 @@ -375,7 +369,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. @@ -435,7 +429,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 diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 69d11b3a00c..59ecffac1c7 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/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 @@ -589,15 +590,16 @@ cumulativeSum value start = snd . M.mapAccumWithKey accumValued start -- 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 diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index fc4f42a35a9..97c7e4c0adf 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index ea82a36e86a..02d337a48ca 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -26,6 +26,7 @@ import Safe import System.Console.ANSI import System.FilePath (takeFileName) import Text.DocLayout (realLength) +import Text.Layout.Table import Hledger import Hledger.Cli hiding (progname,prognameandversion) @@ -214,10 +215,10 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = txt balspace <+> splitAmounts balBuilder where - balBuilder = maybe mempty showamt asItemMixedAmount - showamt = showMixedAmountB oneLine{displayMinWidth=Just balwidth, displayMaxWidth=Just balwidth} + balBuilder = maybe emptyCell showamt asItemMixedAmount + showamt = trimOrPad right (singleCutMark "..") balwidth . showMixedAmountOneLineB noPrice balspace = T.replicate (2 + balwidth - visibleLength balBuilder) " " - splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . buildCell + splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " renderamt :: T.Text -> Widget Name renderamt a | T.any (=='-') a = withAttr (sel $ "list" <> "balance" <> "negative") $ txt a | otherwise = withAttr (sel $ "list" <> "balance" <> "positive") $ txt a diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index fb44df5d8c9..7d02756d958 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -28,6 +28,7 @@ import Brick.Widgets.Edit import Lens.Micro.Platform import Safe import System.Console.ANSI +import Text.Layout.Table import Hledger @@ -98,7 +99,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec ,rsItemBalanceAmount = showamt bal ,rsItemTransaction = t } - where showamt = showMixedAmountB oneLine{displayMaxWidth=Just 32} + where showamt = showMixedAmountOneLineB noPrice -- blank items are added to allow more control of scroll position; we won't allow movement over these. -- XXX Ugly. Changing to 0 helps when debugging. blankitems = replicate 100 -- "100 ought to be enough for anyone" @@ -106,8 +107,8 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec ,rsItemStatus = Unmarked ,rsItemDescription = "" ,rsItemOtherAccounts = "" - ,rsItemChangeAmount = mempty - ,rsItemBalanceAmount = mempty + ,rsItemChangeAmount = emptyCell + ,rsItemBalanceAmount = emptyCell ,rsItemTransaction = nulltransaction } -- build the List @@ -165,8 +166,8 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} whitespacewidth = 10 -- inter-column whitespace, fixed width minnonamtcolswidth = datewidth + 1 + 2 + 2 -- date column plus at least 1 for status and 2 for desc and accts maxamtswidth = max 0 (totalwidth - minnonamtcolswidth - whitespacewidth) - maxchangewidthseen = maximum' $ map (visibleLength . rsItemChangeAmount) displayitems - maxbalwidthseen = maximum' $ map (visibleLength . rsItemBalanceAmount) displayitems + maxchangewidthseen = min maxAmountWidth . maximum' $ map (visibleLength . rsItemChangeAmount) displayitems + maxbalwidthseen = min maxAmountWidth . maximum' $ map (visibleLength . rsItemBalanceAmount) displayitems changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen) maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth maxbalwidth = maxamtswidth - maxchangewidth @@ -268,8 +269,8 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist txt " " <+> withAttr balattr (txt $ fitText (Just balwidth) (Just balwidth) True False balanceAmt) where - changeAmt = buildCell rsItemChangeAmount - balanceAmt = buildCell rsItemBalanceAmount + changeAmt = trim right (singleCutMark "..") maxAmountWidth rsItemChangeAmount + balanceAmt = trim right (singleCutMark "..") maxAmountWidth rsItemBalanceAmount changeattr | T.any (=='-') changeAmt = sel $ "list" <> "amount" <> "decrease" | otherwise = sel $ "list" <> "amount" <> "increase" balattr | T.any (=='-') balanceAmt = sel $ "list" <> "balance" <> "negative" @@ -419,6 +420,8 @@ rsHandle _ _ = error "event handler called with wrong screen type, should not ha isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just "" +maxAmountWidth = 32 + rsCenterAndContinue ui = do scrollSelectionToMiddle $ rsList $ aScreen ui continue ui diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 1203b8aa3d1..dbbd298eb75 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -44,6 +44,7 @@ import Brick import Brick.Widgets.List (List) import Brick.Widgets.Edit (Editor) import Lens.Micro.Platform +import Text.Layout.Table.Cell.ElidableList (ElidableList) import Text.Show.Functions () -- import the Show instance for functions. Warning, this also re-exports it @@ -144,13 +145,13 @@ data AccountsScreenItem = AccountsScreenItem { -- | An item in the register screen's list of transactions in the current account. data RegisterScreenItem = RegisterScreenItem { - rsItemDate :: Text -- ^ date - ,rsItemStatus :: Status -- ^ transaction status - ,rsItemDescription :: Text -- ^ description - ,rsItemOtherAccounts :: Text -- ^ other accounts - ,rsItemChangeAmount :: RenderText -- ^ the change to the current account from this transaction - ,rsItemBalanceAmount :: RenderText -- ^ the balance or running total after this transaction - ,rsItemTransaction :: Transaction -- ^ the full transaction + rsItemDate :: Text -- ^ date + ,rsItemStatus :: Status -- ^ transaction status + ,rsItemDescription :: Text -- ^ description + ,rsItemOtherAccounts :: Text -- ^ other accounts + ,rsItemChangeAmount :: ElidableList String RenderText -- ^ the change to the current account from this transaction + ,rsItemBalanceAmount :: ElidableList String RenderText -- ^ the balance or running total after this transaction + ,rsItemTransaction :: Transaction -- ^ the full transaction } deriving (Show) diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index 565ab734375..6846385456b 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack @@ -86,6 +86,7 @@ executable hledger-ui , process >=1.2 , safe >=0.2 , split >=0.1 + , table-layout >=0.9.1.0 , text >=1.2 , text-zipper >=0.4 , time >=1.5 diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml index f4bd2da2357..aee75a39f34 100644 --- a/hledger-ui/package.yaml +++ b/hledger-ui/package.yaml @@ -70,6 +70,7 @@ dependencies: - process >=1.2 - safe >=0.2 - split >=0.1 +- table-layout >=0.9.1.0 - text >=1.2 - text-zipper >=0.4 - time >=1.5 diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 01946b986dc..de67c1c220a 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -268,8 +268,9 @@ import Data.Time (addDays, fromGregorian) import Lucid (Html, toHtml, class_, style_, table_, td_, th_, tr_) import qualified Lucid as L import System.Console.CmdArgs.Explicit as C -import Safe (maximumMay) import Text.Layout.Table +import Text.Layout.Table.Cell.ElidableList (ElidableList) +import Text.Layout.Table.Primitives.ColumnModifier (deriveColModInfos') import Hledger import Hledger.Cli.CliOptions @@ -432,12 +433,11 @@ balanceReportAsText opts ((items, total)) = (totalLines, _) = balanceReportItemAsText opts ("", "", 0, total) -- with a custom format, extend the line to the full report width; -- otherwise show the usual 20-char line for compatibility - iscustom = case format_ opts of - OneLine ((FormatField _ _ _ TotalField):_) -> False - TopAligned ((FormatField _ _ _ TotalField):_) -> False - BottomAligned ((FormatField _ _ _ TotalField):_) -> False - _ -> True - overlinewidth = if iscustom then sum (map maximum' $ transpose sizes) else 20 + overlinewidth = case format_ opts of + OneLine ((FormatField _ w _ TotalField):_) -> fromMaybe 20 w + TopAligned ((FormatField _ w _ TotalField):_) -> fromMaybe 20 w + BottomAligned ((FormatField _ w _ TotalField):_) -> fromMaybe 20 w + _ -> sum . map maximum' $ transpose sizes overline = TB.fromText $ T.replicate overlinewidth "-" {- @@ -459,8 +459,12 @@ balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> (TB.Builder, [Int] balanceReportItemAsText opts (_, acctname, depth, total) = renderRow' $ concatMap (renderComponent oneline opts (acctname, depth, total)) comps where - renderRow' is = ( concatLines . map mconcat . gridB (concatMap colSpec comps) $ colsAsRowsAll vPos is - , map (fromMaybe 0 . maximumMay . map visibleLength) is ) + renderRow' is = (concatLines . map mconcat $ gridB specs tab, map (widthCMI . unalignedCMI) cmis) + where + -- Deconstruct some of gridB to get access to the widths + cmis = deriveColModInfos' specs tab + specs = concatMap colSpec comps + tab = colsAsRowsAll vPos is (vPos, oneline, comps) = case format_ opts of OneLine comps -> (top, True, comps) @@ -468,29 +472,37 @@ balanceReportItemAsText opts (_, acctname, depth, total) = BottomAligned comps -> (bottom, False, comps) -- If we're using LayoutBare, the commodity column goes after the totals column, along with a spacing column. - colSpec (FormatField ljust _ _ TotalField) | layout_ opts == LayoutBare = col ljust : replicate 2 (col True) - colSpec (FormatField ljust _ _ _) = [col ljust] - colSpec (FormatLiteral _) = [col True] - col ljust = column expand (if ljust then left else right) noAlign (singleCutMark "..") + colSpec (FormatField ljust mmin mmax TotalField) | layout_ opts == LayoutBare + = col ljust mmin mmax : replicate 2 (col True Nothing Nothing) + colSpec (FormatField _ _ _ DepthSpacerField) = [col True Nothing Nothing] + colSpec (FormatField ljust mmin mmax _) = [col ljust mmin mmax] + colSpec (FormatLiteral _) = [col True Nothing Nothing] + col ljust mmin mmax = column lenSpec (if ljust then left else right) noAlign (singleCutMark "..") + where + lenSpec = case (mmin, mmax) of + (Nothing, Nothing) -> expand + (Just m, Nothing) -> fixedUntil m + (Nothing, Just n ) -> expandUntil n + (Just m, Just n ) -> expandBetween m n -- | Render one StringFormat component for a balance report item. -renderComponent :: Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> [[RenderText]] -renderComponent _ _ _ (FormatLiteral s) = [[renderText s]] -renderComponent oneline opts (acctname, depth, total) (FormatField ljust mmin mmax field) = case field of - DepthSpacerField -> [[renderText $ T.replicate d " "]] +renderComponent :: Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent + -> [[Either (ElidableList String RenderText) RenderText]] +renderComponent _ _ _ (FormatLiteral s) = [[Right $ renderText s]] +renderComponent oneline opts (acctname, depth, total) (FormatField _ mmin mmax field) = case field of + DepthSpacerField -> [[Right . renderText $ T.replicate d " "]] where d = maybe id min mmax $ depth * fromMaybe 1 mmin - AccountField -> [[renderText $ formatText ljust mmin mmax acctname]] + AccountField -> [[Right $ renderText acctname]] -- Add commodities after the amounts, if LayoutBare is used. - TotalField | oneline -> [showMixedAmountB dopts total] : commoditiesColumns - TotalField -> showMixedAmountLinesB dopts total : commoditiesColumns + TotalField | oneline -> [Left $ showMixedAmountOneLineB dopts total] : map (map Right) commoditiesColumns + TotalField -> map (map Right) $ showMixedAmountLinesB dopts total : commoditiesColumns _ -> [[]] where - dopts = noPrice{ displayColour=color_ opts, displayOneLine=oneline, displayOrder=commodities - , displayMinWidth=mmin, displayMaxWidth=mmax} + dopts = noPrice{displayColour=color_ opts, displayOrder=commodities} commodities = case layout_ opts of LayoutBare -> Just $ if mixedAmountLooksZero total then [""] else S.toList $ maCommodities total _ -> Nothing - commoditiesColumns = maybe [] (\cs -> [[renderText " "], map renderText cs]) commodities + commoditiesColumns = maybe [] (\cs -> [[" "], map renderText cs]) commodities -- rendering multi-column balance reports @@ -647,7 +659,8 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $ _ -> False -- | Build a 'Table' from a multi-column balance report. -balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text RenderText +balanceReportAsTable :: ReportOpts -> MultiBalanceReport + -> Table T.Text T.Text (Either (ElidableList String RenderText) RenderText) balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} (PeriodicReport spans items tr) = maybetranspose $ @@ -685,26 +698,32 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} multiBalanceRowAsCsvText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]] multiBalanceRowAsCsvText opts colspans = map (map buildCell) . multiBalanceRowAsTableTextHelper csvDisplay opts colspans -multiBalanceRowAsTableText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[RenderText]] +multiBalanceRowAsTableText :: ReportOpts -> PeriodicReportRow a MixedAmount + -> [[Either (ElidableList String RenderText) RenderText]] multiBalanceRowAsTableText opts = multiBalanceRowAsTableTextHelper oneLine{displayColour=color_ opts} opts [] -multiBalanceRowAsTableTextHelper :: AmountDisplayOpts -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[RenderText]] +-- | Represent a 'PeriodicReportRow' as a table of renderable text. There is +-- one row per line and each row has a number of columns corresponding to the dates. +multiBalanceRowAsTableTextHelper :: AmountDisplayOpts -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount + -> [[Either (ElidableList String RenderText) RenderText]] multiBalanceRowAsTableTextHelper bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = case layout_ of - LayoutWide width -> [fmap (showMixedAmountB bopts{displayMaxWidth=width}) allamts] - LayoutTall -> paddedTranspose mempty - . fmap (showMixedAmountLinesB bopts{displayMaxWidth=Nothing}) - $ allamts - LayoutBare -> zipWith (:) (map renderText cs) -- add symbols - . transpose -- each row becomes a list of Text quantities - . map (showMixedAmountLinesB bopts{displayOrder=Just cs, displayMinWidth=Nothing}) - $ allamts - LayoutTidy -> concat - . zipWith (map . addDateColumns) colspans - . fmap ( zipWith (\c a -> [renderText c, a]) cs - . showMixedAmountLinesB bopts{displayOrder=Just cs, displayMinWidth=Nothing}) - $ as -- Do not include totals column or average for tidy output, as this - -- complicates the data representation and can be easily calculated + LayoutWide _ -> [map (Left . showMixedAmountOneLineB bopts) allamts] + LayoutTall -> map (map Right) + . colsAsRowsAll top + . map (showMixedAmountLinesB bopts) + $ allamts + LayoutBare -> map (map Right) + . zipWith (:) (map renderText cs) -- add symbols + . colsAsRowsAll top -- each row becomes a list of Text quantities + . map (showMixedAmountLinesB bopts{displayOrder=Just cs}) + $ allamts + LayoutTidy -> map (map Right) . concat + . zipWith (map . addDateColumns) colspans + . map ( zipWith (\c a -> [renderText c, a]) cs + . showMixedAmountLinesB bopts{displayOrder=Just cs}) + $ as -- Do not include totals column or average for tidy output, as this + -- complicates the data representation and can be easily calculated where totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts @@ -713,20 +732,6 @@ multiBalanceRowAsTableTextHelper bopts ReportOpts{..} colspans (PeriodicReportRo . (renderText (maybe "" showDate s) :) . (renderText (maybe "" (showDate . addDays (-1)) e) :) - paddedTranspose :: a -> [[a]] -> [[a]] - paddedTranspose _ [] = [[]] - paddedTranspose n as = take (maximum . map length $ as) . trans $ as - where - trans ([] : xss) = (n : map h xss) : trans ([n] : map t xss) - trans ((x : xs) : xss) = (x : map h xss) : trans (m xs : map t xss) - trans [] = [] - h (x:_) = x - h [] = n - t (_:xs) = xs - t [] = [n] - m (x:xs) = x:xs - m [] = [n] - tests_Balance = testGroup "Balance" [ testGroup "balanceReportAsText" [ diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 2cadce5296c..6bbea3bc865 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -22,6 +22,7 @@ import Data.Time.Calendar (Day, addDays) import System.Console.CmdArgs.Explicit as C import Lucid as L hiding (value_) import Text.Layout.Table +import Text.Layout.Table.Cell.ElidableList (ElidableList) import Hledger import Hledger.Read.CsvReader (CSV, printCSV) @@ -219,7 +220,7 @@ compoundBalanceReportAsText ropts where bigtable = case map (subreportAsTable ropts) subreports of - [] -> Table (T.pack <$> noneH) (T.pack <$> noneH) [[]] :: Table T.Text T.Text RenderText + [] -> Table (T.pack <$> noneH) (T.pack <$> noneH) [[]] :: Table T.Text T.Text (Either (ElidableList String RenderText) RenderText) r:rs -> foldl' (concatTables DoubleLine) r rs bigtable' | no_total_ ropts || length subreports == 1 = @@ -232,13 +233,13 @@ compoundBalanceReportAsText ropts -- | Convert a named multi balance report to a table suitable for -- concatenating with others to make a compound balance report table. - subreportAsTable :: ReportOpts -> (T.Text, MultiBalanceReport, w) -> Table T.Text T.Text RenderText + subreportAsTable :: ReportOpts -> (T.Text, MultiBalanceReport, w) -> Table T.Text T.Text (Either (ElidableList String RenderText) RenderText) subreportAsTable ropts (title, r, _) = t where -- convert to table Table lefthdrs tophdrs cells = balanceReportAsTable ropts r -- tweak the layout - t = Table (groupH SingleLine [headerH (headerColumn left Nothing) title, lefthdrs]) tophdrs (replicate (length $ headerContents tophdrs) mempty : cells) + t = Table (groupH SingleLine [headerH (headerColumn left Nothing) title, lefthdrs]) tophdrs (replicate (length $ headerContents tophdrs) emptyCell : cells) -- | Render a compound balance report as CSV. -- Subreports' CSV is concatenated, with the headings rows replaced by a diff --git a/hledger/test/balance/format.test b/hledger/test/balance/format.test index 798363199ab..79765b2e1ad 100644 --- a/hledger/test/balance/format.test +++ b/hledger/test/balance/format.test @@ -22,7 +22,7 @@ $ hledger -f sample.journal balance --tree --format="%30(account) %-.20(total)" # Test too-small maximum balance widths $ hledger -f - balance -N --format="%7.7(total) %(account)" > -1 mor.. a +..0 AAA a 500 AAA b >= 0 diff --git a/hledger/test/check-balancednoautoconversion.test b/hledger/test/check-balancednoautoconversion.test index 780b8f80ef4..52704d4559e 100644 --- a/hledger/test/check-balancednoautoconversion.test +++ b/hledger/test/check-balancednoautoconversion.test @@ -4,5 +4,5 @@ a -10£ b 16$ $ hledger -f - check balancednoautoconversion ->2 /real postings' sum should be 0 but is: 16\$/ +>2 /real postings' sum should be 0 but is: 16\$/ >=1 diff --git a/hledger/test/errors/balancednoautoconversion.test b/hledger/test/errors/balancednoautoconversion.test index 69ad32145ad..42b52058e4b 100644 --- a/hledger/test/errors/balancednoautoconversion.test +++ b/hledger/test/errors/balancednoautoconversion.test @@ -1,11 +1,11 @@ $$$ hledger check balancednoautoconversion -f balancednoautoconversion.j >>>2 /hledger: Error: .*balancednoautoconversion.j:6-8 could not balance this transaction: -real postings' sum should be 0 but is: 1 A +real postings' sum should be 0 but is: 1 A -1 B 2022-01-01 a 1 A b -1 B / ->>>= 1 \ No newline at end of file +>>>= 1