From 38a1ee239f5c4ca5aeb46fa51500b7a2ac728a5b Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 29 Mar 2022 10:32:31 +1100 Subject: [PATCH] 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 | 20 +- 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, 83 insertions(+), 423 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 6bba6ad6aff7..7710cd36fa11 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 2cd06da4f1b6..c5b9d9bd5433 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 584e608d9fa7..0aea7109cd24 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -36,9 +36,9 @@ 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.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 @@ -232,21 +232,25 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $ <> ":" -- | Build a 'Table' from a multi-column balance report. -budgetReportAsTable :: ReportOpts -> BudgetReport -> Tab.Table Text Text (WideFormat) +budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text (WideFormat) 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 @@ -257,16 +261,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 d2979ab53000..f024f8ec4274 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -59,7 +59,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 @@ -594,8 +593,8 @@ cumulativeSum value start = snd . M.mapAccumWithKey accumValued start -- made using 'balanceReportAsTable'), render it in a format suitable for -- console output. Amounts with more than two commodities will be elided -- unless --no-elide is used. -balanceReportTableAsText :: ReportOpts -> Tab.Table T.Text T.Text WideFormat -> TB.Builder -balanceReportTableAsText ReportOpts{..} (Tab.Table rh ch cells) = +balanceReportTableAsText :: ReportOpts -> Table T.Text T.Text WideFormat -> TB.Builder +balanceReportTableAsText ReportOpts{..} (Table rh ch cells) = tableStringB colSpec style rowHeader colHeader (map rowG cells) <> TB.singleton '\n' where colSpec = case layout_ of @@ -604,13 +603,8 @@ balanceReportTableAsText ReportOpts{..} (Tab.Table rh ch cells) = where col pos = column expand pos noAlign noCutMark style = if pretty_ then hledgerPrettyStyle else hledgerStyle - rowHeader = translate left $ plainWide <$> rh - colHeader = translate right $ plainWide <$> 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 = plainWide <$> rh + colHeader = plainWide <$> ch -- | The 'TableStyle' used by hledger balance commands when using ascii characters. hledgerStyle :: TableStyle LineStyle LineStyle diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index ad50b6bb1e59..01ff966829df 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -39,12 +39,15 @@ module Hledger.Utils.Text linesPrepend2, unlinesB, -- * wide-character-aware layout + textTakeWidth, + -- ** table layout module Text.Layout.Table.Cell, module Text.Layout.Table.Cell.Formatted, module Text.Layout.Table.Cell.WideString, + Table(..), WideFormat, plainWide, - textTakeWidth, + concatTables, -- * Reading readDecimal, -- * tests @@ -232,6 +235,12 @@ linesPrepend2 prefix1 prefix2 s = T.unlines $ case T.lines s of 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]] + -- | An alias for formatted text measured by display length. type WideFormat = Formatted WideText @@ -239,6 +248,15 @@ type WideFormat = Formatted WideText plainWide :: Text -> WideFormat plainWide = plain . WideText +-- | 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 + + -- | Read a decimal number from a Text. Assumes the input consists only of digit -- characters. readDecimal :: Text -> Integer diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs deleted file mode 100644 index 9b6411830134..000000000000 --- 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 b31ae88f2b24..000000000000 --- 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 df96eb841116..dfd9a5815ab8 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -84,10 +84,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: ./ @@ -123,7 +121,6 @@ library , regex-tdfa , safe >=0.3.18 , table-layout >=0.9.1.0 - , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 , template-haskell @@ -175,7 +172,6 @@ test-suite doctest , regex-tdfa , safe >=0.3.18 , table-layout >=0.9.1.0 - , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 , template-haskell @@ -229,7 +225,6 @@ test-suite unittest , regex-tdfa , safe >=0.3.18 , 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 7701e89e3920..c59cbfa97dc3 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.18 -- tabular >=0.2 - table-layout >=0.9.1.0 - tasty >=1.2.3 - tasty-hunit >=0.10.0.2 @@ -138,7 +137,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 3260675793a5..9f78ee1b44ca 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -269,7 +269,6 @@ 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 import Hledger import Hledger.Cli.CliOptions @@ -647,21 +646,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 WideFormat +balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text WideFormat 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) @@ -672,14 +675,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 -> [[WideFormat]] -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 -> [[WideFormat]] +multiBalanceRowAsTableText opts = multiBalanceRowAsTableTextHelper oneLine{displayColour=color_ opts} opts [] + +multiBalanceRowAsTableTextHelper :: AmountDisplayOpts -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideFormat]] +multiBalanceRowAsTableTextHelper bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = case layout_ of LayoutWide width -> [fmap (showMixedAmountB bopts{displayMaxWidth=width}) allamts] LayoutTall -> paddedTranspose mempty @@ -706,22 +715,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 -> [[WideFormat]] -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 66e9aec69e36..c431233cdf8a 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 WideFormat 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 WideFormat 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 06cb3d8ba112..9000470c5d8b 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -165,7 +165,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 @@ -215,7 +214,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 @@ -266,7 +264,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 @@ -316,7 +313,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 672522e681bd..005ffe63e086 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