From 460c3b7eefd8a81c1c10f7c2b6e82f32639a8f23 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 25 Mar 2022 00:23:05 +1100 Subject: [PATCH 1/8] ref!: tabular: Port Text utilities over to table-layout library. --- hledger-lib/Hledger/Utils/Text.hs | 73 +++++++++++++------------------ hledger-lib/hledger-lib.cabal | 5 ++- hledger-lib/package.yaml | 1 + stack.yaml | 2 + stack8.10.yaml | 2 + stack8.6.yaml | 2 + stack8.8.yaml | 2 + stack9.0.yaml | 2 + stack9.2.yaml | 46 +++++++++++++++++++ 9 files changed, 92 insertions(+), 43 deletions(-) create mode 100644 stack9.2.yaml diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index a91f5433f30..134fb15afde 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -44,6 +44,11 @@ module Hledger.Utils.Text wbFromText, wbUnpack, textTakeWidth, + -- ** table layout + module Text.Layout.Table.Cell.Formatted, + module Text.Layout.Table.Cell.WideString, + RenderText, + renderText, -- * Reading readDecimal, -- * tests @@ -52,17 +57,16 @@ module Hledger.Utils.Text where import Data.Char (digitToInt) -import Data.Default (def) 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 Text.DocLayout (charWidth, realLength) +import Text.Layout.Table +import Text.Layout.Table.Cell +import Text.Layout.Table.Cell.Formatted +import Text.Layout.Table.Cell.WideString import Test.Tasty (testGroup) import Test.Tasty.HUnit ((@?=), testCase) -import Text.Tabular.AsciiWide - (Align(..), Header(..), Properties(..), TableOpts(..), renderRow, textCell) import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack) @@ -185,14 +189,14 @@ textUnbracket s -- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded. -- Treats wide characters as double width. textConcatTopPadded :: [Text] -> Text -textConcatTopPadded = TL.toStrict . renderRow def{tableBorders=False, borderSpaces=False} - . Group NoLine . map (Header . textCell BottomLeft) +textConcatTopPadded = concatLines . map mconcat . gridB (repeat def) + . colsAsRowsAll bottom . map (map WideText) . map T.lines -- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded. -- Treats wide characters as double width. textConcatBottomPadded :: [Text] -> Text -textConcatBottomPadded = TL.toStrict . renderRow def{tableBorders=False, borderSpaces=False} - . Group NoLine . map (Header . textCell TopLeft) +textConcatBottomPadded = concatLines . map mconcat . gridB (repeat def) + . colsAsRowsAll top . map (map WideText) . map T.lines -- -- Functions below treat wide (eg CJK) characters as double-width. @@ -202,50 +206,29 @@ textConcatBottomPadded = TL.toStrict . renderRow def{tableBorders=False, borderS -- 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 = clip . pad +fitText mminwidth mmaxwidth ellipsify rightside = + maybe id clip' mmaxwidth . maybe buildCell pad' mminwidth . WideText where - clip :: Text -> Text - clip s = - case mmaxwidth of - Just w - | realLength s > w -> - if rightside - then textTakeWidth (w - T.length ellipsis) s <> ellipsis - else ellipsis <> T.reverse (textTakeWidth (w - T.length ellipsis) $ T.reverse s) - | otherwise -> s - where - ellipsis = if ellipsify then ".." else "" - Nothing -> s - pad :: Text -> Text - pad s = - case mminwidth of - Just w - | sw < w -> - if rightside - then s <> T.replicate (w - sw) " " - else T.replicate (w - sw) " " <> s - | otherwise -> s - Nothing -> s - where sw = realLength s + 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 -- | 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 _ "" = "" -textTakeWidth 0 _ = "" -textTakeWidth w t | not (T.null t), - let c = T.head t, - let cw = charWidth c, - cw <= w - = T.cons c $ textTakeWidth (w-cw) (T.tail t) - | otherwise = "" +textTakeWidth = trimIfWider False True -- | Add a prefix to each line of a string. linesPrepend :: Text -> Text -> Text linesPrepend prefix = T.unlines . map (prefix<>) . T.lines --- | Add a prefix to the first line of a string, +-- | Add a prefix to the first line of a string, -- and a different prefix to the remaining lines. linesPrepend2 :: Text -> Text -> Text -> Text linesPrepend2 prefix1 prefix2 s = T.unlines $ case T.lines s of @@ -262,6 +245,12 @@ readDecimal :: Text -> Integer readDecimal = T.foldl' step 0 where step a c = a * 10 + toInteger (digitToInt c) +-- | An alias for formatted text measured by display length. +type RenderText = Formatted WideText + +-- | Wrap 'Text' in a TextWide wrapper and apply trivial formatting. +renderText :: Text -> RenderText +renderText = plain . WideText tests_Text = testGroup "Text" [ testCase "quoteIfSpaced" $ do diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 65d97ab1cab..612752523ed 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.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 @@ -126,6 +126,7 @@ library , pretty-simple >4 && <5 , regex-tdfa , safe >=0.3.19 + , table-layout >=0.9.1.0 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 @@ -177,6 +178,7 @@ test-suite doctest , pretty-simple >4 && <5 , regex-tdfa , safe >=0.3.19 + , table-layout >=0.9.1.0 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 @@ -230,6 +232,7 @@ test-suite unittest , pretty-simple >4 && <5 , regex-tdfa , safe >=0.3.19 + , table-layout >=0.9.1.0 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index fbdf78a90ac..83f5dc2e5c7 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -60,6 +60,7 @@ dependencies: - regex-tdfa - safe >=0.3.19 - tabular >=0.2 +- table-layout >=0.9.1.0 - tasty >=1.2.3 - tasty-hunit >=0.10.0.2 - template-haskell diff --git a/stack.yaml b/stack.yaml index 595c808ca07..aee834aa17f 100644 --- a/stack.yaml +++ b/stack.yaml @@ -10,6 +10,8 @@ packages: extra-deps: # for hledger-lib: +- git: https://github.com/Xitian9/table-layout + commit: 37e5bff454c1895891d52c08a2b42ea59b695a5c # for hledger: # for hledger-ui: - brick-1.0 diff --git a/stack8.10.yaml b/stack8.10.yaml index 5f1eb93b0fc..fc899f5531b 100644 --- a/stack8.10.yaml +++ b/stack8.10.yaml @@ -15,6 +15,8 @@ packages: extra-deps: # for hledger-lib: - doctest-0.20.0 +- git: https://github.com/Xitian9/table-layout + commit: 37e5bff454c1895891d52c08a2b42ea59b695a5c # for hledger: # for hledger-ui: - brick-1.0 diff --git a/stack8.6.yaml b/stack8.6.yaml index 56a5d401d08..9366b42ec02 100644 --- a/stack8.6.yaml +++ b/stack8.6.yaml @@ -30,6 +30,8 @@ extra-deps: - prettyprinter-ansi-terminal-1.1.2 - doctest-0.18.1 - safe-0.3.19 +- git: https://github.com/Xitian9/table-layout + commit: 37e5bff454c1895891d52c08a2b42ea59b695a5c # for hledger: - githash-0.1.6.2 - th-compat-0.1.4 diff --git a/stack8.8.yaml b/stack8.8.yaml index 29177e09ceb..5a64c7247fb 100644 --- a/stack8.8.yaml +++ b/stack8.8.yaml @@ -19,6 +19,8 @@ extra-deps: - doctest-0.18.1 - doclayout-0.3.1.1 - emojis-0.1.2 +- git: https://github.com/Xitian9/table-layout + commit: 37e5bff454c1895891d52c08a2b42ea59b695a5c # for hledger: - githash-0.1.6.2 - th-compat-0.1.4 diff --git a/stack9.0.yaml b/stack9.0.yaml index 2674a0d870d..a1b022af62e 100644 --- a/stack9.0.yaml +++ b/stack9.0.yaml @@ -18,6 +18,8 @@ packages: extra-deps: # for hledger-lib: +- git: https://github.com/Xitian9/table-layout + commit: 37e5bff454c1895891d52c08a2b42ea59b695a5c # for hledger: # for hledger-ui: - brick-1.0 diff --git a/stack9.2.yaml b/stack9.2.yaml new file mode 100644 index 00000000000..dad8a071077 --- /dev/null +++ b/stack9.2.yaml @@ -0,0 +1,46 @@ +# stack build plan using GHC 9.2.2 + +resolver: nightly-2022-03-25 + +packages: +- hledger-lib +- hledger +- hledger-ui +# - hledger-web + +# for hledger-web +#allow-newer: true +extra-deps: +# for hledger-lib: +- git: https://github.com/Xitian9/table-layout + commit: 37e5bff454c1895891d52c08a2b42ea59b695a5c +# for hledger: +# for hledger-ui: +# for hledger-web: +# - yesod-1.6.2@sha256:4359fcb48a1e8a5cf862338de0fad56d9a50f038c8774137257bcb5276545ec0,2028 +# - yesod-static-1.6.1.0@sha256:0f075bcb8c90626ef738367333e3ac745fd7872619c6db388c0555f2ce768a5a,4419 +# - yesod-test-1.6.12@sha256:3a44e58051da38ba3cc2f29a3f2579a4a1c68c3077b5c5d2ad2f4f792d737184,2924 +# - yesod-core-1.6.21.0@sha256:d95ce6c0ff787a617fd0e1a6d4fc09ea57745ffca1e3795b01248ffcf596f83f,8124 +# - yesod-form-1.7.0@sha256:fd857fb9ea4f5af8500ec8613aa026e3a478c874b93da9d8ab8f17f329ec8c9e,3387 +# - yesod-persistent-1.6.0.7@sha256:7ece60b1a1e0c9f56ec2f1cf67dd9d0c3962ccabc878b975bef7f743709d267d,1732 +# - base64-0.4.2.3@sha256:97bd6f7decaab6110725ef1675a3ed8576233f6bab6599bb813f6caf68d36c94,2876 # doesn't build with 9.2 yet +# for Shake.hs: + +nix: + pure: false + packages: [perl gmp ncurses zlib] + +# # for precise profiling, per https://www.tweag.io/posts/2020-01-30-haskell-profiling.html: +# # apply-ghc-options: everything +# # rebuild-ghc-options: true +# # stack build --profile --ghc-options="-fno-prof-auto" + +# # tell GHC to write hie files, eg for weeder. Rumoured to be slow. +# # ghc-options: +# # "$locals": -fwrite-ide-info + +# # ghc-options: +# # "$locals": -ddump-timings +# # "$targets": -Werror +# # "$everything": -O2 +# # some-package: -DSOME_CPP_FLAG From 6119977bccbafa997902aa4c0784e8e64c379d72 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Thu, 24 Mar 2022 23:32:04 +1100 Subject: [PATCH 2/8] ref!: tabular: Port register, aregister, and stats over to table-layout. --- hledger-lib/Hledger/Data/Posting.hs | 30 +++++++++-------------- hledger/Hledger/Cli/Commands/Aregister.hs | 27 +++++++------------- hledger/Hledger/Cli/Commands/Register.hs | 25 ++++++------------- hledger/Hledger/Cli/Commands/Stats.hs | 21 ++++++---------- hledger/hledger.cabal | 4 +++ hledger/package.yaml | 1 + hledger/test/journal/include.test | 4 +-- 7 files changed, 43 insertions(+), 69 deletions(-) diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index a8142dbfbce..16fb616be81 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -72,7 +72,6 @@ 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) @@ -80,13 +79,11 @@ 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 Text.Layout.Table.Cell (Cell(..)) import Hledger.Utils import Hledger.Data.Types @@ -236,22 +233,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 . map (map renderText) $ + case showBalanceAssertion <$> pbalanceassertion p of + Nothing -> [ [statusandaccount, "", wbToText amt, T.drop 1 samelinecomment] | amt <- shownAmounts ] + Just asst -> [ [statusandaccount, "", wbToText amt, wbToText asst, 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 + thisacctwidth = visibleLength . renderText $ pacctstr p pacctstr p' = showAccountName Nothing (ptype p') (paccount p') pstatusandacct p' = pstatusprefix p' <> pacctstr p' diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 121fa3de94c..99f27b5e7f3 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -19,24 +19,23 @@ module Hledger.Cli.Commands.Aregister ( ,tests_Aregister ) where -import Data.Default (def) import Data.List (find) import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import System.Console.CmdArgs.Explicit (flagNone, flagReq) +import Text.Layout.Table import Hledger import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils -import Text.Tabular.AsciiWide aregistermode = hledgerCommandMode $(embedFileRelative "Hledger/Cli/Commands/Aregister.txt") ([ - flagNone ["txn-dates"] (setboolopt "txn-dates") + flagNone ["txn-dates"] (setboolopt "txn-dates") "filter strictly by transaction date, not posting date. Warning: this can show a wrong running balance." ,flagNone ["no-elide"] (setboolopt "no-elide") "don't show only 2 commodities per amount" -- flagNone ["cumulative"] (setboolopt "cumulative") @@ -171,21 +170,13 @@ accountTransactionsReportItemAsText -- MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction table <> TB.singleton '\n' where - table = renderRowB def{tableBorders=False, borderSpaces=False} . Group NoLine $ map Header - [ textCell TopLeft $ fitText (Just datewidth) (Just datewidth) True True date - , spacerCell - , textCell TopLeft $ fitText (Just descwidth) (Just descwidth) True True tdescription - , spacerCell2 - , textCell TopLeft $ fitText (Just acctwidth) (Just acctwidth) True True accts - , spacerCell2 - , Cell TopRight $ map (pad amtwidth) amt - , spacerCell2 - , Cell BottomRight $ map (pad balwidth) bal - ] - spacerCell = Cell BottomLeft [WideBuilder (TB.singleton ' ') 1] - spacerCell2 = Cell BottomLeft [WideBuilder (TB.fromString " ") 2] - pad fullwidth amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt - where w = fullwidth - wbWidth amt + table = gridStringB colSpec $ colsAsRows [top, top, top, top, top, top, top, bottom] $ map (map renderText) + [[date], [tdescription], [""], [accts], [""], map wbToText amt, [""], map wbToText bal] + where + colSpec = [cl datewidth, cl descwidth, cl 0, cl acctwidth, cl 0, cr amtwidth, cl 0, cr balwidth] + cl width = column (fixed width) left noAlign (singleCutMark "..") + cr width = column (fixed width) right noAlign (singleCutMark "..") + -- calculate widths (totalwidth,mdescwidth) = registerWidthsFromOpts copts (datewidth, date) = (10, showDate $ transactionRegisterDate wd reportq thisacctq t) diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 638d7fc5b9f..13e1094c10e 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -18,18 +18,17 @@ module Hledger.Cli.Commands.Register ( ,tests_Register ) where -import Data.Default (def) import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import System.Console.CmdArgs.Explicit (flagNone, flagReq) +import Text.Layout.Table import Hledger import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils -import Text.Tabular.AsciiWide registermode = hledgerCommandMode $(embedFileRelative "Hledger/Cli/Commands/Register.txt") @@ -131,21 +130,13 @@ postingsReportItemAsText :: CliOpts -> Int -> Int postingsReportItemAsText opts preferredamtwidth preferredbalwidth ((mdate, mperiod, mdesc, p, _), amt, bal) = table <> TB.singleton '\n' where - table = renderRowB def{tableBorders=False, borderSpaces=False} . Group NoLine $ map Header - [ textCell TopLeft $ fitText (Just datewidth) (Just datewidth) True True date - , spacerCell - , textCell TopLeft $ fitText (Just descwidth) (Just descwidth) True True desc - , spacerCell2 - , textCell TopLeft $ fitText (Just acctwidth) (Just acctwidth) True True acct - , spacerCell2 - , Cell TopRight $ map (pad amtwidth) amt - , spacerCell2 - , Cell BottomRight $ map (pad balwidth) bal - ] - spacerCell = Cell BottomLeft [WideBuilder (TB.singleton ' ') 1] - spacerCell2 = Cell BottomLeft [WideBuilder (TB.fromString " ") 2] - pad fullwidth amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt - where w = fullwidth - wbWidth amt + table = gridStringB colSpec $ colsAsRows [top, top, top, top, top, top, top, bottom] $ map (map renderText) + [[date], [desc], [""], [acct], [""], map wbToText amt, [""], map wbToText bal] + where + colSpec = [cl datewidth, cl descwidth, cl 0, cl acctwidth, cl 0, cr amtwidth, cl 0, cr balwidth] + cl width = column (fixed width) left noAlign (singleCutMark "..") + cr width = column (fixed width) right noAlign (singleCutMark "..") + -- calculate widths (totalwidth,mdescwidth) = registerWidthsFromOpts opts datewidth = maybe 10 periodTextWidth mperiod diff --git a/hledger/Hledger/Cli/Commands/Stats.hs b/hledger/Hledger/Cli/Commands/Stats.hs index 8549ea9b2f3..1279e6ee485 100644 --- a/hledger/Hledger/Cli/Commands/Stats.hs +++ b/hledger/Hledger/Cli/Commands/Stats.hs @@ -14,23 +14,22 @@ module Hledger.Cli.Commands.Stats ( ) where -import Data.Default (def) +import Data.HashSet (size, fromList) import Data.List (nub, sortOn) import Data.List.Extra (nubSort) +import qualified Data.Map as Map import Data.Maybe (fromMaybe) -import Data.HashSet (size, fromList) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day, addDays, diffDays) -import System.Console.CmdArgs.Explicit hiding (Group) +import Data.Time.Clock.POSIX (getPOSIXTime) +import System.Console.CmdArgs.Explicit import Text.Printf (printf) -import qualified Data.Map as Map +import Text.Layout.Table import Hledger import Hledger.Cli.CliOptions import Hledger.Cli.Utils (writeOutputLazyText) -import Text.Tabular.AsciiWide -import Data.Time.Clock.POSIX (getPOSIXTime) statsmode = hledgerCommandMode @@ -60,13 +59,9 @@ stats opts@CliOpts{reportspec_=rspec, progstarttime_} j = do (realToFrac dt :: Float) (fromIntegral numtxns / realToFrac dt :: Float) showLedgerStats :: Ledger -> Day -> DateSpan -> (TB.Builder, Int) -showLedgerStats l today span = - (unlinesB $ map (renderRowB def{tableBorders=False, borderSpaces=False} . showRow) stats - ,tnum) +showLedgerStats l today span = (gridStringB [def, def] $ map showRow stats, tnum) where - showRow (label, value) = Group NoLine $ map (Header . textCell TopLeft) - [fitText (Just w1) (Just w1) False True label `T.append` ": ", T.pack value] - w1 = maximum $ map (T.length . fst) stats + showRow (label, value) = [label <> ": ", T.pack value] (stats, tnum) = ([ ("Main file", path) -- ++ " (from " ++ source ++ ")") ,("Included files", unlines $ drop 1 $ journalFilePaths j) @@ -83,7 +78,7 @@ showLedgerStats l today span = -- Unmarked transactions : %(unmarked)s -- Days since reconciliation : %(reconcileelapsed)s -- Days since last transaction : %(recentelapsed)s - ] + ] ,tnum) where j = ljournal l diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 8d9323726ec..8bd1588e472 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -162,6 +162,7 @@ library , safe >=0.3.19 , shakespeare >=2.0.2.2 , split >=0.1 + , table-layout >=0.9.1.0 , tabular >=0.2 , tasty >=1.2.3 , temporary @@ -211,6 +212,7 @@ executable hledger , safe >=0.3.19 , shakespeare >=2.0.2.2 , split >=0.1 + , table-layout >=0.9.1.0 , tabular >=0.2 , tasty >=1.2.3 , temporary @@ -261,6 +263,7 @@ test-suite unittest , safe >=0.3.19 , shakespeare >=2.0.2.2 , split >=0.1 + , table-layout >=0.9.1.0 , tabular >=0.2 , tasty >=1.2.3 , temporary @@ -310,6 +313,7 @@ benchmark bench , safe >=0.3.19 , shakespeare >=2.0.2.2 , split >=0.1 + , table-layout >=0.9.1.0 , tabular >=0.2 , tasty >=1.2.3 , temporary diff --git a/hledger/package.yaml b/hledger/package.yaml index 58c6317949f..13760dc8f22 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -120,6 +120,7 @@ dependencies: - shakespeare >=2.0.2.2 - split >=0.1 - math-functions >=0.3.3.0 +- table-layout >=0.9.1.0 - tabular >=0.2 - tasty >=1.2.3 - temporary diff --git a/hledger/test/journal/include.test b/hledger/test/journal/include.test index 75cdf667694..0c2b82f38ad 100644 --- a/hledger/test/journal/include.test +++ b/hledger/test/journal/include.test @@ -78,7 +78,7 @@ include ~/included.journal # 7. test that order of include files is maintained printf 'include _b\n' >_a; touch _b; hledger -f _a stats | grep _ | sed -e 's%.*/%%'; rm -rf _a _b >>> -_a +_a _b >>>2 >>>=0 @@ -86,7 +86,7 @@ _b # 8. and with --auto code path printf 'include _d\n=\n' >_c; touch _d; hledger -f _c stats --auto | grep _ | sed -e 's%.*/%%'; rm -rf _c _d >>> -_c +_c _d >>>2 >>>=0 From a0fc5eac13a1ffb61b0bcf53f38f80ee780aaf48 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 25 Mar 2022 13:59:16 +1100 Subject: [PATCH 3/8] ref: tabular: Port MultiBalanceReport over to table-layout. --- .../Hledger/Reports/MultiBalanceReport.hs | 31 ++++++++++--------- hledger-lib/Hledger/Utils/Text.hs | 23 ++++++++++++++ hledger-lib/Text/Tabular/AsciiWide.hs | 8 +++-- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 2 +- 4 files changed, 47 insertions(+), 17 deletions(-) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 0a3a3795d05..c60738a20e4 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -51,8 +51,8 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Time.Calendar (fromGregorian) import Safe (lastDef, minimumMay) +import Text.Layout.Table -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 @@ -590,20 +590,23 @@ cumulativeSum start = snd . M.mapAccum (\a b -> let s = sumAcct a b in (s, s)) s -- 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{..} (Tab.Table rh ch cells) = + tableStringB colSpec style rowHeader colHeader rows <> 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 : repeat (col right) + _ -> repeat (col right) + where + col pos = column expand pos noAlign noCutMark + style = if pretty_ then hledgerPrettyStyle else hledgerStyle + rowHeader = renderText <$> translate left rh + colHeader = renderText <$> translate right ch + rows = map (rowG . map (renderText . wbToText)) cells + + translate pos (Tab.Group Tab.NoLine as) = groupH NoLine $ map (translate pos) as + translate pos (Tab.Group Tab.SingleLine as) = groupH SingleLine $ map (translate pos) as + translate pos (Tab.Group Tab.DoubleLine as) = groupH DoubleLine $ map (translate pos) as + translate pos (Tab.Header a) = headerH (headerColumn pos Nothing) a -- tests diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index 134fb15afde..039029667ee 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -49,6 +49,11 @@ module Hledger.Utils.Text module Text.Layout.Table.Cell.WideString, RenderText, renderText, + -- * table rendering + hledgerStyle, + hledgerStyleBorders, + hledgerPrettyStyle, + hledgerPrettyStyleBorders, -- * Reading readDecimal, -- * tests @@ -252,6 +257,24 @@ type RenderText = Formatted WideText renderText :: Text -> RenderText renderText = plain . WideText +-- | The 'TableStyle' used by hledger when using ascii characters. +hledgerStyle :: TableStyle LineStyle LineStyle +hledgerStyle = withoutBorders hledgerStyleBorders + +-- | The 'TableStyle' used by hledger when using ascii characters, including a border. +hledgerStyleBorders :: TableStyle LineStyle LineStyle +hledgerStyleBorders = asciiTableStyleFromSpec . setTableStyleSpecSeparator DoubleLine $ + simpleTableStyleSpec SingleLine SingleLine + +-- | The 'TableStyle' used by hledger allowing unicode characters. +hledgerPrettyStyle :: TableStyle LineStyle LineStyle +hledgerPrettyStyle = withoutBorders hledgerPrettyStyleBorders + +-- | The 'TableStyle' used by hledger allowing unicode characters, including a border. +hledgerPrettyStyleBorders :: TableStyle LineStyle LineStyle +hledgerPrettyStyleBorders = unicodeS + + tests_Text = testGroup "Text" [ testCase "quoteIfSpaced" $ do quoteIfSpaced "a'a" @?= "a'a" diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs index 4af4548df94..9b641183013 100644 --- a/hledger-lib/Text/Tabular/AsciiWide.hs +++ b/hledger-lib/Text/Tabular/AsciiWide.hs @@ -300,6 +300,10 @@ lineart _ _ _ _ = const mempty -- | Add the second table below the first, discarding its column headings. -concatTables :: Properties -> Table rh ch a -> Table rh ch2 a -> Table rh ch a +concatTables :: Monoid a => Properties -> Table rh ch a -> Table rh ch2 a -> Table rh ch a concatTables prop (Table hLeft hTop dat) (Table hLeft' _ dat') = - Table (Group prop [hLeft, hLeft']) hTop (dat ++ dat') + Table (Group prop [hLeft, hLeft']) hTop (map padRow $ dat ++ dat') + where + numCols = length $ headerContents hTop + padRow r = replicate (numCols - length r) mempty ++ r + diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 6fb68110f2b..66e9aec69e3 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -237,7 +237,7 @@ compoundBalanceReportAsText ropts -- convert to table Table lefthdrs tophdrs cells = balanceReportAsTable ropts r -- tweak the layout - t = Table (Tab.Group Tab.SingleLine [Tab.Header title, lefthdrs]) tophdrs ([]:cells) + t = Table (Tab.Group Tab.SingleLine [Tab.Header title, lefthdrs]) tophdrs (replicate (length $ headerContents tophdrs) mempty : cells) -- | Render a compound balance report as CSV. -- Subreports' CSV is concatenated, with the headings rows replaced by a From ad4cc4709186603ab00528433a5ac2f60a4a6693 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 25 Mar 2022 15:23:57 +1100 Subject: [PATCH 4/8] ref!: tabular: Port balance format code over to table-layout. It also means that --layout=bare can function with custom format strings. The commodity column will be displayed immediately after the totals column, left aligned. Default width for a balance report with --layout=bare is harmonised with the ordinary balance report. --- hledger/Hledger/Cli/Commands/Balance.hs | 103 ++++++++----------- hledger/test/amount-rendering.test | 2 +- hledger/test/balance/layout.test | 46 ++++----- hledger/test/balance/sorting.test | 2 +- hledger/test/i18n/unicode-balance.test | 7 +- hledger/test/journal/scientific.test | 2 +- hledger/test/journal/transaction-prices.test | 2 +- hledger/test/journal/valuation.test | 2 +- 8 files changed, 72 insertions(+), 94 deletions(-) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 190016e56c6..06fa9c60252 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -258,7 +258,6 @@ module Hledger.Cli.Commands.Balance ( ,tests_Balance ) where -import Data.Default (def) import Data.List (transpose, transpose) import qualified Data.Set as S import Data.Maybe (fromMaybe) @@ -268,10 +267,8 @@ import qualified Data.Text.Lazy.Builder as TB import Data.Time (addDays, fromGregorian) import System.Console.CmdArgs.Explicit as C import Lucid as L -import Safe (headMay, maximumMay) -import Text.Tabular.AsciiWide - (Align(..), Cell(..), Table(..), TableOpts(..), cellWidth, concatTables, - renderColumns, renderRowB, textCell) +import Safe (maximumMay) +import Text.Layout.Table import qualified Text.Tabular.AsciiWide as Tab import Hledger @@ -427,14 +424,12 @@ balanceReportAsCsv opts (items, total) = -- | Render a single-column balance report as plain text. balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder -balanceReportAsText opts ((items, total)) = case layout_ opts of - LayoutBare | iscustom -> error' "Custom format not supported with commodity columns" -- PARTIAL: - LayoutBare -> balanceReportAsText' opts ((items, total)) - _ -> unlinesB lines <> unlinesB (if no_total_ opts then [] else [overline, totalLines]) +balanceReportAsText opts ((items, total)) = + unlinesB lines <> unlinesB (if no_total_ opts then [] else [overline, totalLines]) where (lines, sizes) = unzip $ map (balanceReportItemAsText opts) items - -- abuse renderBalanceReportItem to render the total with similar format - (totalLines, _) = renderBalanceReportItem opts ("",0,total) + -- abuse balanceReportItemAsText to render the total with similar format + (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 @@ -445,26 +440,6 @@ balanceReportAsText opts ((items, total)) = case layout_ opts of overlinewidth = if iscustom then sum (map maximum' $ transpose sizes) else 20 overline = TB.fromText $ T.replicate overlinewidth "-" --- | Render a single-column balance report as plain text in commodity-column mode -balanceReportAsText' :: ReportOpts -> BalanceReport -> TB.Builder -balanceReportAsText' opts ((items, total)) = - unlinesB . fmap (renderColumns def{tableBorders=False} sizes . Tab.Group Tab.NoLine . fmap Tab.Header) $ - lines ++ concat [[[overline], totalline] | not (no_total_ opts)] - where - render (_, acctname, depth, amt) = - [ Cell TopRight damts - , Cell TopLeft (fmap wbFromText cs) - , Cell TopLeft (replicate (length damts - 1) mempty ++ [wbFromText dispname]) ] - where dopts = oneLine{displayColour=color_ opts, displayOrder=Just cs} - cs = if mixedAmountLooksZero amt then [""] else S.toList $ maCommodities amt - dispname = T.replicate ((depth - 1) * 2) " " <> acctname - damts = showMixedAmountLinesB dopts amt - lines = fmap render items - totalline = render ("", "", 0, total) - sizes = fromMaybe 0 . maximumMay . map cellWidth <$> - transpose ([totalline | not (no_total_ opts)] ++ lines) - overline = Cell TopLeft . pure . wbFromText . flip T.replicate "-" . fromMaybe 0 $ headMay sizes - {- :r This implementation turned out to be a bit convoluted but implements the following algorithm for formatting: @@ -481,38 +456,42 @@ This implementation turned out to be a bit convoluted but implements the followi -- differently-priced quantities of the same commodity will appear merged. -- The output will be one or more lines depending on the format and number of commodities. balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> (TB.Builder, [Int]) -balanceReportItemAsText opts (_, accountName, depth, amt) = - renderBalanceReportItem opts (accountName, depth, amt) - --- | Render a balance report item using the given StringFormat, generating one or more lines of text. -renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> (TB.Builder, [Int]) -renderBalanceReportItem opts (acctname, depth, total) = - case format_ opts of - OneLine comps -> renderRow' $ render True True comps - TopAligned comps -> renderRow' $ render True False comps - BottomAligned comps -> renderRow' $ render False False comps +balanceReportItemAsText opts (_, acctname, depth, total) = + renderRow' $ concatMap (renderComponent oneline opts (acctname, depth, total)) comps where - renderRow' is = ( renderRowB def{tableBorders=False, borderSpaces=False} - . Tab.Group Tab.NoLine $ map Tab.Header is - , map cellWidth is ) + renderRow' is = ( concatLines . map mconcat . gridB (concatMap colSpec comps) . colsAsRowsAll vPos $ + map (map (Hledger.renderText . wbToText)) is + , map (fromMaybe 0 . maximumMay . map wbWidth) is ) + + (vPos, oneline, comps) = case format_ opts of + OneLine comps -> (top, True, comps) + TopAligned comps -> (top, False, comps) + BottomAligned comps -> (bottom, False, comps) - render topaligned oneline = map (renderComponent topaligned oneline opts (acctname, depth, total)) + -- 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 "..") -- | Render one StringFormat component for a balance report item. -renderComponent :: Bool -> Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell -renderComponent _ _ _ _ (FormatLiteral s) = textCell TopLeft s -renderComponent topaligned oneline opts (acctname, depth, total) (FormatField ljust mmin mmax field) = case field of - DepthSpacerField -> Cell align [WideBuilder (TB.fromText $ T.replicate d " ") d] - where d = maybe id min mmax $ depth * fromMaybe 1 mmin - AccountField -> textCell align $ formatText ljust mmin mmax acctname - TotalField -> Cell align . pure $ showMixedAmountB dopts total - _ -> Cell align [mempty] +renderComponent :: Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> [[WideBuilder]] +renderComponent _ _ _ (FormatLiteral s) = [[wbFromText s]] +renderComponent oneline opts (acctname, depth, total) (FormatField ljust mmin mmax field) = case field of + DepthSpacerField -> [[WideBuilder (TB.fromText $ T.replicate d " ") d]] + where d = maybe id min mmax $ depth * fromMaybe 1 mmin + AccountField -> [[wbFromText $ formatText ljust mmin mmax acctname]] + -- Add commodities after the amounts, if LayoutBare is used. + TotalField | oneline -> [showMixedAmountB dopts total] : commoditiesColumns + TotalField -> showMixedAmountLinesB dopts total : commoditiesColumns + _ -> [[]] where - align | topaligned && ljust = TopLeft - | topaligned = TopRight - | ljust = BottomLeft - | otherwise = BottomRight - dopts = noPrice{displayColour=color_ opts, displayOneLine=oneline, displayMinWidth=mmin, displayMaxWidth=mmax} + dopts = noPrice{ displayColour=color_ opts, displayOneLine=oneline, displayOrder=commodities + , displayMinWidth=mmin, displayMaxWidth=mmax} + commodities = case layout_ opts of + LayoutBare -> Just $ if mixedAmountLooksZero total then [""] else S.toList $ maCommodities total + _ -> Nothing + commoditiesColumns = maybe [] (\cs -> [[wbFromText " "], map wbFromText cs]) commodities -- rendering multi-column balance reports @@ -669,12 +648,12 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $ _ -> False -- | Build a 'Table' from a multi-column balance report. -balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text WideBuilder +balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Tab.Table T.Text T.Text WideBuilder balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} (PeriodicReport spans items tr) = maybetranspose $ addtotalrow $ - Table + Tab.Table (Tab.Group Tab.NoLine $ map Tab.Header (concat accts)) (Tab.Group Tab.NoLine $ map Tab.Header colheadings) (concat rows) @@ -696,8 +675,8 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} let totalrows = multiBalanceRowAsTableText opts tr rh = Tab.Group Tab.NoLine . replicate (length totalrows) $ Tab.Header "" ch = Tab.Header [] -- ignored - in (flip (concatTables Tab.SingleLine) $ Table rh ch totalrows) - maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals) + in (flip (Tab.concatTables Tab.SingleLine) $ Tab.Table rh ch totalrows) + maybetranspose | transpose_ opts = \(Tab.Table rh ch vals) -> Tab.Table ch rh (transpose vals) | otherwise = id multiBalanceRowAsWbs :: AmountDisplayOpts -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] diff --git a/hledger/test/amount-rendering.test b/hledger/test/amount-rendering.test index fd3f2711744..3b690530764 100644 --- a/hledger/test/amount-rendering.test +++ b/hledger/test/amount-rendering.test @@ -40,7 +40,7 @@ hledger -f - balance -N >>> EUR 1 a USD 1 b - EUR -1 + EUR -1 USD -1 c >>>=0 diff --git a/hledger/test/balance/layout.test b/hledger/test/balance/layout.test index 1be112d6d95..e2834836a13 100644 --- a/hledger/test/balance/layout.test +++ b/hledger/test/balance/layout.test @@ -28,33 +28,33 @@ $ hledger -f bcexample.hledger bal assets.*etrade -3 -O csv --layout=bare # 3. Balance report output with no commodity column. $ hledger -f bcexample.hledger bal assets.*etrade -3 > - 70.00 GLD - 17.00 ITOT - 5120.50 USD - 36.00 VEA + 70.00 GLD + 17.00 ITOT + 5120.50 USD + 36.00 VEA 294.00 VHT Assets:US:ETrade -------------------- - 70.00 GLD - 17.00 ITOT - 5120.50 USD - 36.00 VEA + 70.00 GLD + 17.00 ITOT + 5120.50 USD + 36.00 VEA 294.00 VHT >=0 # 4. Balance report with commodity column. $ hledger -f bcexample.hledger bal assets.*etrade -3 --layout=bare > - 70.00 GLD - 17.00 ITOT - 5120.50 USD - 36.00 VEA - 294.00 VHT Assets:US:ETrade - ------- - 70.00 GLD - 17.00 ITOT - 5120.50 USD - 36.00 VEA - 294.00 VHT + 70.00 GLD + 17.00 ITOT + 5120.50 USD + 36.00 VEA + 294.00 VHT Assets:US:ETrade +-------------------- + 70.00 GLD + 17.00 ITOT + 5120.50 USD + 36.00 VEA + 294.00 VHT >=0 # 5. Multicolumn balance report csv output with no commodity columns. @@ -275,10 +275,10 @@ $ hledger -f bcexample.hledger bal -T assets.*etrade -3 -O csv --layout=tidy # 15. Should omit commodity from totals row when the sum is zero with --layout=bare. (#1789) $ hledger -f - bal --layout=bare - 1.00 INR Assets:Bank - -1.00 INR Equity:Opening - ----- - 0 + 1.00 INR Assets:Bank + -1.00 INR Equity:Opening +-------------------- + 0 >=0 # 16. The same with -M. (#1789) diff --git a/hledger/test/balance/sorting.test b/hledger/test/balance/sorting.test index 8a6910e2721..8e16cde3691 100644 --- a/hledger/test/balance/sorting.test +++ b/hledger/test/balance/sorting.test @@ -222,7 +222,7 @@ Income Statement 2020-01-01 # determined by their account name. $ hledger -f- bal -N -S 1 X f - 1 X + 1 X -1 Y e -1 Y d -1 X a diff --git a/hledger/test/i18n/unicode-balance.test b/hledger/test/i18n/unicode-balance.test index 69f2346329b..612f1f69eb5 100644 --- a/hledger/test/i18n/unicode-balance.test +++ b/hledger/test/i18n/unicode-balance.test @@ -1,11 +1,10 @@ -hledger -f - balance -<<< +< 2009-01-01 проверка τράπεζα 10 руб नकद ->>> +$ hledger -f - balance 10 руб τράπεζα -10 руб नकद -------------------- 0 ->>>=0 +>=0 diff --git a/hledger/test/journal/scientific.test b/hledger/test/journal/scientific.test index 3010f9a1ecb..62fbe82b19b 100644 --- a/hledger/test/journal/scientific.test +++ b/hledger/test/journal/scientific.test @@ -68,7 +68,7 @@ hledger -f - bal --no-total (a) 1.00005e (a) 2.00003E >>> - 2.00003E + 2.00003E 1.00005e a >>>=0 diff --git a/hledger/test/journal/transaction-prices.test b/hledger/test/journal/transaction-prices.test index b94809e3b58..c30dfce2c66 100644 --- a/hledger/test/journal/transaction-prices.test +++ b/hledger/test/journal/transaction-prices.test @@ -151,7 +151,7 @@ $ hledger -f - balance 10£ a -16$ b -------------------- - -16$ + -16$ 10£ >=0 diff --git a/hledger/test/journal/valuation.test b/hledger/test/journal/valuation.test index 37aa33ea6ef..a3517f1e206 100644 --- a/hledger/test/journal/valuation.test +++ b/hledger/test/journal/valuation.test @@ -352,7 +352,7 @@ $ hledger -f- reg -V -M -b 2000 # 30. single column balance report valued at cost $ hledger -f- bal -N --value=cost -b 2000 - 15 B + 15 B 6 C a # 31. single column balance report valued at period end (which includes market price declarations, see #1405) From 0011d4d516443f221a646d135b3f8ce8adfef14d Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 25 Mar 2022 22:59:14 +1100 Subject: [PATCH 5/8] ref: tabular: Port ROI over to table-layout. --- hledger/Hledger/Cli/Commands/Roi.hs | 64 ++++----- hledger/test/roi.test | 201 ++++++++++++++++------------ 2 files changed, 152 insertions(+), 113 deletions(-) diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index 374b3d7123a..5283e3cb0cc 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -26,9 +26,10 @@ import Numeric.RootFinding import Data.Decimal import qualified Data.Text as T import qualified Data.Text.Lazy.IO as TL +import qualified Data.Text.Lazy.Builder as TB import System.Console.CmdArgs.Explicit as CmdArgs - -import Text.Tabular.AsciiWide as Tab +import Text.Layout.Table +import Text.Layout.Table.Cell (Cell) import Hledger import Hledger.Cli.CliOptions @@ -138,15 +139,10 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO , T.pack $ printf "%0.2f%%" $ smallIsZero irr , T.pack $ printf "%0.2f%%" $ smallIsZero twr ] - let table = Table - (Tab.Group Tab.NoLine (map (Header . T.pack . show) (take (length tableBody) [1..]))) - (Tab.Group Tab.DoubleLine - [ Tab.Group Tab.SingleLine [Header "Begin", Header "End"] - , Tab.Group Tab.SingleLine [Header "Value (begin)", Header "Cashflow", Header "Value (end)", Header "PnL"] - , Tab.Group Tab.SingleLine [Header "IRR", Header "TWR"]]) - tableBody + let table = renderTable prettyTables colHeader (map (T.pack . show) [1..]) tableBody + colHeader = [ ["" :: T.Text], ["Begin", "End"], ["Value (begin)", "Cashflow", "Value (end)", "PnL"], ["IRR", "TWR"] ] - TL.putStrLn $ Tab.render prettyTables id id id table + TL.putStrLn . TB.toLazyText $ table <> TB.singleton '\n' timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue (OneSpan spanBegin spanEnd valueBeforeAmt valueAfter cashFlow pnl) = do let valueBefore = unMix valueBeforeAmt @@ -236,20 +232,18 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV unitPrices = add initialUnitPrice unitPrices' unitBalances = add initialUnits unitBalances' - TL.putStr $ Tab.render prettyTables id id T.pack - (Table - (Tab.Group NoLine (map (Header . showDate) dates)) - (Tab.Group DoubleLine [ Tab.Group Tab.SingleLine [Tab.Header "Portfolio value", Tab.Header "Unit balance"] - , Tab.Group Tab.SingleLine [Tab.Header "Pnl", Tab.Header "Cashflow", Tab.Header "Unit price", Tab.Header "Units"] - , Tab.Group Tab.SingleLine [Tab.Header "New Unit Balance"]]) - [ [value, oldBalance, pnl, cashflow, prc, udelta, balance] - | value <- map showDecimal valuesOnDate - | oldBalance <- map showDecimal (0:unitBalances) - | balance <- map showDecimal unitBalances - | pnl <- map showMixedAmount pnls - | cashflow <- map showMixedAmount cashflows - | prc <- map showDecimal unitPrices - | udelta <- map showDecimal unitsBoughtOrSold ]) + let table = renderTable prettyTables colHeader (map showDate dates) tableBody + tableBody = [ map T.pack [value, oldBalance, pnl, cashflow, prc, udelta, balance] + | value <- map showDecimal valuesOnDate + | oldBalance <- map showDecimal (0:unitBalances) + | balance <- map showDecimal unitBalances + | pnl <- map showMixedAmount pnls + | cashflow <- map showMixedAmount cashflows + | prc <- map showDecimal unitPrices + | udelta <- map showDecimal unitsBoughtOrSold ] + colHeader = [ ["" :: T.Text], ["Portfolio value", "Unit balance"], ["Pnl", "Cashflow", "Unit price", "Units"], ["New Unit Balance"] ] + + TL.putStrLn . TB.toLazyText $ table <> TB.singleton '\n' printf "Final unit price: %s/%s units = %s\nTotal TWR: %s%%.\nPeriod: %.2f years.\nAnnualized TWR: %.2f%%\n\n" (showMixedAmount valueAfter) (showDecimal finalUnitBalance) (showDecimal finalUnitPrice) (showDecimal totalTWR) years annualizedTWR @@ -265,12 +259,12 @@ internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueB when showCashFlow $ do printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd)) - let (dates, amounts) = unzip totalCF - TL.putStrLn $ Tab.render prettyTables id id id - (Table - (Tab.Group Tab.NoLine (map (Header . showDate) dates)) - (Tab.Group Tab.SingleLine [Header "Amount"]) - (map ((:[]) . T.pack . showMixedAmount) amounts)) + let table = renderTable prettyTables colHeader (map showDate dates) tableBody + tableBody = map (pure . T.pack . showMixedAmount) amounts + (dates, amounts) = unzip totalCF + colHeader = [ ["" :: T.Text], ["Amount"] ] + + TL.putStrLn $ TB.toLazyText table -- 0% is always a solution, so require at least something here case totalCF of @@ -312,4 +306,12 @@ showDecimal d = if d == rounded then show d else show rounded where rounded = roundTo 2 d - +-- Utility to build the ROI table +renderTable :: Cell a => Bool -> [[a]] -> [T.Text] -> [[T.Text]] -> TB.Builder +renderTable pretty colHeaders rowHeaders = + tableStringB colSpec style (noneSepH NoLine) (groupH DoubleLine $ map (fullSepH SingleLine headerSpec) colHeaders) + . zipWith (\h row -> rowG . map renderText $ h : row) rowHeaders + where + colSpec = repeat (column expand right noAlign noCutMark) + headerSpec = repeat $ headerColumn right Nothing + style = if pretty then hledgerPrettyStyleBorders else hledgerStyleBorders diff --git a/hledger/test/roi.test b/hledger/test/roi.test index 11175efa509..031c55b4ed7 100644 --- a/hledger/test/roi.test +++ b/hledger/test/roi.test @@ -1,6 +1,4 @@ -# 1. investment that does not grow has no return -hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y -<<< +< 2017-01-01 investment assets:cash -$100 investment @@ -8,18 +6,18 @@ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y 2017-06-01 investment assets:cash -$100 investment ->>> + +# 1. investment that does not grow has no return +$ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y +---++------------+------------++---------------+----------+-------------+-----++-------+-------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++=======+=======+ | 1 || 2017-01-01 | 2017-12-31 || 0 | $200 | $200 | 0 || 0.00% | 0.00% | +---++------------+------------++---------------+----------+-------------+-----++-------+-------+ ->>>=0 +>=0 -# 2. Growth by 12% from single investment transaction should show 12% IRR and 12% TWR -hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y -<<< +< 2017-01-01 investment assets:cash -$100 investment @@ -27,18 +25,18 @@ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y 2017-12-31 investment valuation investment = $112 pnl ->>> + +# 2. Growth by 12% from single investment transaction should show 12% IRR and 12% TWR +$ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y +---++------------+------------++---------------+----------+-------------+-----++--------+--------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++========+========+ | 1 || 2017-01-01 | 2017-12-31 || 0 | $100 | $112 | $12 || 12.00% | 12.00% | +---++------------+------------++---------------+----------+-------------+-----++--------+--------+ ->>>=0 +>=0 -# 3. Same as (2), but grow by 1% per month -hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y -<<< +< 2017-01-01 investment assets:cash -$100 investment @@ -62,47 +60,46 @@ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y 2017-05-31 investment valuation investment = $105 pnl - + 2017-06-30 investment valuation investment = $106 pnl - + 2017-07-31 investment valuation investment = $107 pnl - + 2017-08-31 investment valuation investment = $108 pnl - + 2017-09-30 investment valuation investment = $109 pnl - + 2017-10-31 investment valuation investment = $110 pnl - + 2017-11-30 investment valuation investment = $111 pnl - + 2017-12-31 investment valuation investment = $112 pnl ->>> +# 3. Same as (2), but grow by 1% per month +$ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y +---++------------+------------++---------------+----------+-------------+-----++--------+--------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++========+========+ | 1 || 2017-01-01 | 2017-12-31 || 0 | $100 | $112 | $12 || 12.00% | 12.00% | +---++------------+------------++---------------+----------+-------------+-----++--------+--------+ ->>>=0 +>=0 -# 4. When $100 invested over 12 month + $100 invested over 6 month yield $220, that's 10% TWR, but 12.73% IRR -hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y -<<< +< 2017-01-01 investment assets:cash -$100 investment @@ -114,18 +111,18 @@ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y 2017-12-31 investment valuation investment = $220 pnl ->>> + +# 4. When $100 invested over 12 month + $100 invested over 6 month yield $220, that's 10% TWR, but 12.73% IRR +$ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y +---++------------+------------++---------------+----------+-------------+-----++--------+--------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++========+========+ | 1 || 2017-01-01 | 2017-12-31 || 0 | $200 | $220 | $20 || 12.72% | 10.00% | +---++------------+------------++---------------+----------+-------------+-----++--------+--------+ ->>>=0 +>=0 -# 5. When $100 invested over 12 month + $100 invested over 6 month yield $20, that's -90% TWR, but -95.73% IRR -hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y -<<< +< 2017-01-01 investment assets:cash -$100 investment @@ -137,18 +134,18 @@ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y 2017-12-31 investment valuation investment = $20 pnl ->>> + +# 5. When $100 invested over 12 month + $100 invested over 6 month yield $20, that's -90% TWR, but -95.73% IRR +$ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Y +---++------------+------------++---------------+----------+-------------+-------++---------+---------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=======++=========+=========+ | 1 || 2017-01-01 | 2017-12-31 || 0 | $200 | $20 | $-180 || -95.73% | -90.00% | +---++------------+------------++---------------+----------+-------------+-------++---------+---------+ ->>>=0 +>=0 -# 6. Check that deposits/withdrawals and profit/loss are reflected in the right periods -hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Q -<<< +< 2017-01-01 investment assets:cash -$100 investment @@ -168,7 +165,9 @@ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Q 2017-12-31 investment valuation investment = $155 pnl ->>> + +# 6. Check that deposits/withdrawals and profit/loss are reflected in the right periods +$ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Q +---++------------+------------++---------------+----------+-------------+-----++---------+---------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++=========+=========+ @@ -178,11 +177,9 @@ hledger -f- roi --inv investment --pnl pnl -b 2017 -e 2018 -Q | 4 || 2017-10-01 | 2017-12-31 || $210 | $-50 | $155 | $-5 || -11.83% | -11.82% | +---++------------+------------++---------------+----------+-------------+-----++---------+---------+ ->>>=0 +>=0 -# 7. Check that reporting for the part of the total history of investment works -hledger -f- roi --inv investment --pnl pnl -b 2017-06 -e 2018 -<<< +< 2017-01-01 investment assets:cash -$100 investment @@ -202,33 +199,33 @@ hledger -f- roi --inv investment --pnl pnl -b 2017-06 -e 2018 2017-12-31 investment valuation investment = $155 pnl ->>> + +# 7. Check that reporting for the part of the total history of investment works +$ hledger -f- roi --inv investment --pnl pnl -b 2017-06 -e 2018 +---++------------+------------++---------------+----------+-------------+-----++-------+--------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++=======+========+ | 1 || 2017-06-01 | 2017-12-31 || $100 | $50 | $155 | $5 || 5.24% | 11.45% | +---++------------+------------++---------------+----------+-------------+-----++-------+--------+ ->>>=0 +>=0 -# 8. Dont fail where there is no rate-of-return -hledger -f- roi -p 2019-11 -<<< +< 2019/11/01 Example Assets:Checking 1 Income:Salary -1 ->>> + +# 8. Don't fail where there is no rate-of-return +$ hledger -f- roi -p 2019-11 +---++------------+------------++---------------+----------+-------------+-----++-------+-------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++=======+=======+ | 1 || 2019-11-01 | 2019-11-30 || 0 | 0 | 0 | 0 || 0.00% | 0.00% | +---++------------+------------++---------------+----------+-------------+-----++-------+-------+ ->>>=0 +>=0 -# 9. Fail with a nice error message when commodity can't be valued -hledger -f- roi -p 2019-11 --inv Investment --pnl PnL -<<< +< 2019/11/01 Example Assets:Checking -100 A Investment 10 B @@ -237,15 +234,16 @@ hledger -f- roi -p 2019-11 --inv Investment --pnl PnL Investment -10 B @@ 100 A Assets:Checking 101 A Unrealized PnL ->>>2 + +# 9. Fail with a nice error message when commodity can't be valued +$ hledger -f- roi -p 2019-11 --inv Investment --pnl PnL +>2 hledger: Error: Amounts could not be converted to a single cost basis: ["10 B","-10 B @@ 100 A"] Consider using --value to force all costs to be in a single commodity. For example, "--cost --value=end, --infer-market-prices", where commodity is the one that was used to pay for the investment. ->>>=1 +>=1 -# 10. Forcing valuation via --value -hledger -f- roi -p 2019-11 --inv Investment --pnl PnL --cost --value=then,A --infer-market-prices -<<< +< 2019/11/01 Example Assets:Checking -100 A Investment 10 B @@ -254,18 +252,18 @@ hledger -f- roi -p 2019-11 --inv Investment --pnl PnL --cost --value=then,A --in Investment -10 B @@ 100 A Assets:Checking 101 A Unrealized PnL ->>> + +# 10. Forcing valuation via --value +$ hledger -f- roi -p 2019-11 --inv Investment --pnl PnL --cost --value=then,A --infer-market-prices +---++------------+------------++---------------+----------+-------------+-----++----------+--------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++==========+========+ | 1 || 2019-11-01 | 2019-11-30 || 0 | -1 A | 0 | 1 A || 3678.34% | 12.87% | +---++------------+------------++---------------+----------+-------------+-----++----------+--------+ ->>>=0 +>=0 -# 11. Use "then" prices. 10000/76.20 = 131.23, 11000/73.88=148.89 -hledger -f - roi --inv assets:investment --pnl income:investment --value=then,'$' -<<< +< P 2020-12-01 $ 76.20 P 2021-01-01 $ 73.88 @@ -276,18 +274,18 @@ P 2021-01-01 $ 73.88 2021-01-02 get profit assets:investment =11000 income:investment ->>> + +# 11. Use "then" prices. 10000/76.20 = 131.23, 11000/73.88=148.89 +$ hledger -f - roi --inv assets:investment --pnl income:investment --value=then,'$' +---++------------+------------++---------------+----------+-------------+-----++---------+---------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++=========+=========+ | 1 || 2020-12-02 | 2021-01-02 || 0 | $131 | $149 | $18 || 321.99% | 321.81% | +---++------------+------------++---------------+----------+-------------+-----++---------+---------+ ->>>=0 +>=0 -# 12. Use "end" prices. 10000/73.88=135.35 -hledger -f - roi --inv assets:investment --pnl income:investment --value=end,'$' -<<< +< P 2020-12-01 $ 76.20 P 2021-01-01 $ 73.88 @@ -298,57 +296,95 @@ P 2021-01-01 $ 73.88 2021-01-02 get profit assets:investment =11000 income:investment ->>> + +# 12. Use "end" prices. 10000/73.88=135.35 +$ hledger -f - roi --inv assets:investment --pnl income:investment --value=end,'$' +---++------------+------------++---------------+----------+-------------+-----++---------+---------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=====++=========+=========+ | 1 || 2020-12-02 | 2021-01-02 || 0 | $135 | $149 | $14 || 196.58% | 196.58% | +---++------------+------------++---------------+----------+-------------+-----++---------+---------+ ->>>=0 +>=0 -# 13. Several PnL transactions on a single date are aggregated together -hledger -f - roi --inv saving --pnl dividend -<<< +< 2010-01-01 A1 savingA 100.00 € - checking + checking 2011-12-31 A2 savingA 0.00 € dividendA -8.00 € checking - + 2012-03-29 A3 savingA -100.00 € checking - + # ======================================== 2010-01-01 B1 savingB 100.00 € - checking + checking 2011-12-31 B2 savingB 0.00 € dividendB -8.00 € checking - + 2012-03-29 B3 saving -100.00 € checking ->>> + +# 13. Several PnL transactions on a single date are aggregated together +$ hledger -f - roi --inv saving --pnl dividend ++---++------------+------------++---------------+----------+-------------+---------++-------+-------+ +| || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | ++===++============+============++===============+==========+=============+=========++=======+=======+ +| 1 || 2010-01-01 | 2012-03-29 || 0 | -16.00 € | 0 | 16.00 € || 3.52% | 3.49% | ++---++------------+------------++---------------+----------+-------------+---------++-------+-------+ + +>=0 + +# 14. Show cashflows +$ hledger -f - roi --inv saving --pnl dividend --cashflow + +IRR cash flow for 2010-01-01 - 2012-03-29 ++------------++-----------+ +| || Amount | ++============++===========+ +| 2010-01-01 || -100.00 € | +| 2010-01-01 || -100.00 € | +| 2011-12-31 || 8.00 € | +| 2011-12-31 || 8.00 € | +| 2012-03-29 || 100.00 € | +| 2012-03-29 || 100.00 € | ++------------++-----------+ + +TWR cash flow for 2010-01-01 - 2012-03-29 ++------------++-----------------+--------------++---------+-----------+------------+-------++-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+ +| || Portfolio value | Unit balance || Pnl | Cashflow | Unit price | Units || New Unit Balance | ++============++=================+==============++=========+===========+============+=======++===================================================================================================================================================================================================================================================================+ +| 2010-01-01 || 0 | 0 || 0 | 200.00 € | 100 | 2 || 2 | +| 2011-12-31 || 200.00 | 2 || 16.00 € | 0 | 108 | 0 || 2 | +| 2011-12-31 || 200.00 | 2 || 0 | -16.00 € | 108 | -0.15 || 1.85 | +| 2012-03-29 || 200.00 | 1.85 || 0 | -200.00 € | 108 | -1.85 || 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 | ++------------++-----------------+--------------++---------+-----------+------------+-------++-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+ + +Final unit price: 0/0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 units = 108 +Total TWR: 8.00%. +Period: 2.24 years. +Annualized TWR: 3.49% + +---++------------+------------++---------------+----------+-------------+---------++-------+-------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+=========++=======+=======+ | 1 || 2010-01-01 | 2012-03-29 || 0 | -16.00 € | 0 | 16.00 € || 3.52% | 3.49% | +---++------------+------------++---------------+----------+-------------+---------++-------+-------+ ->>>=0 +>=0 -# 14. Should support begin date before first transaction where first transaction has pnl -hledger -f - roi --inv stocks --pnl expenses --value=then,€ -Y -<<< +< P 2022-07-31 A € 1 2022-08-01 Purchase @@ -358,11 +394,12 @@ P 2022-07-31 A € 1 P 2022-08-02 A € 2 ->>> +# 15. Should support begin date before first transaction where first transaction has pnl +$ hledger -f - roi --inv stocks --pnl expenses --value=then,€ -Y +---++------------+------------++---------------+----------+-------------+------++---------+--------+ | || Begin | End || Value (begin) | Cashflow | Value (end) | PnL || IRR | TWR | +===++============+============++===============+==========+=============+======++=========+========+ | 1 || 2022-01-01 | 2022-12-31 || 0 | € 101 | € 200 | € 99 || 410.31% | 98.02% | +---++------------+------------++---------------+----------+-------------+------++---------+--------+ ->>>=0 +>=0 From 439de57246da5c8b65f5bfb8b66be249dc2ee871 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Sat, 26 Mar 2022 01:14:11 +1100 Subject: [PATCH 6/8] ref!: tabular: show(Mixed)?Amount(Lines)?B now return RenderText instead of WideBuilder. Use buildCell to convert this to String, Text, Builder, or other representable forms. --- hledger-lib/Hledger/Data/Account.hs | 9 +- hledger-lib/Hledger/Data/Amount.hs | 155 ++++++++---------- hledger-lib/Hledger/Data/Posting.hs | 21 +-- hledger-lib/Hledger/Read/CsvReader.hs | 2 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 40 +++-- .../Hledger/Reports/MultiBalanceReport.hs | 5 +- hledger-lib/Hledger/Utils.hs | 15 +- hledger-lib/Hledger/Utils/Text.hs | 6 +- hledger-ui/Hledger/UI/AccountsScreen.hs | 6 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 8 +- hledger-ui/Hledger/UI/UITypes.hs | 4 +- hledger-web/Hledger/Web/Handler/RegisterR.hs | 2 +- hledger/Hledger/Cli/Commands/Add.hs | 2 +- hledger/Hledger/Cli/Commands/Aregister.hs | 14 +- hledger/Hledger/Cli/Commands/Balance.hs | 42 ++--- hledger/Hledger/Cli/Commands/Prices.hs | 2 +- hledger/Hledger/Cli/Commands/Print.hs | 2 +- hledger/Hledger/Cli/Commands/Register.hs | 16 +- hledger/Hledger/Cli/Commands/Roi.hs | 1 - hledger/Hledger/Cli/Utils.hs | 8 +- hledger/test/balance/bcexample.test | 32 ++-- 21 files changed, 184 insertions(+), 208 deletions(-) diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index a8bd8b22e63..6bba6ad6aff 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -41,6 +41,7 @@ import Data.Ord (Down(..)) import Safe (headMay) import Text.Printf (printf) +import Hledger.Utils (buildCell) import Hledger.Data.AccountName (expandAccountName, clipOrEllipsifyAccountName) import Hledger.Data.Amount import Hledger.Data.Types @@ -52,8 +53,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 +304,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) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 91010046c42..2f38de38df5 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -136,8 +136,6 @@ module Hledger.Data.Amount ( showMixedAmountWithZeroCommodity, showMixedAmountB, showMixedAmountLinesB, - wbToText, - wbUnpack, mixedAmountSetPrecision, mixedAmountSetFullPrecision, canonicaliseMixedAmount, @@ -158,20 +156,19 @@ import qualified Data.Map.Strict as M import qualified Data.Set as S import Data.Maybe (fromMaybe, isNothing, isJust) import Data.Semigroup (Semigroup(..)) +import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.Lazy.Builder as TB import Data.Word (Word8) -import Safe (headDef, lastDef, lastMay) +import Safe (lastDef, lastMay) import System.Console.ANSI (Color(..),ColorIntensity(..)) -import Debug.Trace (trace) import Test.Tasty (testGroup) import Test.Tasty.HUnit ((@?=), assertBool, testCase) import Hledger.Data.Types -import Hledger.Utils (colorB, numDigitsInt) -import Hledger.Utils.Text (textQuoteIfNeeded) -import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack) +import Hledger.Utils + (Cell(..), RenderText, numDigitsInt, textQuoteIfNeeded, trace, colorB, + renderText, visibleLength) -- A 'Commodity' is a symbol representing a currency or some other kind of @@ -402,11 +399,11 @@ withDecimalPoint = flip setAmountDecimalPoint amountStripPrices :: Amount -> Amount amountStripPrices a = a{aprice=Nothing} -showAmountPrice :: Amount -> WideBuilder +showAmountPrice :: Amount -> RenderText showAmountPrice amt = case aprice amt of Nothing -> mempty - Just (UnitPrice pa) -> WideBuilder (TB.fromString " @ ") 3 <> showAmountB noColour pa - Just (TotalPrice pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour (sign pa) + Just (UnitPrice pa) -> " @ " <> showAmountB noColour pa + Just (TotalPrice pa) -> " @@ " <> showAmountB noColour (sign pa) where sign = if aquantity amt < 0 then negate else id showAmountPriceDebug :: Maybe AmountPrice -> String @@ -446,26 +443,25 @@ amountUnstyled a = a{astyle=amountstyle} -- zero are converted to just \"0\". The special "missing" amount is -- displayed as the empty string. -- --- > showAmount = wbUnpack . showAmountB noColour +-- > showAmount = buildCell . showAmountB noColour showAmount :: Amount -> String -showAmount = wbUnpack . showAmountB noColour +showAmount = buildCell . showAmountB noColour --- | General function to generate a WideBuilder for an Amount, according the +-- | General function to generate a RenderText for an Amount, according the -- supplied AmountDisplayOpts. The special "missing" amount is displayed as -- the empty string. This is the main function to use for showing --- Amounts, constructing a builder; it can then be converted to a Text with --- wbToText, or to a String with wbUnpack. -showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder +-- Amounts; it can then be converted to a String or Text buildCell. +showAmountB :: AmountDisplayOpts -> Amount -> RenderText showAmountB _ Amount{acommodity="AUTO"} = mempty showAmountB opts a@Amount{astyle=style} = color $ case ascommodityside style of - L -> showC (wbFromText c) space <> quantity' <> price - R -> quantity' <> showC space (wbFromText c) <> price + L -> showC (renderText c) space <> quantity' <> price + R -> quantity' <> showC space (renderText c) <> price where - quantity = showamountquantity $ if displayThousandsSep opts then a else a{astyle=(astyle a){asdigitgroups=Nothing}} - (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"") + quantity = renderText . showamountquantity $ if displayThousandsSep opts then a else a{astyle=(astyle a){asdigitgroups=Nothing}} + (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = ("0", "") | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a) - space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty + space = if not (T.null c) && ascommodityspaced style then " " else "" showC l r = if isJust (displayOrder opts) then mempty else l <> r price = if displayPrice opts then showAmountPrice a else mempty color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id @@ -473,21 +469,21 @@ showAmountB opts a@Amount{astyle=style} = -- | Colour version. For a negative amount, adds ANSI codes to change the colour, -- currently to hard-coded red. -- --- > cshowAmount = wbUnpack . showAmountB def{displayColour=True} +-- > cshowAmount = buildCell . showAmountB def{displayColour=True} cshowAmount :: Amount -> String -cshowAmount = wbUnpack . showAmountB def{displayColour=True} +cshowAmount = buildCell . showAmountB def{displayColour=True} -- | Get the string representation of an amount, without any \@ price. -- --- > showAmountWithoutPrice = wbUnpack . showAmountB noPrice +-- > showAmountWithoutPrice = buildCell . showAmountB noPrice showAmountWithoutPrice :: Amount -> String -showAmountWithoutPrice = wbUnpack . showAmountB noPrice +showAmountWithoutPrice = buildCell . showAmountB noPrice -- | Like showAmount, but show a zero amount's commodity if it has one. -- --- > showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeryCommodity=True} +-- > showAmountWithZeroCommodity = buildCell . showAmountB noColour{displayZeryCommodity=True} showAmountWithZeroCommodity :: Amount -> String -showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeroCommodity=True} +showAmountWithZeroCommodity = buildCell . showAmountB noColour{displayZeroCommodity=True} -- | Get a string representation of an amount for debugging, -- appropriate to the current debug level. 9 shows maximum detail. @@ -497,10 +493,9 @@ showAmountDebug Amount{..} = "Amount {acommodity=" ++ show acommodity ++ ", aquantity=" ++ show aquantity ++ ", aprice=" ++ showAmountPriceDebug aprice ++ ", astyle=" ++ show astyle ++ "}" --- | Get a Text Builder for the string representation of the number part of of an amount, --- using the display settings from its commodity. Also returns the width of the --- number. -showamountquantity :: Amount -> WideBuilder +-- | Get a Text for the string representation of the number part of of an amount, +-- using the display settings from its commodity. +showamountquantity :: Amount -> Text showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} = signB <> intB <> fracB where @@ -514,19 +509,19 @@ showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgro (intPart, fracPart) = T.splitAt intLen padded intB = applyDigitGroupStyle mgrps intLen $ if e == 0 then strN else intPart - signB = if n < 0 then WideBuilder (TB.singleton '-') 1 else mempty - fracB = if e > 0 then WideBuilder (TB.singleton dec <> TB.fromText fracPart) (fromIntegral e + 1) else mempty + signB = if n < 0 then "-" else "" + fracB = if e > 0 then T.cons dec fracPart else "" -- | Split a string representation into chunks according to DigitGroupStyle, -- returning a Text builder and the number of separators used. -applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> T.Text -> WideBuilder -applyDigitGroupStyle Nothing l s = WideBuilder (TB.fromText s) l -applyDigitGroupStyle (Just (DigitGroups _ [])) l s = WideBuilder (TB.fromText s) l +applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> T.Text -> Text +applyDigitGroupStyle Nothing _ s = s +applyDigitGroupStyle (Just (DigitGroups _ [])) _ s = s applyDigitGroupStyle (Just (DigitGroups c (g:gs))) l s = addseps (g:|gs) (toInteger l) s where addseps (g:|gs) l s - | l' > 0 = addseps gs' l' rest <> WideBuilder (TB.singleton c <> TB.fromText part) (fromIntegral g + 1) - | otherwise = WideBuilder (TB.fromText s) (fromInteger l) + | l' > 0 = addseps gs' l' rest <> T.cons c part + | otherwise = s where (rest, part) = T.splitAt (fromInteger l') s gs' = fromMaybe (g:|[]) $ nonEmpty gs @@ -778,45 +773,45 @@ mixedAmountUnstyled = mapMixedAmountUnsafe amountUnstyled -- normalising it to one amount per commodity. Assumes amounts have -- no or similar prices, otherwise this can show misleading prices. -- --- > showMixedAmount = wbUnpack . showMixedAmountB noColour +-- > showMixedAmount = buildCell . showMixedAmountB noColour showMixedAmount :: MixedAmount -> String -showMixedAmount = wbUnpack . showMixedAmountB noColour +showMixedAmount = buildCell . showMixedAmountB noColour -- | Get the one-line string representation of a mixed amount. -- --- > showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine +-- > showMixedAmountOneLine = buildCell . showMixedAmountB oneLine showMixedAmountOneLine :: MixedAmount -> String -showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine +showMixedAmountOneLine = buildCell . showMixedAmountB oneLine -- | Like showMixedAmount, but zero amounts are shown with their -- commodity if they have one. -- --- > showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True} +-- > showMixedAmountWithZeroCommodity = buildCell . showMixedAmountB noColour{displayZeroCommodity=True} showMixedAmountWithZeroCommodity :: MixedAmount -> String -showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True} +showMixedAmountWithZeroCommodity = buildCell . showMixedAmountB noColour{displayZeroCommodity=True} -- | Get the string representation of a mixed amount, without showing any transaction prices. -- With a True argument, adds ANSI codes to show negative amounts in red. -- --- > showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noPrice{displayColour=c} +-- > showMixedAmountWithoutPrice c = buildCell . showMixedAmountB noPrice{displayColour=c} showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String -showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noPrice{displayColour=c} +showMixedAmountWithoutPrice c = buildCell . showMixedAmountB noPrice{displayColour=c} -- | Get the one-line string representation of a mixed amount, but without -- any \@ prices. -- With a True argument, adds ANSI codes to show negative amounts in red. -- --- > showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c} +-- > showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountB oneLine{displayColour=c} showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String -showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c} +showMixedAmountOneLineWithoutPrice c = buildCell . showMixedAmountB oneLine{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 = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w} +-- > showMixedAmountElided w c = buildCell . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w} showMixedAmountElided :: Int -> Bool -> MixedAmount -> String -showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w} +showMixedAmountElided w c = buildCell . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w} -- | Get an unambiguous string representation of a mixed amount for debugging. showMixedAmountDebug :: MixedAmount -> String @@ -824,10 +819,9 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)" | otherwise = "Mixed [" ++ as ++ "]" where as = intercalate "\n " $ map showAmountDebug $ amounts m --- | General function to generate a WideBuilder for a MixedAmount, according to the +-- | General function to generate a RenderText for a MixedAmount, according to the -- supplied AmountDisplayOpts. This is the main function to use for showing --- MixedAmounts, constructing a builder; it can then be converted to a Text with --- wbToText, or to a String with wbUnpack. +-- MixedAmounts; it can then be converted to a Text or String with buildCell. -- -- If a maximum width is given then: -- - If displayed on one line, it will display as many Amounts as can @@ -836,56 +830,52 @@ 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 -> WideBuilder +showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> RenderText showMixedAmountB opts ma | displayOneLine opts = showMixedAmountOneLineB opts ma - | otherwise = WideBuilder (wbBuilder . mconcat $ intersperse sep lines) width + | otherwise = mconcat $ intersperse sep lines where lines = showMixedAmountLinesB opts ma - width = headDef 0 $ map wbWidth lines - sep = WideBuilder (TB.singleton '\n') 0 + sep = "\n" -- | Helper for showMixedAmountB to show a list of Amounts on multiple lines. This returns --- the list of WideBuilders: one for each Amount, and padded/elided to the appropriate +-- the list of RenderText: one for each Amount, and padded/elided to the appropriate -- width. This does not honour displayOneLine: all amounts will be displayed as if -- displayOneLine were False. -showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder] +showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [RenderText] showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma = map (adBuilder . pad) elided where - astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $ + astrs = amtDisplayList 0 (showAmountB opts) . orderedAmounts opts $ if displayPrice opts then ma else mixedAmountStripPrices ma - sep = WideBuilder (TB.singleton '\n') 0 - width = maximum $ map (wbWidth . adBuilder) elided + width = maximum $ map (visibleLength . adBuilder) elided pad amt | Just mw <- mmin = - let w = (max width mw) - wbWidth (adBuilder amt) - in amt{ adBuilder = WideBuilder (TB.fromText $ T.replicate w " ") w <> adBuilder amt } + 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) (wbWidth sep) (length long) $ lastDef nullAmountDisplay short - (short, long) = partition ((m>=) . wbWidth . adBuilder) xs + elisionStr = elisionDisplay (Just m) 0 (length long) $ lastDef nullAmountDisplay short + (short, long) = partition ((m>=) . visibleLength . adBuilder) xs -- | 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 -> WideBuilder +showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> RenderText showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma = - WideBuilder (wbBuilder . pad . mconcat . intersperse sep $ map adBuilder elided) - . max width $ fromMaybe 0 mmin + pad . mconcat . intersperse sep $ map adBuilder elided where width = maybe 0 adTotal $ lastMay elided - astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $ + astrs = amtDisplayList (visibleLength sep) (showAmountB opts) . orderedAmounts opts $ if displayPrice opts then ma else mixedAmountStripPrices ma - sep = WideBuilder (TB.fromString ", ") 2 + sep = ", " n = length astrs - pad = (WideBuilder (TB.fromText $ T.replicate w " ") w <>) - where w = fromMaybe 0 mmin - width + pad = (renderText (T.replicate (fromMaybe 0 mmin - width) " ") <>) elided = maybe id elideTo mmax astrs elideTo m = addElide . takeFitting m . withElided @@ -900,7 +890,7 @@ showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWi 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 (wbWidth sep) num amt)) [n-1,n-2..0] + withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (visibleLength sep) num amt)) [n-1,n-2..0] orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount] orderedAmounts dopts = maybe id (mapM pad) (displayOrder dopts) . amounts @@ -909,34 +899,33 @@ orderedAmounts dopts = maybe id (mapM pad) (displayOrder dopts) . amounts data AmountDisplay = AmountDisplay - { adBuilder :: !WideBuilder -- ^ String representation of the Amount - , adTotal :: !Int -- ^ Cumulative length of MixedAmount this Amount is part of, - -- including separators + { 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 -> WideBuilder) -> [Amount] -> [AmountDisplay] +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 + (wbWidth str) + sep + 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 (WideBuilder (TB.fromText str) len) (adTotal lastAmt + len) + | 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 = T.take (m - 2) fullString <> ".." - | otherwise = fullString + 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 diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 16fb616be81..492b7bedcd5 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -79,11 +79,9 @@ 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.Builder as TB import Data.Time.Calendar (Day) import Safe (maximumBound) import Text.Layout.Table -import Text.Layout.Table.Cell (Cell(..)) import Hledger.Utils import Hledger.Data.Types @@ -156,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 @@ -233,16 +230,16 @@ 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 (map T.stripEnd . T.lines) . gridLinesB colSpec . map (map renderText) $ + postingblocks = map (map T.stripEnd . T.lines) . gridLinesB colSpec $ case showBalanceAssertion <$> pbalanceassertion p of - Nothing -> [ [statusandaccount, "", wbToText amt, T.drop 1 samelinecomment] | amt <- shownAmounts ] - Just asst -> [ [statusandaccount, "", wbToText amt, wbToText asst, T.drop 1 samelinecomment] | amt <- shownAmounts ] + 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 + 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') @@ -258,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 [] -> ("",[]) diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 8170762b013..6d75bebec13 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/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 ] ++ ["" diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index a6ddd9c55f1..907035568df 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -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 @@ -271,7 +271,7 @@ 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 -> Tab.Table Text Text (RenderText) budgetReportAsTable ReportOpts{..} (PeriodicReport spans items tr) = @@ -310,11 +310,11 @@ budgetReportAsTable (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 @@ -342,11 +342,11 @@ budgetReportAsTable _ -> ( showMixedAmountLinesB noPrice{displayOrder=Just cs, displayMinWidth=Nothing, displayColour=color_} , \a b -> fmap (percentage' a b) cs) - 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 @@ -361,8 +361,8 @@ budgetReportAsTable 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 (am, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (visibleLength am, bw, pw) in fmap (fmap cellwidth . disp) row -- build a list of widths for each column. In the case of transposed budget @@ -383,18 +383,17 @@ budgetReportAsTable budgetAndPerc b = uncurry zip ( showmixed b - , fmap (wbFromText . T.pack . show . roundTo 0) <$> percbudget actual' b + , fmap (renderText . T.pack . show . roundTo 0) <$> percbudget actual' b ) full | Just b <- mbudget = Just <$> budgetAndPerc b | otherwise = repeat Nothing - paddisplaycell :: (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder + paddisplaycell :: (Int, Int, Int) -> BudgetDisplayCell -> RenderText paddisplaycell (actualwidth, budgetwidth, percentwidth) (actual, mbudget) = full where - toPadded (WideBuilder b w) = - (TB.fromText . flip T.replicate " " $ actualwidth - w) <> b + toPadded s = renderText (T.replicate (actualwidth - visibleLength s) " ") <> s (totalpercentwidth, totalbudgetwidth) = let totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5 @@ -405,14 +404,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 = toPadded 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 +460,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 +470,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, displayMinWidth=Nothing} .fromMaybe nullmixedamt) $ all where diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index c60738a20e4..ba4beecedd2 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -589,9 +589,9 @@ 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.Table T.Text T.Text RenderText -> TB.Builder balanceReportTableAsText ReportOpts{..} (Tab.Table rh ch cells) = - tableStringB colSpec style rowHeader colHeader rows <> TB.singleton '\n' + tableStringB colSpec style rowHeader colHeader (map rowG cells) <> TB.singleton '\n' where colSpec = case layout_ of LayoutBare | not transpose_ -> col left : repeat (col right) @@ -601,7 +601,6 @@ balanceReportTableAsText ReportOpts{..} (Tab.Table rh ch cells) = style = if pretty_ then hledgerPrettyStyle else hledgerStyle rowHeader = renderText <$> translate left rh colHeader = renderText <$> translate right ch - rows = map (rowG . map (renderText . wbToText)) cells translate pos (Tab.Group Tab.NoLine as) = groupH NoLine $ map (translate pos) as translate pos (Tab.Group Tab.SingleLine as) = groupH SingleLine $ map (translate pos) as diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 1f9a199ecb5..9505d1a4f59 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -37,7 +37,6 @@ import Data.List.Extra (foldl', foldl1', uncons, unsnoc) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text.IO as T -import qualified Data.Text.Lazy.Builder as TB import Data.Time.Clock (getCurrentTime) import Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone, utcToLocalTime, utcToZonedTime) @@ -278,15 +277,13 @@ color int col s = setSGRCode [SetColor Foreground int col] ++ s ++ setSGRCode [] bgColor :: ColorIntensity -> Color -> String -> String bgColor int col s = setSGRCode [SetColor Background int col] ++ s ++ setSGRCode [] --- | Wrap a WideBuilder in ANSI codes to set and reset foreground colour. -colorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder -colorB int col (WideBuilder s w) = - WideBuilder (TB.fromString (setSGRCode [SetColor Foreground int col]) <> s <> TB.fromString (setSGRCode [])) w +-- | Wrap a 'Formatted a' in ANSI codes to set and reset foreground colour. +colorB :: ColorIntensity -> Color -> Formatted a -> Formatted a +colorB int col s = formatted (setSGRCode [SetColor Foreground int col]) s (setSGRCode []) --- | Wrap a WideBuilder in ANSI codes to set and reset background colour. -bgColorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder -bgColorB int col (WideBuilder s w) = - WideBuilder (TB.fromString (setSGRCode [SetColor Background int col]) <> s <> TB.fromString (setSGRCode [])) w +-- | Wrap a 'Formatted a' in ANSI codes to set and reset background colour. +bgColorB :: ColorIntensity -> Color -> Formatted a -> Formatted a +bgColorB int col s = formatted (setSGRCode [SetColor Background int col]) s (setSGRCode []) -- | Make classy lenses for Hledger options fields. diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index 039029667ee..cd2cbc30840 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -39,12 +39,9 @@ module Hledger.Utils.Text linesPrepend2, unlinesB, -- * wide-character-aware layout - WideBuilder(..), - wbToText, - wbFromText, - wbUnpack, textTakeWidth, -- ** table layout + module Text.Layout.Table.Cell, module Text.Layout.Table.Cell.Formatted, module Text.Layout.Table.Cell.WideString, RenderText, @@ -72,7 +69,6 @@ import Text.Layout.Table.Cell.WideString import Test.Tasty (testGroup) import Test.Tasty.HUnit ((@?=), testCase) -import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack) -- lowercase, uppercase :: String -> String diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index e16deb011e4..a7be4043414 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -128,7 +128,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} displayitems = s ^. asList . listElementsL acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems - balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems + balwidths = V.map (maybe 0 (visibleLength . showMixedAmountB oneLine) . asItemMixedAmount) displayitems preferredacctwidth = V.maximum acctwidths totalacctwidthseen = V.sum acctwidths preferredbalwidth = V.maximum balwidths @@ -217,8 +217,8 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = where balBuilder = maybe mempty showamt asItemMixedAmount showamt = showMixedAmountB oneLine{displayMinWidth=Just balwidth, displayMaxWidth=Just balwidth} - balspace = T.replicate (2 + balwidth - wbWidth balBuilder) " " - splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . wbToText + balspace = T.replicate (2 + balwidth - visibleLength balBuilder) " " + splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . buildCell renderamt :: T.Text -> Widget Name renderamt a | T.any (=='-') a = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "negative") $ txt a | otherwise = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "positive") $ txt a diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 6e624180233..5de24d72464 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -165,8 +165,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 (wbWidth . rsItemChangeAmount) displayitems - maxbalwidthseen = maximum' $ map (wbWidth . rsItemBalanceAmount) displayitems + maxchangewidthseen = maximum' $ map (visibleLength . rsItemChangeAmount) displayitems + maxbalwidthseen = maximum' $ map (visibleLength . rsItemBalanceAmount) displayitems changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen) maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth maxbalwidth = maxamtswidth - maxchangewidth @@ -268,8 +268,8 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist txt " " <+> withAttr balattr (txt $ fitText (Just balwidth) (Just balwidth) True False balanceAmt) where - changeAmt = wbToText rsItemChangeAmount - balanceAmt = wbToText rsItemBalanceAmount + changeAmt = buildCell rsItemChangeAmount + balanceAmt = buildCell rsItemBalanceAmount changeattr | T.any (=='-') changeAmt = sel $ attrName "list" <> attrName "amount" <> attrName "decrease" | otherwise = sel $ attrName "list" <> attrName "amount" <> attrName "increase" balattr | T.any (=='-') balanceAmt = sel $ attrName "list" <> attrName "balance" <> attrName "negative" diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 185c43617e4..4e9e5700f34 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -153,8 +153,8 @@ data RegisterScreenItem = RegisterScreenItem { ,rsItemStatus :: Status -- ^ transaction status ,rsItemDescription :: Text -- ^ description ,rsItemOtherAccounts :: Text -- ^ other accounts - ,rsItemChangeAmount :: WideBuilder -- ^ the change to the current account from this transaction - ,rsItemBalanceAmount :: WideBuilder -- ^ the balance or running total after this transaction + ,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 } deriving (Show) diff --git a/hledger-web/Hledger/Web/Handler/RegisterR.hs b/hledger-web/Hledger/Web/Handler/RegisterR.hs index dad399963a0..a01fe72621b 100644 --- a/hledger-web/Hledger/Web/Handler/RegisterR.hs +++ b/hledger-web/Hledger/Web/Handler/RegisterR.hs @@ -107,7 +107,7 @@ registerChartHtml q title percommoditytxnreports = $(hamletFile "templates/chart colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)] simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts . mixedAmountStripPrices - showZeroCommodity = wbUnpack . showMixedAmountB oneLine{displayPrice=False,displayZeroCommodity=True} + showZeroCommodity = buildCell . showMixedAmountB oneLine{displayPrice=False,displayZeroCommodity=True} :: MixedAmount -> String shownull c = if null c then " " else c nodatelink = (RegisterR, [("q", T.unwords $ removeDates q)]) diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 97f22f81a2e..cbe1ed295c3 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -360,7 +360,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do return (a,c) balancingamt = maNegate . sumPostings $ filter isReal esPostings balancingamtfirstcommodity = mixed . take 1 $ amounts balancingamt - showamt = wbUnpack . showMixedAmountB noColour . mixedAmountSetPrecision + showamt = buildCell . showMixedAmountB noColour . mixedAmountSetPrecision -- what should this be ? -- 1 maxprecision (show all decimal places or none) ? -- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ? diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 99f27b5e7f3..d642cec83e4 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -121,8 +121,8 @@ accountTransactionsReportItemAsCsvRecord where idx = T.pack $ show tindex date = showDate $ transactionRegisterDate wd reportq thisacctq t - amt = wbToText $ showMixedAmountB csvDisplay change - bal = wbToText $ showMixedAmountB csvDisplay balance + amt = buildCell $ showMixedAmountB csvDisplay change + bal = buildCell $ showMixedAmountB csvDisplay balance -- | Render a register report as plain text suitable for console output. accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text @@ -156,7 +156,7 @@ accountTransactionsReportAsText copts reportq thisacctq items = TB.toLazyText $ -- has multiple commodities. -- accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int - -> (AccountTransactionsReportItem, [WideBuilder], [WideBuilder]) + -> (AccountTransactionsReportItem, [RenderText], [RenderText]) -> TB.Builder accountTransactionsReportItemAsText copts@CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}} @@ -170,8 +170,8 @@ accountTransactionsReportItemAsText -- MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction table <> TB.singleton '\n' where - table = gridStringB colSpec $ colsAsRows [top, top, top, top, top, top, top, bottom] $ map (map renderText) - [[date], [tdescription], [""], [accts], [""], map wbToText amt, [""], map wbToText bal] + table = gridStringB colSpec $ colsAsRows [top, top, top, top, top, top, top, bottom] + [[date], [renderText tdescription], [""], [accts], [""], amt, [""], bal] where colSpec = [cl datewidth, cl descwidth, cl 0, cl acctwidth, cl 0, cr amtwidth, cl 0, cr balwidth] cl width = column (fixed width) left noAlign (singleCutMark "..") @@ -179,7 +179,7 @@ accountTransactionsReportItemAsText -- calculate widths (totalwidth,mdescwidth) = registerWidthsFromOpts copts - (datewidth, date) = (10, showDate $ transactionRegisterDate wd reportq thisacctq t) + (datewidth, date) = (10, renderText . showDate $ transactionRegisterDate wd reportq thisacctq t) where wd = whichDate ropts (amtwidth, balwidth) | shortfall <= 0 = (preferredamtwidth, preferredbalwidth) @@ -198,7 +198,7 @@ accountTransactionsReportItemAsText -- gather content accts = -- T.unpack $ elideAccountName acctwidth $ T.pack - otheracctsstr + renderText otheracctsstr -- tests diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 06fa9c60252..c2c01d08b07 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -265,8 +265,9 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB 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 Lucid as L import Safe (maximumMay) import Text.Layout.Table import qualified Text.Tabular.AsciiWide as Tab @@ -418,7 +419,7 @@ balanceReportAsCsv opts (items, total) = _ -> [[showName name, renderAmount ma]] showName = accountNameDrop (drop_ opts) - renderAmount amt = wbToText $ showMixedAmountB bopts amt + renderAmount amt = buildCell $ showMixedAmountB bopts amt where bopts = csvDisplay{displayOrder = order} order = if layout_ opts == LayoutBare then Just (S.toList $ maCommodities amt) else Nothing @@ -459,9 +460,8 @@ 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 $ - map (map (Hledger.renderText . wbToText)) is - , map (fromMaybe 0 . maximumMay . map wbWidth) is ) + renderRow' is = ( concatLines . map mconcat . gridB (concatMap colSpec comps) $ colsAsRowsAll vPos is + , map (fromMaybe 0 . maximumMay . map visibleLength) is ) (vPos, oneline, comps) = case format_ opts of OneLine comps -> (top, True, comps) @@ -475,12 +475,12 @@ balanceReportItemAsText opts (_, acctname, depth, total) = col ljust = column expand (if ljust then left else right) noAlign (singleCutMark "..") -- | Render one StringFormat component for a balance report item. -renderComponent :: Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> [[WideBuilder]] -renderComponent _ _ _ (FormatLiteral s) = [[wbFromText s]] +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 -> [[WideBuilder (TB.fromText $ T.replicate d " ") d]] + DepthSpacerField -> [[renderText $ T.replicate d " "]] where d = maybe id min mmax $ depth * fromMaybe 1 mmin - AccountField -> [[wbFromText $ formatText ljust mmin mmax acctname]] + AccountField -> [[renderText $ formatText ljust mmin mmax acctname]] -- Add commodities after the amounts, if LayoutBare is used. TotalField | oneline -> [showMixedAmountB dopts total] : commoditiesColumns TotalField -> showMixedAmountLinesB dopts total : commoditiesColumns @@ -491,7 +491,7 @@ renderComponent oneline opts (acctname, depth, total) (FormatField ljust mmin mm commodities = case layout_ opts of LayoutBare -> Just $ if mixedAmountLooksZero total then [""] else S.toList $ maCommodities total _ -> Nothing - commoditiesColumns = maybe [] (\cs -> [[wbFromText " "], map wbFromText cs]) commodities + commoditiesColumns = maybe [] (\cs -> [[renderText " "], map renderText cs]) commodities -- rendering multi-column balance reports @@ -648,7 +648,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $ _ -> False -- | Build a 'Table' from a multi-column balance report. -balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Tab.Table T.Text T.Text WideBuilder +balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Tab.Table T.Text T.Text RenderText balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} (PeriodicReport spans items tr) = maybetranspose $ @@ -679,20 +679,20 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} maybetranspose | transpose_ opts = \(Tab.Table rh ch vals) -> Tab.Table ch rh (transpose vals) | otherwise = id -multiBalanceRowAsWbs :: AmountDisplayOpts -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] +multiBalanceRowAsWbs :: AmountDisplayOpts -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[RenderText]] multiBalanceRowAsWbs 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 (:) (fmap wbFromText cs) -- add symbols - . transpose -- each row becomes a list of Text quantities - . fmap (showMixedAmountLinesB bopts{displayOrder=Just cs, displayMinWidth=Nothing}) + 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 -> [wbFromText c, a]) cs + . 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 @@ -700,9 +700,9 @@ multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowto totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts allamts = as ++ [rowtot | totalscolumn && not (null as)] ++ [rowavg | average_ && not (null as)] - addDateColumns span@(DateSpan s e) = (wbFromText (showDateSpan span) :) - . (wbFromText (maybe "" showDate s) :) - . (wbFromText (maybe "" (showDate . addDays (-1)) e) :) + addDateColumns span@(DateSpan s e) = (renderText (showDateSpan span) :) + . (renderText (maybe "" showDate s) :) + . (renderText (maybe "" (showDate . addDays (-1)) e) :) paddedTranspose :: a -> [[a]] -> [[a]] paddedTranspose _ [] = [[]] @@ -719,9 +719,9 @@ multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowto m [] = [n] multiBalanceRowAsCsvText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]] -multiBalanceRowAsCsvText opts colspans = fmap (fmap wbToText) . multiBalanceRowAsWbs csvDisplay opts colspans +multiBalanceRowAsCsvText opts colspans = map (map buildCell) . multiBalanceRowAsWbs csvDisplay opts colspans -multiBalanceRowAsTableText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] +multiBalanceRowAsTableText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[RenderText]] multiBalanceRowAsTableText opts = multiBalanceRowAsWbs oneLine{displayColour=color_ opts} opts [] tests_Balance = testGroup "Balance" [ diff --git a/hledger/Hledger/Cli/Commands/Prices.hs b/hledger/Hledger/Cli/Commands/Prices.hs index 132a4446ff7..30cde716b77 100755 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/hledger/Hledger/Cli/Commands/Prices.hs @@ -54,7 +54,7 @@ prices opts j = do | otherwise = const [] showPriceDirective :: PriceDirective -> T.Text -showPriceDirective mp = T.unwords ["P", T.pack . show $ pddate mp, quoteCommoditySymbolIfNeeded $ pdcommodity mp, wbToText . showAmountB noColour{displayZeroCommodity=True} $ pdamount mp] +showPriceDirective mp = T.unwords ["P", T.pack . show $ pddate mp, quoteCommoditySymbolIfNeeded $ pdcommodity mp, buildCell . showAmountB noColour{displayZeroCommodity=True} $ pdamount mp] -- XXX diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 1231a751b8f..aeb01fcec30 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -185,7 +185,7 @@ postingToCSV p = -- commodity goes into separate column, so we suppress it, along with digit group -- separators and prices let a_ = amountStripPrices a{acommodity=""} in - let showamt = wbToText . showAmountB csvDisplay in + let showamt = buildCell . showAmountB csvDisplay in let amount = showamt a_ in let credit = if q < 0 then showamt $ negate a_ else "" in let debit = if q >= 0 then showamt a_ else "" in diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 13e1094c10e..625ab85349b 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -88,8 +88,8 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal VirtualPosting -> wrap "(" ")" _ -> id -- Since postingsReport strips prices from all Amounts when not used, we can display prices. - amt = wbToText . showMixedAmountB csvDisplay $ pamount p - bal = wbToText $ showMixedAmountB csvDisplay b + amt = buildCell . showMixedAmountB csvDisplay $ pamount p + bal = buildCell $ showMixedAmountB csvDisplay b -- | Render a register report as plain text suitable for console output. postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text @@ -125,13 +125,13 @@ postingsReportAsText opts = TB.toLazyText . -- Also returns the natural width (without padding) of the amount and balance -- fields. postingsReportItemAsText :: CliOpts -> Int -> Int - -> (PostingsReportItem, [WideBuilder], [WideBuilder]) + -> (PostingsReportItem, [RenderText], [RenderText]) -> TB.Builder postingsReportItemAsText opts preferredamtwidth preferredbalwidth ((mdate, mperiod, mdesc, p, _), amt, bal) = table <> TB.singleton '\n' where - table = gridStringB colSpec $ colsAsRows [top, top, top, top, top, top, top, bottom] $ map (map renderText) - [[date], [desc], [""], [acct], [""], map wbToText amt, [""], map wbToText bal] + table = gridStringB colSpec $ colsAsRows [top, top, top, top, top, top, top, bottom] + [[date], [desc], [""], [acct], [""], amt, [""], bal] where colSpec = [cl datewidth, cl descwidth, cl 0, cl acctwidth, cl 0, cr amtwidth, cl 0, cr balwidth] cl width = column (fixed width) left noAlign (singleCutMark "..") @@ -140,7 +140,7 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth ((mdate, mperi -- calculate widths (totalwidth,mdescwidth) = registerWidthsFromOpts opts datewidth = maybe 10 periodTextWidth mperiod - date = case mperiod of + date = renderText $ case mperiod of Just period -> if isJust mdate then showPeriod period else "" Nothing -> maybe "" showDate mdate (amtwidth, balwidth) @@ -162,8 +162,8 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth ((mdate, mperi w = fromMaybe ((remaining - 2) `div` 2) mdescwidth -- gather content - desc = fromMaybe "" mdesc - acct = parenthesise . elideAccountName awidth $ paccount p + desc = renderText $ fromMaybe "" mdesc + acct = renderText . parenthesise . elideAccountName awidth $ paccount p where (parenthesise, awidth) = case ptype p of BalancedVirtualPosting -> (wrap "[" "]", acctwidth-2) diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index 5283e3cb0cc..810e9f08e2c 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -29,7 +29,6 @@ import qualified Data.Text.Lazy.IO as TL import qualified Data.Text.Lazy.Builder as TB import System.Console.CmdArgs.Explicit as CmdArgs import Text.Layout.Table -import Text.Layout.Table.Cell (Cell) import Hledger import Hledger.Cli.CliOptions diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index d9f4589596f..04b01a34888 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -262,7 +262,7 @@ journalSimilarTransaction cliopts j desc = mbestmatch -- | Render a 'PostingsReport' or 'AccountTransactionsReport' as Text, -- determining the appropriate starting widths and increasing as necessary. postingsOrTransactionsReportAsText - :: Bool -> CliOpts -> (Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> TB.Builder) + :: Bool -> CliOpts -> (Int -> Int -> (a, [RenderText], [RenderText]) -> TB.Builder) -> (a -> MixedAmount) -> (a -> MixedAmount) -> [a] -> TB.Builder postingsOrTransactionsReportAsText alignAll opts itemAsText itemamt itembal report = mconcat . snd $ mapAccumL renderItem (startWidth amt, startWidth bal) itemsWithAmounts @@ -273,10 +273,10 @@ postingsOrTransactionsReportAsText alignAll opts itemAsText itemamt itembal repo renderItem (amtWidth, balWidth) item@(_, amt, bal) = ((amtWidth', balWidth'), itemBuilder) where itemBuilder = itemAsText amtWidth' balWidth' item - amtWidth' = if alignAll then amtWidth else maximumStrict $ amtWidth : map wbWidth amt - balWidth' = if alignAll then balWidth else maximumStrict $ balWidth : map wbWidth bal + amtWidth' = if alignAll then amtWidth else maximumStrict $ amtWidth : map visibleLength amt + balWidth' = if alignAll then balWidth else maximumStrict $ balWidth : map visibleLength bal - startWidth f = maximum $ minWidth : map wbWidth (concatMap f startAlign) + startWidth f = maximum $ minWidth : map visibleLength (concatMap f startAlign) where startAlign = (if alignAll then id else take chunkSize) itemsWithAmounts diff --git a/hledger/test/balance/bcexample.test b/hledger/test/balance/bcexample.test index 9d322963f67..2ef8d433e70 100644 --- a/hledger/test/balance/bcexample.test +++ b/hledger/test/balance/bcexample.test @@ -3,27 +3,27 @@ $ hledger -f bcexample.hledger bal -t -1 --color=always > - 70.00 GLD - 17.00 ITOT -489.957000000000 RGAGX - 5716.53 USD - 337.26 VACHR -309.950000000000 VBMPX - 36.00 VEA + 70.00 GLD + 17.00 ITOT +489.957000000000 RGAGX + 5716.53 USD + 337.26 VACHR +309.950000000000 VBMPX + 36.00 VEA 294.00 VHT Assets -2891.85 USD Liabilities -3077.70 USD Equity - -52000.00 IRAUSD - -365071.44 USD + -52000.00 IRAUSD + -365071.44 USD -337.26 VACHR Income - 52000.00 IRAUSD + 52000.00 IRAUSD 260911.70 USD Expenses -------------------- - 70.00 GLD - 17.00 ITOT -489.957000000000 RGAGX - -104412.76 USD -309.950000000000 VBMPX - 36.00 VEA + 70.00 GLD + 17.00 ITOT +489.957000000000 RGAGX + -104412.76 USD +309.950000000000 VBMPX + 36.00 VEA 294.00 VHT >=0 From 2d16503b10ffe494333ab93bcef015329f62a372 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 29 Mar 2022 10:32:31 +1100 Subject: [PATCH 7/8] cln!: tabular: Remove unneeded tabular modules. Text.WideString and Text.Tabular.AsciiWide modules are now redundant and can be removed. A local definition of Table and concatTables has been moved to Hledger.Utils.Text. --- hledger-lib/Hledger/Data/Account.hs | 1 - hledger-lib/Hledger/Data/Amount.hs | 1 + hledger-lib/Hledger/Reports/BudgetReport.hs | 30 +- .../Hledger/Reports/MultiBalanceReport.hs | 14 +- hledger-lib/Hledger/Utils/Text.hs | 24 +- hledger-lib/Text/Tabular/AsciiWide.hs | 309 ------------------ hledger-lib/Text/WideString.hs | 39 --- hledger-lib/hledger-lib.cabal | 5 - hledger-lib/package.yaml | 2 - hledger/Hledger/Cli/Commands/Balance.hs | 65 ++-- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 15 +- hledger/hledger.cabal | 4 - hledger/package.yaml | 1 - 13 files changed, 84 insertions(+), 426 deletions(-) delete mode 100644 hledger-lib/Text/Tabular/AsciiWide.hs delete mode 100644 hledger-lib/Text/WideString.hs diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index 6bba6ad6aff..7710cd36fa1 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -41,7 +41,6 @@ import Data.Ord (Down(..)) import Safe (headMay) import Text.Printf (printf) -import Hledger.Utils (buildCell) import Hledger.Data.AccountName (expandAccountName, clipOrEllipsifyAccountName) import Hledger.Data.Amount import Hledger.Data.Types diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 2f38de38df5..45184ecf76e 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -136,6 +136,7 @@ module Hledger.Data.Amount ( showMixedAmountWithZeroCommodity, showMixedAmountB, showMixedAmountLinesB, + buildCell, mixedAmountSetPrecision, mixedAmountSetFullPrecision, canonicaliseMixedAmount, diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 907035568df..f7fbfe337ca 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -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 @@ -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 (RenderText) +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,16 +300,16 @@ 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)) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index ba4beecedd2..ce6856aefce 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -55,7 +55,6 @@ import Text.Layout.Table 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,8 +588,8 @@ 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 RenderText -> TB.Builder -balanceReportTableAsText ReportOpts{..} (Tab.Table rh ch cells) = +balanceReportTableAsText :: ReportOpts -> Table T.Text T.Text 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 @@ -599,13 +598,8 @@ balanceReportTableAsText ReportOpts{..} (Tab.Table rh ch cells) = where col pos = column expand pos noAlign noCutMark style = if pretty_ then hledgerPrettyStyle else hledgerStyle - rowHeader = renderText <$> translate left rh - colHeader = renderText <$> translate right ch - - translate pos (Tab.Group Tab.NoLine as) = groupH NoLine $ map (translate pos) as - translate pos (Tab.Group Tab.SingleLine as) = groupH SingleLine $ map (translate pos) as - translate pos (Tab.Group Tab.DoubleLine as) = groupH DoubleLine $ map (translate pos) as - translate pos (Tab.Header a) = headerH (headerColumn pos Nothing) a + rowHeader = renderText <$> rh + colHeader = renderText <$> ch -- tests diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index cd2cbc30840..fc4f42a35a9 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -46,6 +46,8 @@ module Hledger.Utils.Text module Text.Layout.Table.Cell.WideString, RenderText, renderText, + Table(..), + concatTables, -- * table rendering hledgerStyle, hledgerStyleBorders, @@ -236,16 +238,30 @@ linesPrepend2 prefix1 prefix2 s = T.unlines $ case T.lines s of [] -> [] l:ls -> (prefix1<>l) : map (prefix2<>) ls --- | Join a list of Text Builders with a newline after each item. -unlinesB :: [TB.Builder] -> TB.Builder -unlinesB = foldMap (<> TB.singleton '\n') - -- | Read a decimal number from a Text. Assumes the input consists only of digit -- characters. readDecimal :: Text -> Integer readDecimal = T.foldl' step 0 where step a c = a * 10 + toInteger (digitToInt c) +-- | Join a list of Text Builders with a newline after each item. +unlinesB :: [TB.Builder] -> TB.Builder +unlinesB = foldMap (<> TB.singleton '\n') + + +-- Tables and rendering + +-- | 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]] + +-- | 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 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 + -- | An alias for formatted text measured by display length. type RenderText = Formatted WideText diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs deleted file mode 100644 index 9b641183013..00000000000 --- a/hledger-lib/Text/Tabular/AsciiWide.hs +++ /dev/null @@ -1,309 +0,0 @@ --- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat --- wide characters as double width. - -{-# LANGUAGE OverloadedStrings #-} - -module Text.Tabular.AsciiWide -( module Text.Tabular - -, TableOpts(..) -, render -, renderTable -, renderTableB -, renderTableByRowsB -, renderRow -, renderRowB -, renderColumns - -, Cell(..) -, Align(..) -, emptyCell -, textCell -, textsCell -, cellWidth -, concatTables -) where - -import Data.Bifunctor (bimap) -import Data.Maybe (fromMaybe) -import Data.Default (Default(..)) -import Data.List (intercalate, intersperse, transpose) -import Data.Semigroup (stimesMonoid) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText) -import Safe (maximumMay) -import Text.Tabular -import Text.WideString (WideBuilder(..), wbFromText) - - --- | The options to use for rendering a table. -data TableOpts = TableOpts - { prettyTable :: Bool -- ^ Pretty tables - , tableBorders :: Bool -- ^ Whether to display the outer borders - , borderSpaces :: Bool -- ^ Whether to display spaces around bars - } deriving (Show) - -instance Default TableOpts where - def = TableOpts { prettyTable = False - , tableBorders = True - , borderSpaces = True - } - --- | Cell contents along an alignment -data Cell = Cell Align [WideBuilder] - --- | How to align text in a cell -data Align = TopRight | BottomRight | BottomLeft | TopLeft - deriving (Show) - -emptyCell :: Cell -emptyCell = Cell TopRight [] - --- | Create a single-line cell from the given contents with its natural width. -textCell :: Align -> Text -> Cell -textCell a x = Cell a . map wbFromText $ if T.null x then [""] else T.lines x - --- | Create a multi-line cell from the given contents with its natural width. -textsCell :: Align -> [Text] -> Cell -textsCell a = Cell a . fmap wbFromText - --- | Return the width of a Cell. -cellWidth :: Cell -> Int -cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map wbWidth xs - - --- | Render a table according to common options, for backwards compatibility -render :: Bool -> (rh -> Text) -> (ch -> Text) -> (a -> Text) -> Table rh ch a -> TL.Text -render pretty fr fc f = renderTable def{prettyTable=pretty} (cell . fr) (cell . fc) (cell . f) - where cell = textCell TopRight - --- | Render a table according to various cell specifications> -renderTable :: TableOpts -- ^ Options controlling Table rendering - -> (rh -> Cell) -- ^ Rendering function for row headers - -> (ch -> Cell) -- ^ Rendering function for column headers - -> (a -> Cell) -- ^ Function determining the string and width of a cell - -> Table rh ch a - -> TL.Text -renderTable topts fr fc f = toLazyText . renderTableB topts fr fc f - --- | A version of renderTable which returns the underlying Builder. -renderTableB :: TableOpts -- ^ Options controlling Table rendering - -> (rh -> Cell) -- ^ Rendering function for row headers - -> (ch -> Cell) -- ^ Rendering function for column headers - -> (a -> Cell) -- ^ Function determining the string and width of a cell - -> Table rh ch a - -> Builder -renderTableB topts fr fc f = renderTableByRowsB topts (fmap fc) $ bimap fr (fmap f) - --- | A version of renderTable that operates on rows (including the 'row' of --- column headers) and returns the underlying Builder. -renderTableByRowsB :: TableOpts -- ^ Options controlling Table rendering - -> ([ch] -> [Cell]) -- ^ Rendering function for column headers - -> ((rh, [a]) -> (Cell, [Cell])) -- ^ Rendering function for row and row header - -> Table rh ch a - -> Builder -renderTableByRowsB topts@TableOpts{prettyTable=pretty, tableBorders=borders} fc f (Table rh ch cells) = - unlinesB . addBorders $ - renderColumns topts sizes ch2 - : bar VM DoubleLine -- +======================================+ - : renderRs (renderR <$> zipHeader [] cellContents rowHeaders) - where - renderR :: ([Cell], Cell) -> Builder - renderR (cs,h) = renderColumns topts sizes $ Group DoubleLine - [ Header h - , fst <$> zipHeader emptyCell cs colHeaders - ] - - rows = unzip . fmap f $ zip (headerContents rh) cells - rowHeaders = fst <$> zipHeader emptyCell (fst rows) rh - colHeaders = fst <$> zipHeader emptyCell (fc $ headerContents ch) ch - cellContents = snd rows - - -- ch2 and cell2 include the row and column labels - ch2 = Group DoubleLine [Header emptyCell, colHeaders] - cells2 = headerContents ch2 : zipWith (:) (headerContents rowHeaders) cellContents - - -- maximum width for each column - sizes = map (fromMaybe 0 . maximumMay . map cellWidth) $ transpose cells2 - renderRs (Header s) = [s] - renderRs (Group p hs) = intercalate sep $ map renderRs hs - where sep = renderHLine VM borders pretty sizes ch2 p - - -- borders and bars - addBorders xs = if borders then bar VT SingleLine : xs ++ [bar VB SingleLine] else xs - bar vpos prop = mconcat $ renderHLine vpos borders pretty sizes ch2 prop - unlinesB = foldMap (<> singleton '\n') - --- | Render a single row according to cell specifications. -renderRow :: TableOpts -> Header Cell -> TL.Text -renderRow topts = toLazyText . renderRowB topts - --- | A version of renderRow which returns the underlying Builder. -renderRowB:: TableOpts -> Header Cell -> Builder -renderRowB topts h = renderColumns topts is h - where is = map cellWidth $ headerContents h - - -verticalBar :: Bool -> Char -verticalBar pretty = if pretty then '│' else '|' - -leftBar :: Bool -> Bool -> Builder -leftBar pretty True = fromString $ verticalBar pretty : " " -leftBar pretty False = singleton $ verticalBar pretty - -rightBar :: Bool -> Bool -> Builder -rightBar pretty True = fromString $ ' ' : [verticalBar pretty] -rightBar pretty False = singleton $ verticalBar pretty - -midBar :: Bool -> Bool -> Builder -midBar pretty True = fromString $ ' ' : verticalBar pretty : " " -midBar pretty False = singleton $ verticalBar pretty - -doubleMidBar :: Bool -> Bool -> Builder -doubleMidBar pretty True = fromText $ if pretty then " ║ " else " || " -doubleMidBar pretty False = fromText $ if pretty then "║" else "||" - --- | We stop rendering on the shortest list! -renderColumns :: TableOpts -- ^ rendering options for the table - -> [Int] -- ^ max width for each column - -> Header Cell - -> Builder -renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=spaces} is h = - mconcat . intersperse "\n" -- Put each line on its own line - . map (addBorders . mconcat) . transpose -- Change to a list of lines and add borders - . map (either hsep padCell) . flattenHeader -- We now have a matrix of strings - . zipHeader 0 is $ padRow <$> h -- Pad cell height and add width marker - where - -- Pad each cell to have the appropriate width - padCell (w, Cell TopLeft ls) = map (\x -> wbBuilder x <> fromText (T.replicate (w - wbWidth x) " ")) ls - padCell (w, Cell BottomLeft ls) = map (\x -> wbBuilder x <> fromText (T.replicate (w - wbWidth x) " ")) ls - padCell (w, Cell TopRight ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls - padCell (w, Cell BottomRight ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls - - - -- Pad each cell to have the same number of lines - padRow (Cell TopLeft ls) = Cell TopLeft $ ls ++ replicate (nLines - length ls) mempty - padRow (Cell TopRight ls) = Cell TopRight $ ls ++ replicate (nLines - length ls) mempty - padRow (Cell BottomLeft ls) = Cell BottomLeft $ replicate (nLines - length ls) mempty ++ ls - padRow (Cell BottomRight ls) = Cell BottomRight $ replicate (nLines - length ls) mempty ++ ls - - hsep :: Properties -> [Builder] - hsep NoLine = replicate nLines $ if spaces then " " else "" - hsep SingleLine = replicate nLines $ midBar pretty spaces - hsep DoubleLine = replicate nLines $ doubleMidBar pretty spaces - - addBorders xs | borders = leftBar pretty spaces <> xs <> rightBar pretty spaces - | spaces = fromText " " <> xs <> fromText " " - | otherwise = xs - - nLines = fromMaybe 0 . maximumMay . map (\(Cell _ ls) -> length ls) $ headerContents h - -renderHLine :: VPos - -> Bool -- ^ show outer borders - -> Bool -- ^ pretty - -> [Int] -- ^ width specifications - -> Header a - -> Properties - -> [Builder] -renderHLine _ _ _ _ _ NoLine = [] -renderHLine vpos borders pretty w h prop = [renderHLine' vpos borders pretty prop w h] - -renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder -renderHLine' vpos borders pretty prop is h = addBorders $ sep <> coreLine <> sep - where - addBorders xs = if borders then edge HL <> xs <> edge HR else xs - edge hpos = boxchar vpos hpos SingleLine prop pretty - coreLine = foldMap helper $ flattenHeader $ zipHeader 0 is h - helper = either vsep dashes - dashes (i,_) = stimesMonoid i sep - sep = boxchar vpos HM NoLine prop pretty - vsep v = case v of - NoLine -> sep <> sep - _ -> sep <> cross v prop <> sep - cross v h = boxchar vpos HM v h pretty - -data VPos = VT | VM | VB -- top middle bottom -data HPos = HL | HM | HR -- left middle right - -boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> Builder -boxchar vpos hpos vert horiz = lineart u d l r - where - u = case vpos of - VT -> NoLine - _ -> vert - d = case vpos of - VB -> NoLine - _ -> vert - l = case hpos of - HL -> NoLine - _ -> horiz - r = case hpos of - HR -> NoLine - _ -> horiz - -pick :: Text -> Text -> Bool -> Builder -pick x _ True = fromText x -pick _ x False = fromText x - -lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> Builder --- up down left right -lineart SingleLine SingleLine SingleLine SingleLine = pick "┼" "+" -lineart SingleLine SingleLine SingleLine NoLine = pick "┤" "+" -lineart SingleLine SingleLine NoLine SingleLine = pick "├" "+" -lineart SingleLine NoLine SingleLine SingleLine = pick "┴" "+" -lineart NoLine SingleLine SingleLine SingleLine = pick "┬" "+" -lineart SingleLine NoLine NoLine SingleLine = pick "└" "+" -lineart SingleLine NoLine SingleLine NoLine = pick "┘" "+" -lineart NoLine SingleLine SingleLine NoLine = pick "┐" "+" -lineart NoLine SingleLine NoLine SingleLine = pick "┌" "+" -lineart SingleLine SingleLine NoLine NoLine = pick "│" "|" -lineart NoLine NoLine SingleLine SingleLine = pick "─" "-" - -lineart DoubleLine DoubleLine DoubleLine DoubleLine = pick "╬" "++" -lineart DoubleLine DoubleLine DoubleLine NoLine = pick "╣" "++" -lineart DoubleLine DoubleLine NoLine DoubleLine = pick "╠" "++" -lineart DoubleLine NoLine DoubleLine DoubleLine = pick "╩" "++" -lineart NoLine DoubleLine DoubleLine DoubleLine = pick "╦" "++" -lineart DoubleLine NoLine NoLine DoubleLine = pick "╚" "++" -lineart DoubleLine NoLine DoubleLine NoLine = pick "╝" "++" -lineart NoLine DoubleLine DoubleLine NoLine = pick "╗" "++" -lineart NoLine DoubleLine NoLine DoubleLine = pick "╔" "++" -lineart DoubleLine DoubleLine NoLine NoLine = pick "║" "||" -lineart NoLine NoLine DoubleLine DoubleLine = pick "═" "=" - -lineart DoubleLine NoLine NoLine SingleLine = pick "╙" "++" -lineart DoubleLine NoLine SingleLine NoLine = pick "╜" "++" -lineart NoLine DoubleLine SingleLine NoLine = pick "╖" "++" -lineart NoLine DoubleLine NoLine SingleLine = pick "╓" "++" - -lineart SingleLine NoLine NoLine DoubleLine = pick "╘" "+" -lineart SingleLine NoLine DoubleLine NoLine = pick "╛" "+" -lineart NoLine SingleLine DoubleLine NoLine = pick "╕" "+" -lineart NoLine SingleLine NoLine DoubleLine = pick "╒" "+" - -lineart DoubleLine DoubleLine SingleLine NoLine = pick "╢" "++" -lineart DoubleLine DoubleLine NoLine SingleLine = pick "╟" "++" -lineart DoubleLine NoLine SingleLine SingleLine = pick "╨" "++" -lineart NoLine DoubleLine SingleLine SingleLine = pick "╥" "++" - -lineart SingleLine SingleLine DoubleLine NoLine = pick "╡" "+" -lineart SingleLine SingleLine NoLine DoubleLine = pick "╞" "+" -lineart SingleLine NoLine DoubleLine DoubleLine = pick "╧" "+" -lineart NoLine SingleLine DoubleLine DoubleLine = pick "╤" "+" - -lineart SingleLine SingleLine DoubleLine DoubleLine = pick "╪" "+" -lineart DoubleLine DoubleLine SingleLine SingleLine = pick "╫" "++" - -lineart _ _ _ _ = const mempty - - --- | Add the second table below the first, discarding its column headings. -concatTables :: Monoid a => Properties -> Table rh ch a -> Table rh ch2 a -> Table rh ch a -concatTables prop (Table hLeft hTop dat) (Table hLeft' _ dat') = - Table (Group prop [hLeft, hLeft']) hTop (map padRow $ dat ++ dat') - where - numCols = length $ headerContents hTop - padRow r = replicate (numCols - length r) mempty ++ r - diff --git a/hledger-lib/Text/WideString.hs b/hledger-lib/Text/WideString.hs deleted file mode 100644 index b31ae88f2b2..00000000000 --- a/hledger-lib/Text/WideString.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | Calculate the width of String and Text, being aware of wide characters. - -module Text.WideString ( - -- * Text Builders which keep track of length - WideBuilder(..), - wbUnpack, - wbToText, - wbFromText - ) where - -import Data.Text (Text) -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Builder as TB -import Text.DocLayout (realLength) - - --- | Helper for constructing Builders while keeping track of text width. -data WideBuilder = WideBuilder - { wbBuilder :: !TB.Builder - , wbWidth :: !Int - } deriving (Show) - -instance Semigroup WideBuilder where - WideBuilder x i <> WideBuilder y j = WideBuilder (x <> y) (i + j) - -instance Monoid WideBuilder where - mempty = WideBuilder mempty 0 - --- | Convert a WideBuilder to a strict Text. -wbToText :: WideBuilder -> Text -wbToText = TL.toStrict . TB.toLazyText . wbBuilder - --- | Convert a strict Text to a WideBuilder. -wbFromText :: Text -> WideBuilder -wbFromText t = WideBuilder (TB.fromText t) (realLength t) - --- | Convert a WideBuilder to a String. -wbUnpack :: WideBuilder -> String -wbUnpack = TL.unpack . TB.toLazyText . wbBuilder diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 612752523ed..566b1d0e7ba 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -88,10 +88,8 @@ library Hledger.Utils.String Hledger.Utils.Test Hledger.Utils.Text - Text.Tabular.AsciiWide other-modules: Text.Megaparsec.Custom - Text.WideString Paths_hledger_lib hs-source-dirs: ./ @@ -127,7 +125,6 @@ library , regex-tdfa , safe >=0.3.19 , table-layout >=0.9.1.0 - , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 , template-haskell @@ -179,7 +176,6 @@ test-suite doctest , regex-tdfa , safe >=0.3.19 , table-layout >=0.9.1.0 - , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 , template-haskell @@ -233,7 +229,6 @@ test-suite unittest , regex-tdfa , safe >=0.3.19 , table-layout >=0.9.1.0 - , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 , template-haskell diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 83f5dc2e5c7..0907a087440 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -59,7 +59,6 @@ dependencies: - pretty-simple >4 && <5 - regex-tdfa - safe >=0.3.19 -- tabular >=0.2 - table-layout >=0.9.1.0 - tasty >=1.2.3 - tasty-hunit >=0.10.0.2 @@ -142,7 +141,6 @@ library: - Hledger.Utils.String - Hledger.Utils.Test - Hledger.Utils.Text - - Text.Tabular.AsciiWide # other-modules: # - Ledger.Parser.Text diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index c2c01d08b07..01946b986dc 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -270,7 +270,6 @@ import qualified Lucid as L import System.Console.CmdArgs.Explicit as C import Safe (maximumMay) import Text.Layout.Table -import qualified Text.Tabular.AsciiWide as Tab import Hledger import Hledger.Cli.CliOptions @@ -648,21 +647,25 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $ _ -> False -- | Build a 'Table' from a multi-column balance report. -balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Tab.Table T.Text T.Text RenderText +balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text RenderText balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} (PeriodicReport spans items tr) = maybetranspose $ addtotalrow $ - Tab.Table - (Tab.Group Tab.NoLine $ map Tab.Header (concat accts)) - (Tab.Group Tab.NoLine $ map Tab.Header colheadings) + Table + (makeHeader (if transpose_ opts then right else left) $ concat accts) + datesHeader (concat rows) where totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] - colheadings = ["Commodity" | layout_ opts == LayoutBare] - ++ map (reportPeriodName balanceaccum_ spans) spans - ++ [" Total" | totalscolumn] - ++ ["Average" | average_] + datesHeader = case layout_ opts of + LayoutBare -> groupH NoLine [headerH (headerColumn left Nothing) "Commodity", colheadings] + _ -> colheadings + colheadings = makeHeader (if transpose_ opts then left else right) $ + map (reportPeriodName balanceaccum_ spans) spans + ++ [" Total" | totalscolumn] + ++ ["Average" | average_] + makeHeader pos = fullSepH NoLine (repeat $ headerColumn pos Nothing) fullRowAsTexts row = let rs = multiBalanceRowAsTableText opts row in (replicate (length rs) (renderacct row), rs) @@ -673,14 +676,20 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} | no_total_ opts = id | otherwise = let totalrows = multiBalanceRowAsTableText opts tr - 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) - maybetranspose | transpose_ opts = \(Tab.Table rh ch vals) -> Tab.Table ch rh (transpose vals) + rh = fullSepH NoLine (repeat def) $ replicate (length totalrows) "" + ch = noneH -- ignored + in (flip (concatTables SingleLine) $ Table rh ch totalrows) + maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals) | otherwise = id -multiBalanceRowAsWbs :: AmountDisplayOpts -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[RenderText]] -multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = +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 opts = multiBalanceRowAsTableTextHelper oneLine{displayColour=color_ opts} opts [] + +multiBalanceRowAsTableTextHelper :: AmountDisplayOpts -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[RenderText]] +multiBalanceRowAsTableTextHelper bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = case layout_ of LayoutWide width -> [fmap (showMixedAmountB bopts{displayMaxWidth=width}) allamts] LayoutTall -> paddedTranspose mempty @@ -707,22 +716,16 @@ multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowto 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] - -multiBalanceRowAsCsvText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]] -multiBalanceRowAsCsvText opts colspans = map (map buildCell) . multiBalanceRowAsWbs csvDisplay opts colspans - -multiBalanceRowAsTableText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[RenderText]] -multiBalanceRowAsTableText opts = multiBalanceRowAsWbs oneLine{displayColour=color_ opts} opts [] + 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" [ diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 66e9aec69e3..2cadce5296c 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -20,11 +20,11 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day, addDays) import System.Console.CmdArgs.Explicit as C -import Hledger.Read.CsvReader (CSV, printCSV) import Lucid as L hiding (value_) -import Text.Tabular.AsciiWide as Tab +import Text.Layout.Table import Hledger +import Hledger.Read.CsvReader (CSV, printCSV) import Hledger.Cli.Commands.Balance import Hledger.Cli.CliOptions import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutputLazyText) @@ -219,25 +219,26 @@ compoundBalanceReportAsText ropts where bigtable = case map (subreportAsTable ropts) subreports of - [] -> Tab.empty + [] -> Table (T.pack <$> noneH) (T.pack <$> noneH) [[]] :: Table T.Text T.Text RenderText r:rs -> foldl' (concatTables DoubleLine) r rs bigtable' | no_total_ ropts || length subreports == 1 = bigtable | otherwise = let totalrows = multiBalanceRowAsTableText ropts netrow - rh = Tab.Group NoLine $ map Header ("Net:" : replicate (length totalrows - 1) "") - ch = Header [] -- ignored - in ((concatTables Tab.DoubleLine) bigtable $ Table rh ch totalrows) + rh = fullSepH NoLine (repeat $ headerColumn left Nothing) . map T.pack $ "Net:" : replicate (length totalrows - 1) "" + ch = noneH -- ignored + in (concatTables DoubleLine bigtable $ Table rh ch totalrows) -- | 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 ropts (title, r, _) = t where -- convert to table Table lefthdrs tophdrs cells = balanceReportAsTable ropts r -- tweak the layout - t = Table (Tab.Group Tab.SingleLine [Tab.Header title, lefthdrs]) tophdrs (replicate (length $ headerContents tophdrs) mempty : cells) + t = Table (groupH SingleLine [headerH (headerColumn left Nothing) title, lefthdrs]) tophdrs (replicate (length $ headerContents tophdrs) mempty : cells) -- | Render a compound balance report as CSV. -- Subreports' CSV is concatenated, with the headings rows replaced by a diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 8bd1588e472..3bae9771ea1 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -163,7 +163,6 @@ library , shakespeare >=2.0.2.2 , split >=0.1 , table-layout >=0.9.1.0 - , tabular >=0.2 , tasty >=1.2.3 , temporary , text >=0.11 @@ -213,7 +212,6 @@ executable hledger , shakespeare >=2.0.2.2 , split >=0.1 , table-layout >=0.9.1.0 - , tabular >=0.2 , tasty >=1.2.3 , temporary , text >=0.11 @@ -264,7 +262,6 @@ test-suite unittest , shakespeare >=2.0.2.2 , split >=0.1 , table-layout >=0.9.1.0 - , tabular >=0.2 , tasty >=1.2.3 , temporary , text >=0.11 @@ -314,7 +311,6 @@ benchmark bench , shakespeare >=2.0.2.2 , split >=0.1 , table-layout >=0.9.1.0 - , tabular >=0.2 , tasty >=1.2.3 , temporary , text >=0.11 diff --git a/hledger/package.yaml b/hledger/package.yaml index 13760dc8f22..ff507f3bac6 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -121,7 +121,6 @@ dependencies: - split >=0.1 - math-functions >=0.3.3.0 - table-layout >=0.9.1.0 -- tabular >=0.2 - tasty >=1.2.3 - temporary - text >=0.11 From 2f41a1b8740835482939c2a74b138fa6647a88d6 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 26 Apr 2022 01:32:01 +1000 Subject: [PATCH 8/8] 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 +- 12 files changed, 145 insertions(+), 215 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 f7fbfe337ca..85a2377410b 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', 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 diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index ce6856aefce..f9b96169d44 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 @@ -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 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 a7be4043414..fb520fd8f0a 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -27,6 +27,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) @@ -215,10 +216,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 $ attrName "list" <> attrName "balance" <> attrName "negative") $ txt a | otherwise = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "positive") $ txt a diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 5de24d72464..4ca995d61db 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 $ attrName "list" <> attrName "amount" <> attrName "decrease" | otherwise = sel $ attrName "list" <> attrName "amount" <> attrName "increase" balattr | T.any (=='-') balanceAmt = sel $ attrName "list" <> attrName "balance" <> attrName "negative" @@ -423,6 +424,8 @@ rsHandle ev = do isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just "" +maxAmountWidth = 32 + rsCenterAndContinue ui = do scrollSelectionToMiddle $ rsList $ aScreen ui put ui diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 4e9e5700f34..9d21e3b4b7f 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -45,6 +45,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 @@ -149,13 +150,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 5ef31c6655c..5c404b1c132 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.3.19 , 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 493fda8a376..68f6f9871af 100644 --- a/hledger-ui/package.yaml +++ b/hledger-ui/package.yaml @@ -70,6 +70,7 @@ dependencies: - process >=1.2 - safe >=0.3.19 - 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