diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 4523ea9e2..882a3d4a5 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -44,6 +44,7 @@ import qualified Data.Text as T --import Lucid as L import Text.Printf (printf) import Text.Tabular as T +import Text.Tabular.AsciiWide as T import Hledger.Data import Hledger.Utils @@ -209,8 +210,9 @@ combineBudgetAndActual ropts j -- | Render a budget report as plain text suitable for console output. budgetReportAsText :: ReportOpts -> BudgetReport -> String budgetReportAsText ropts@ReportOpts{..} budgetr = - title ++ "\n\n" ++ - tableAsText ropts showcell (maybetranspose $ budgetReportAsTable ropts budgetr) + title ++ "\n\n" ++ + renderTable False pretty_tables_ leftCell rightCell showcell + (maybetranspose $ budgetReportAsTable ropts budgetr) where multiperiod = interval_ /= NoInterval title = printf "Budget performance in %s%s:" @@ -232,8 +234,8 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = where amountWidth = maybe 0 (length . showMixedAmountElided False) -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells - showcell :: BudgetCell -> String - showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr + showcell :: BudgetCell -> CellSpec + showcell (mactual, mbudget) = rightCell $ actualstr ++ " " ++ budgetstr where percentwidth = 4 actual = fromMaybe 0 mactual diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 242a0b2a3..17e186b4e 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -19,10 +19,6 @@ module Hledger.Reports.MultiBalanceReport ( compoundBalanceReport, compoundBalanceReportWith, - tableAsText, - trimBorder, - leftAlignRowHeaders, - sortRows, sortRowsLike, @@ -56,8 +52,6 @@ import Data.Semigroup ((<>)) import Data.Semigroup (sconcat) import Data.Time.Calendar (Day, addDays, fromGregorian) import Safe (headMay, lastDef, lastMay) -import Text.Tabular as T -import Text.Tabular.AsciiWide (render) import Hledger.Data import Hledger.Query @@ -596,22 +590,6 @@ dbg' s = let p = "multiBalanceReport" in Hledger.Utils.dbg4 (p++" "++s) dbg'' s = let p = "multiBalanceReport" in Hledger.Utils.dbg5 (p++" "++s) -- dbg = const id -- exclude this function from debug output --- common rendering helper, XXX here for now -tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String -tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell = - trimBorder - . render pretty id id showcell - . leftAlignRowHeaders - -trimBorder :: String -> String -trimBorder = unlines . map (drop 1 . init) . drop 1 . init . lines - -leftAlignRowHeaders :: Table String ch a -> Table String ch a -leftAlignRowHeaders (Table l t d) = Table l' t d - where - acctswidth = maximum' $ map strWidth (headerContents l) - l' = padRightWide acctswidth <$> l - -- tests tests_MultiBalanceReport = tests "MultiBalanceReport" [ diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs index 46cf66c70..245a6b9e9 100644 --- a/hledger-lib/Text/Tabular/AsciiWide.hs +++ b/hledger-lib/Text/Tabular/AsciiWide.hs @@ -8,38 +8,60 @@ import Text.Tabular import Hledger.Utils.String +-- | Render a table according to common options, for backwards compatibility render :: Bool -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String -render pretty fr fc f = renderTable pretty fr fc (\a -> let str = f a in (str, strWidth str)) +render pretty fr fc f = renderTable True pretty (rightCell . fr) (rightCell . fc) (rightCell . f) -renderTable :: Bool -- ^ pretty tables - -> (rh -> String) - -> (ch -> String) - -> (a -> (String, Int)) -- ^ Function determining the string and width of a cell +-- | Render a table according to various cell specifications +renderTable :: Bool -- ^ Whether to display the outer borders + -> Bool -- ^ Pretty tables + -> (rh -> CellSpec) -- ^ Rendering function for row headers + -> (ch -> CellSpec) -- ^ Rendering function for column headers + -> (a -> CellSpec) -- ^ Function determining the string and width of a cell -> Table rh ch a -> String -renderTable pretty fr fc f (Table rh ch cells) = - unlines $ [ bar VT SingleLine -- +--------------------------------------+ - , renderColumns pretty sizes ch2 - , bar VM DoubleLine -- +======================================+ - ] ++ - (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++ - [ bar VB SingleLine ] -- +--------------------------------------+ +renderTable borders pretty fr fc f (Table rh ch cells) = + unlines . addBorders $ + [ renderColumns borders pretty sizes ch2 + , bar VM DoubleLine -- +======================================+ + ] ++ + (renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) where - bar vpos prop = concat (renderHLine vpos pretty sizes ch2 prop) + bar vpos prop = concat $ renderHLine vpos borders pretty sizes ch2 prop -- ch2 and cell2 include the row and column labels - ch2 = Group DoubleLine [Header "", fmap fc ch] - cells2 = map (\h -> (h, strWidth h)) (headerContents ch2) - : zipWith (\h cs -> (h, strWidth h) : map f cs) rhStrings cells + ch2 = Group DoubleLine [Header emptyCell, fmap fc ch] + cells2 = headerContents ch2 + : zipWith (\h cs -> h : map f cs) rhStrings cells -- - renderR (cs,h) = renderColumns pretty sizes $ Group DoubleLine + renderR (cs,h) = renderColumns borders pretty sizes $ Group DoubleLine [ Header h - , fmap fst $ zipHeader "" (map (fst . f) cs) ch] + , fmap fst $ zipHeader emptyCell (map f cs) ch] rhStrings = map fr $ headerContents rh -- maximum width for each column - sizes = map (maximum . map snd) $ transpose cells2 + sizes = map (maximum . map csWidth) $ transpose cells2 renderRs (Header s) = [s] renderRs (Group p hs) = concat . intersperse sep $ map renderRs hs - where sep = renderHLine VM pretty sizes ch2 p + where sep = renderHLine VM borders pretty sizes ch2 p + addBorders xs = if borders then bar VT SingleLine : xs ++ [bar VB SingleLine] else xs + + +data CellSpec = CellSpec + { csString :: String + , csAlign :: Align + , csWidth :: Int + } + +emptyCell :: CellSpec +emptyCell = CellSpec "" AlignRight 0 + +rightCell :: String -> CellSpec +rightCell x = CellSpec x AlignRight (strWidth x) + +leftCell :: String -> CellSpec +leftCell x = CellSpec x AlignLeft (strWidth x) + +data Align = AlignLeft | AlignRight + verticalBar :: Bool -> Char verticalBar pretty = if pretty then '│' else '|' @@ -57,31 +79,38 @@ doubleMidBar :: Bool -> String doubleMidBar pretty = if pretty then " ║ " else " || " -- | We stop rendering on the shortest list! -renderColumns :: Bool -- ^ pretty - -> [Int] -- ^ max width for each column - -> Header String +renderColumns :: Bool -- ^ show outer borders + -> Bool -- ^ pretty + -> [Int] -- ^ max width for each column + -> Header CellSpec -> String -renderColumns pretty is h = leftBar pretty ++ coreLine ++ rightBar pretty +renderColumns borders pretty is h = addBorders coreLine where + addBorders xs = if borders then leftBar pretty ++ xs ++ rightBar pretty else ' ' : xs ++ " " coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h - helper = either hsep (uncurry padLeftWide) + helper = either hsep (\(w, cs) -> case csAlign cs of + AlignLeft -> padRightWide w (csString cs) + AlignRight -> padLeftWide w (csString cs) + ) hsep :: Properties -> String hsep NoLine = " " hsep SingleLine = midBar pretty hsep DoubleLine = doubleMidBar pretty renderHLine :: VPos + -> Bool -- ^ show outer borders -> Bool -- ^ pretty -> [Int] -- ^ width specifications - -> Header String + -> Header a -> Properties -> [String] -renderHLine _ _ _ _ NoLine = [] -renderHLine vpos pretty w h prop = [renderHLine' vpos pretty prop w h] +renderHLine _ _ _ _ _ NoLine = [] +renderHLine vpos borders pretty w h prop = [renderHLine' vpos borders pretty prop w h] -renderHLine' :: VPos -> Bool -> Properties -> [Int] -> Header String -> String -renderHLine' vpos pretty prop is h = edge HL ++ sep ++ coreLine ++ sep ++ edge HR +renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> String +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 = concatMap helper $ flattenHeader $ zipHeader 0 is h helper = either vsep dashes diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 2057ee1af..ad4846ab0 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -263,7 +263,7 @@ import System.Console.CmdArgs.Explicit as C import Lucid as L import Text.Printf (printf) import Text.Tabular as T -import Text.Tabular.AsciiWide (renderWidth) +import Text.Tabular.AsciiWide as T import Hledger import Hledger.Cli.CliOptions @@ -610,9 +610,10 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_} -- unless --no-elide is used. balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String balanceReportTableAsText ReportOpts{..} = - trimBorder . renderWidth pretty_tables_ id id showamt . leftAlignRowHeaders + T.renderTable False pretty_tables_ T.leftCell T.rightCell showamt where - showamt = showMixedOneLine showAmountWithoutPrice Nothing mmax color_ + showamt a = CellSpec str AlignRight w + where (str, w) = showMixedOneLine showAmountWithoutPrice Nothing mmax color_ a mmax = if no_elide_ then Nothing else Just 22