diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 94ca4f52a..cd5c12d33 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -26,6 +26,7 @@ module Hledger.Reports.BudgetReport ( where import Data.Decimal +import Data.Default (def) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import Data.List @@ -214,7 +215,8 @@ combineBudgetAndActual ropts j budgetReportAsText :: ReportOpts -> BudgetReport -> String budgetReportAsText ropts@ReportOpts{..} budgetr = title ++ "\n\n" ++ - renderTable False pretty_tables_ leftCell rightCell (uncurry showcell) displayTableWithWidths + renderTable def{tableBorders=False,prettyTable=pretty_tables_} + (alignCell TopLeft) (alignCell TopRight) (uncurry showcell) displayTableWithWidths where multiperiod = interval_ /= NoInterval title = printf "Budget performance in %s%s:" @@ -252,11 +254,9 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = cols = transpose displaycells -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells - showcell :: (Int, Int, Int) -> BudgetDisplayCell -> CellSpec + showcell :: (Int, Int, Int) -> BudgetDisplayCell -> Cell showcell (actualwidth, budgetwidth, percentwidth) ((actual,wa), mbudget) = - CellSpec (replicate (actualwidth - wa) ' ' ++ actual ++ budgetstr) - AlignRight - (actualwidth + totalbudgetwidth) + Cell TopRight [(replicate (actualwidth - wa) ' ' ++ actual ++ budgetstr, actualwidth + totalbudgetwidth)] where totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5 totalbudgetwidth = if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3 diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs index b2bdff2fa..29dcd5e98 100644 --- a/hledger-lib/Text/Tabular/AsciiWide.hs +++ b/hledger-lib/Text/Tabular/AsciiWide.hs @@ -3,30 +3,66 @@ module Text.Tabular.AsciiWide where +import Data.Maybe (fromMaybe) +import Data.Default (Default(..)) import Data.List (intersperse, transpose) +import Safe (maximumMay) import Text.Tabular -import Hledger.Utils.String +import Text.WideString (strWidth) + + +-- | 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 [(String, Int)] + deriving (Show) + +-- | 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. +alignCell :: Align -> String -> Cell +alignCell a x = Cell a [(x, strWidth x)] + +-- | Return the width of a Cell. +cellWidth :: Cell -> Int +cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map snd xs -- | 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 True pretty (rightCell . fr) (rightCell . fc) (rightCell . f) +render pretty fr fc f = renderTable def{prettyTable=pretty} (cell . fr) (cell . fc) (cell . f) + where cell = alignCell TopRight -- | 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 +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 -> String -renderTable borders pretty fr fc f (Table rh ch cells) = +renderTable topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (Table rh ch cells) = unlines . addBorders $ - renderColumns borders pretty sizes ch2 + renderColumns topts sizes ch2 : bar VM DoubleLine -- +======================================+ : renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders) where - renderR (cs,h) = renderColumns borders pretty sizes $ Group DoubleLine + renderR (cs,h) = renderColumns topts sizes $ Group DoubleLine [ Header h , fmap fst $ zipHeader emptyCell cs colHeaders ] @@ -40,7 +76,7 @@ renderTable borders pretty fr fc f (Table rh ch cells) = cells2 = headerContents ch2 : zipWith (:) (headerContents rowHeaders) cellContents -- maximum width for each column - sizes = map (maximum . map csWidth) $ transpose cells2 + sizes = map (fromMaybe 0 . maximumMay . map cellWidth) $ transpose cells2 renderRs (Header s) = [s] renderRs (Group p hs) = concat . intersperse sep $ map renderRs hs where sep = renderHLine VM borders pretty sizes ch2 p @@ -49,59 +85,64 @@ renderTable borders pretty fr fc f (Table rh ch cells) = addBorders xs = if borders then bar VT SingleLine : xs ++ [bar VB SingleLine] else xs bar vpos prop = concat $ renderHLine vpos borders pretty sizes ch2 prop - -data CellSpec = CellSpec - { csString :: String - , csAlign :: Align - , csWidth :: Int - } deriving (Show) - -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 - deriving (Show) +-- | Render a single row according to cell specifications. +renderRow :: TableOpts -> Header Cell -> String +renderRow topts h = renderColumns topts is h + where is = map (\(Cell _ xs) -> fromMaybe 0 . maximumMay $ map snd xs) $ headerContents h verticalBar :: Bool -> Char verticalBar pretty = if pretty then '│' else '|' -leftBar :: Bool -> String -leftBar pretty = verticalBar pretty : " " +leftBar :: Bool -> Bool -> String +leftBar pretty True = verticalBar pretty : " " +leftBar pretty False = [verticalBar pretty] -rightBar :: Bool -> String -rightBar pretty = " " ++ [verticalBar pretty] +rightBar :: Bool -> Bool -> String +rightBar pretty True = ' ' : [verticalBar pretty] +rightBar pretty False = [verticalBar pretty] -midBar :: Bool -> String -midBar pretty = " " ++ verticalBar pretty : " " +midBar :: Bool -> Bool -> String +midBar pretty True = ' ' : verticalBar pretty : " " +midBar pretty False = [verticalBar pretty] -doubleMidBar :: Bool -> String -doubleMidBar pretty = if pretty then " ║ " else " || " +doubleMidBar :: Bool -> Bool -> String +doubleMidBar pretty True = if pretty then " ║ " else " || " +doubleMidBar pretty False = if pretty then "║" else "||" -- | We stop rendering on the shortest list! -renderColumns :: Bool -- ^ show outer borders - -> Bool -- ^ pretty - -> [Int] -- ^ max width for each column - -> Header CellSpec +renderColumns :: TableOpts -- ^ rendering options for the table + -> [Int] -- ^ max width for each column + -> Header Cell -> String -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 (\(w, cs) -> case csAlign cs of - AlignLeft -> csString cs ++ replicate (w - csWidth cs) ' ' - AlignRight -> replicate (w - csWidth cs) ' ' ++ csString cs - ) - hsep :: Properties -> String - hsep NoLine = " " - hsep SingleLine = midBar pretty - hsep DoubleLine = doubleMidBar pretty +renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=spaces} is h = + concat . intersperse "\n" -- Put each line on its own line + . map (addBorders . concat) . 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,xw) -> x ++ replicate (w - xw) ' ') ls + padCell (w, Cell BottomLeft ls) = map (\(x,xw) -> x ++ replicate (w - xw) ' ') ls + padCell (w, Cell TopRight ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls + padCell (w, Cell BottomRight ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls + + -- Pad each cell to have the same number of lines + padRow (Cell TopLeft ls) = Cell TopLeft $ ls ++ replicate (nLines - length ls) ("",0) + padRow (Cell TopRight ls) = Cell TopRight $ ls ++ replicate (nLines - length ls) ("",0) + padRow (Cell BottomLeft ls) = Cell BottomLeft $ replicate (nLines - length ls) ("",0) ++ ls + padRow (Cell BottomRight ls) = Cell BottomRight $ replicate (nLines - length ls) ("",0) ++ ls + + hsep :: Properties -> [String] + 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 = ' ' : xs ++ " " + | otherwise = xs + + nLines = fromMaybe 0 . maximumMay . map (\(Cell _ ls) -> length ls) $ headerContents h renderHLine :: VPos -> Bool -- ^ show outer borders diff --git a/hledger-lib/Text/WideString.hs b/hledger-lib/Text/WideString.hs new file mode 100644 index 000000000..5ed38217f --- /dev/null +++ b/hledger-lib/Text/WideString.hs @@ -0,0 +1,71 @@ +-- | Calculate the width of String and Text, being aware of wide characters. + +module Text.WideString ( + -- * wide-character-aware layout + strWidth, + textWidth, + charWidth + ) where + +import Data.Text (Text) +import qualified Data.Text as T + + +-- | Calculate the render width of a string, considering +-- wide characters (counted as double width) +strWidth :: String -> Int +strWidth = foldr (\a b -> charWidth a + b) 0 + +-- | Calculate the render width of a string, considering +-- wide characters (counted as double width) +textWidth :: Text -> Int +textWidth = T.foldr (\a b -> charWidth a + b) 0 + +-- from Pandoc (copyright John MacFarlane, GPL) +-- see also http://unicode.org/reports/tr11/#Description + +-- | Get the designated render width of a character: 0 for a combining +-- character, 1 for a regular character, 2 for a wide character. +-- (Wide characters are rendered as exactly double width in apps and +-- fonts that support it.) (From Pandoc.) +charWidth :: Char -> Int +charWidth c + | c < '\x0300' = 1 + | c >= '\x0300' && c <= '\x036F' = 0 -- combining + | c >= '\x0370' && c <= '\x10FC' = 1 + | c >= '\x1100' && c <= '\x115F' = 2 + | c >= '\x1160' && c <= '\x11A2' = 1 + | c >= '\x11A3' && c <= '\x11A7' = 2 + | c >= '\x11A8' && c <= '\x11F9' = 1 + | c >= '\x11FA' && c <= '\x11FF' = 2 + | c >= '\x1200' && c <= '\x2328' = 1 + | c >= '\x2329' && c <= '\x232A' = 2 + | c >= '\x232B' && c <= '\x2E31' = 1 + | c >= '\x2E80' && c <= '\x303E' = 2 + | c == '\x303F' = 1 + | c >= '\x3041' && c <= '\x3247' = 2 + | c >= '\x3248' && c <= '\x324F' = 1 -- ambiguous + | c >= '\x3250' && c <= '\x4DBF' = 2 + | c >= '\x4DC0' && c <= '\x4DFF' = 1 + | c >= '\x4E00' && c <= '\xA4C6' = 2 + | c >= '\xA4D0' && c <= '\xA95F' = 1 + | c >= '\xA960' && c <= '\xA97C' = 2 + | c >= '\xA980' && c <= '\xABF9' = 1 + | c >= '\xAC00' && c <= '\xD7FB' = 2 + | c >= '\xD800' && c <= '\xDFFF' = 1 + | c >= '\xE000' && c <= '\xF8FF' = 1 -- ambiguous + | c >= '\xF900' && c <= '\xFAFF' = 2 + | c >= '\xFB00' && c <= '\xFDFD' = 1 + | c >= '\xFE00' && c <= '\xFE0F' = 1 -- ambiguous + | c >= '\xFE10' && c <= '\xFE19' = 2 + | c >= '\xFE20' && c <= '\xFE26' = 1 + | c >= '\xFE30' && c <= '\xFE6B' = 2 + | c >= '\xFE70' && c <= '\xFEFF' = 1 + | c >= '\xFF01' && c <= '\xFF60' = 2 + | c >= '\xFF61' && c <= '\x16A38' = 1 + | c >= '\x1B000' && c <= '\x1B001' = 2 + | c >= '\x1D000' && c <= '\x1F1FF' = 1 + | c >= '\x1F200' && c <= '\x1F251' = 2 + | c >= '\x1F300' && c <= '\x1F773' = 1 + | c >= '\x20000' && c <= '\x3FFFD' = 2 + | otherwise = 1 diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index f40a7eedc..2358fac11 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -1,10 +1,10 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack -- --- hash: a604ce23a128bb6cf15351a33b24e7d1095f46624e7e066a5e07473c681da8da +-- hash: 24b8acde4649dda5e31d86c9f4f95744af97bae68f0e978144a55baf621d0bc8 name: hledger-lib version: 1.19.99 @@ -103,6 +103,7 @@ library Text.Tabular.AsciiWide other-modules: Text.Megaparsec.Custom + Text.WideString Paths_hledger_lib hs-source-dirs: ./. diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 9a3ad7869..fd50fbd62 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -253,8 +253,9 @@ module Hledger.Cli.Commands.Balance ( ,tests_Balance ) where -import Data.List -import Data.Maybe +import Data.Default (def) +import Data.List (intercalate, transpose) +import Data.Maybe (fromMaybe, maybeToList) --import qualified Data.Map as Map import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -608,10 +609,10 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_} -- unless --no-elide is used. balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String balanceReportTableAsText ReportOpts{..} = - T.renderTable False pretty_tables_ T.leftCell T.rightCell showamt + T.renderTable def{tableBorders=False, prettyTable=pretty_tables_} + (T.alignCell TopLeft) (T.alignCell TopRight) showamt where - showamt a = CellSpec str AlignRight w - where (str, w) = showMixedOneLine showAmountWithoutPrice Nothing mmax color_ a + showamt = Cell TopRight . pure . showMixedOneLine showAmountWithoutPrice Nothing mmax color_ mmax = if no_elide_ then Nothing else Just 32