From 13c111da7380a16df3e75eb7a367aeab1ce274fa Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Thu, 24 Dec 2020 11:18:25 +1100 Subject: [PATCH] lib,cli,ui: Use WideBuilder for Tabular.AsciiWide. Move WideBuilder to Text.WideString. --- hledger-lib/Hledger/Reports/BudgetReport.hs | 7 +++-- hledger-lib/Hledger/Utils/String.hs | 8 +++--- hledger-lib/Hledger/Utils/Text.hs | 22 ++------------- hledger-lib/Text/Tabular/AsciiWide.hs | 31 ++++++++++----------- hledger-lib/Text/WideString.hs | 29 ++++++++++++++++++- hledger-ui/Hledger/UI/RegisterScreen.hs | 2 +- hledger/Hledger/Cli/Commands/Balance.hs | 22 +++++++-------- 7 files changed, 65 insertions(+), 56 deletions(-) diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index a44b6010c..867fea59f 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -259,11 +259,14 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $ -- 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 -> Cell showcell (actualwidth, budgetwidth, percentwidth) ((actual,wa), mbudget) = - Cell TopRight [(T.replicate (actualwidth - wa) " " <> actual <> budgetstr, actualwidth + totalbudgetwidth)] + Cell TopRight [WideBuilder ( TB.fromText (T.replicate (actualwidth - wa) " ") + <> TB.fromText actual + <> budgetstr + ) (actualwidth + totalbudgetwidth)] where totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5 totalbudgetwidth = if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3 - budgetstr = case mbudget of + budgetstr = TB.fromText $ case mbudget of Nothing -> T.replicate totalbudgetwidth " " Just ((budget, wb), Nothing) -> " [" <> T.replicate totalpercentwidth " " <> T.replicate (budgetwidth - wb) " " <> budget <> "]" Just ((budget, wb), Just (pct, wp)) -> " [" <> T.replicate (percentwidth - wp) " " <> pct <> "% of " <> T.replicate (budgetwidth - wb) " " <> budget <> "]" diff --git a/hledger-lib/Hledger/Utils/String.hs b/hledger-lib/Hledger/Utils/String.hs index f397923b9..bdbe65402 100644 --- a/hledger-lib/Hledger/Utils/String.hs +++ b/hledger-lib/Hledger/Utils/String.hs @@ -64,8 +64,8 @@ import Text.Printf (printf) import Hledger.Utils.Parse import Hledger.Utils.Regex (toRegex', regexReplace) import Text.Tabular (Header(..), Properties(..)) -import Text.Tabular.AsciiWide (Align(..), Cell(..), TableOpts(..), renderRow) -import Text.WideString (charWidth, strWidth, textWidth) +import Text.Tabular.AsciiWide (Align(..), TableOpts(..), alignCell, renderRow) +import Text.WideString (charWidth, strWidth) -- | Take elements from the end of a list. @@ -188,14 +188,14 @@ unbracket s concatTopPadded :: [String] -> String concatTopPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False} . Group NoLine . map (Header . cell) - where cell = Cell BottomLeft . map (\x -> (x, textWidth x)) . T.lines . T.pack + where cell = alignCell BottomLeft . T.pack -- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded. -- Treats wide characters as double width. concatBottomPadded :: [String] -> String concatBottomPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False} . Group NoLine . map (Header . cell) - where cell = Cell TopLeft . map (\x -> (x, textWidth x)) . T.lines . T.pack + where cell = alignCell TopLeft . T.pack -- | Join multi-line strings horizontally, after compressing each of diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index 78438d0c7..35c5d12b8 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -47,6 +47,7 @@ module Hledger.Utils.Text fitText, -- -- * wide-character-aware layout WideBuilder(..), + wbToText, wbUnpack, textWidth, textTakeWidth, @@ -68,32 +69,13 @@ import Data.Monoid #endif 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.Parsec -- import Text.Printf (printf) -- import Hledger.Utils.Parse -- import Hledger.Utils.Regex import Hledger.Utils.Test -import Text.WideString (charWidth, textWidth) - - --- | Helper for constructing Builders while keeping track of text width. -data WideBuilder = WideBuilder - { wbBuilder :: !TB.Builder - , wbWidth :: !Int - } - -instance Semigroup WideBuilder where - WideBuilder x i <> WideBuilder y j = WideBuilder (x <> y) (i + j) - -instance Monoid WideBuilder where - mempty = WideBuilder mempty 0 - --- | Unpack a WideBuilder to a String. -wbUnpack :: WideBuilder -> String -wbUnpack = TL.unpack . TB.toLazyText . wbBuilder +import Text.WideString (WideBuilder(..), wbToText, wbUnpack, charWidth, textWidth) -- lowercase, uppercase :: String -> String diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs index 2bc3ede4f..b222403b6 100644 --- a/hledger-lib/Text/Tabular/AsciiWide.hs +++ b/hledger-lib/Text/Tabular/AsciiWide.hs @@ -15,7 +15,7 @@ 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 (textWidth) +import Text.WideString (WideBuilder(..), textWidth) -- | The options to use for rendering a table. @@ -32,8 +32,7 @@ instance Default TableOpts where } -- | Cell contents along an alignment -data Cell = Cell Align [(Text, Int)] - deriving (Show) +data Cell = Cell Align [WideBuilder] -- | How to align text in a cell data Align = TopRight | BottomRight | BottomLeft | TopLeft @@ -44,11 +43,11 @@ emptyCell = Cell TopRight [] -- | Create a single-line cell from the given contents with its natural width. alignCell :: Align -> Text -> Cell -alignCell a x = Cell a [(x, textWidth x)] +alignCell a x = Cell a . map (\x -> WideBuilder (fromText x) (textWidth x)) $ if T.null x then [""] else T.lines x -- | Return the width of a Cell. cellWidth :: Cell -> Int -cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map snd xs +cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map wbWidth xs -- | Render a table according to common options, for backwards compatibility @@ -57,7 +56,7 @@ render pretty fr fc f = renderTable def{prettyTable=pretty} (cell . fr) (cell . where cell = alignCell TopRight -- | Render a table according to various cell specifications> -renderTable :: TableOpts -- ^ Options controlling Table rendering +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 @@ -66,7 +65,7 @@ renderTable :: TableOpts -- ^ Options controlling Table rendering 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 +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 @@ -109,7 +108,7 @@ 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 (\(Cell _ xs) -> fromMaybe 0 . maximumMay $ map snd xs) $ headerContents h + where is = map cellWidth $ headerContents h verticalBar :: Bool -> Char @@ -143,16 +142,16 @@ renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=s . 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) -> fromText x <> fromText (T.replicate (w - xw) " ")) ls - padCell (w, Cell BottomLeft ls) = map (\(x,xw) -> fromText x <> fromText (T.replicate (w - xw) " ")) ls - padCell (w, Cell TopRight ls) = map (\(x,xw) -> fromText (T.replicate (w - xw) " ") <> fromText x) ls - padCell (w, Cell BottomRight ls) = map (\(x,xw) -> fromText (T.replicate (w - xw) " ") <> fromText x) ls + 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) ("",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 + 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 "" diff --git a/hledger-lib/Text/WideString.hs b/hledger-lib/Text/WideString.hs index 5ed38217f..eb2d7e491 100644 --- a/hledger-lib/Text/WideString.hs +++ b/hledger-lib/Text/WideString.hs @@ -4,11 +4,38 @@ module Text.WideString ( -- * wide-character-aware layout strWidth, textWidth, - charWidth + charWidth, + -- * Text Builders which keep track of length + WideBuilder(..), + wbUnpack, + wbToText ) where 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 + + +-- | Helper for constructing Builders while keeping track of text width. +data WideBuilder = WideBuilder + { wbBuilder :: !TB.Builder + , wbWidth :: !Int + } + +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 WideBuilder to a String. +wbUnpack :: WideBuilder -> String +wbUnpack = TL.unpack . TB.toLazyText . wbBuilder -- | Calculate the render width of a string, considering diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 04a6e0d36..29d945d0a 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -97,7 +97,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec ,rsItemBalanceAmount = showamt bal ,rsItemTransaction = t } - where showamt = \((WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w)) + where showamt = (\wb -> (wbUnpack wb, wbWidth wb)) . showMixed oneLine{displayMaxWidth=Just 32} -- 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. diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index d58006fb1..2bb2ddd0a 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -420,27 +420,25 @@ renderBalanceReportItem opts (acctname, depth, total) = , map cellWidth is ) render topaligned oneline = map (maybeConcat . renderComponent topaligned opts (acctname, depth, total)) - where maybeConcat (Cell a xs) = if oneline then Cell a [(T.intercalate ", " strs, width)] - else Cell a xs - where - (strs, ws) = unzip xs - width = sumStrict (map (+2) ws) -2 + where maybeConcat (Cell a xs) = + if oneline then Cell a [WideBuilder (mconcat . intersperse (TB.fromText ", ") $ map wbBuilder xs) width] + else Cell a xs + where width = sumStrict (map ((+2) . wbWidth) xs) -2 -- | Render one StringFormat component for a balance report item. renderComponent :: Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell -renderComponent _ _ _ (FormatLiteral s) = Cell TopLeft . map (\x -> (x, textWidth x)) $ T.lines s +renderComponent _ _ _ (FormatLiteral s) = alignCell TopLeft s renderComponent topaligned opts (acctname, depth, total) (FormatField ljust mmin mmax field) = case field of - DepthSpacerField -> Cell align [(T.replicate d " ", d)] + DepthSpacerField -> Cell align [WideBuilder (TB.fromText $ T.replicate d " ") d] where d = maybe id min mmax $ depth * fromMaybe 1 mmin - AccountField -> Cell align [(t, textWidth t)] where t = formatText ljust mmin mmax acctname + AccountField -> alignCell align $ formatText ljust mmin mmax acctname TotalField -> Cell align . pure $ showamt total - _ -> Cell align [("", 0)] + _ -> Cell align [mempty] where align = if topaligned then (if ljust then TopLeft else TopRight) else (if ljust then BottomLeft else BottomRight) - showamt = (\(WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w)) - . showMixed noPrice{displayColour=color_ opts, displayMinWidth=mmin, displayMaxWidth=mmax} + showamt = showMixed noPrice{displayColour=color_ opts, displayMinWidth=mmin, displayMaxWidth=mmax} -- rendering multi-column balance reports @@ -629,7 +627,7 @@ balanceReportTableAsText ReportOpts{..} = Tab.renderTableB def{tableBorders=False, prettyTable=pretty_tables_} (Tab.alignCell TopLeft) (Tab.alignCell TopRight) showamt where - showamt = Cell TopRight . (\(WideBuilder b w) -> [(TL.toStrict $ TB.toLazyText b, w)]) . showMixed oneLine{displayColour=color_, displayMaxWidth=mmax} + showamt = Cell TopRight . pure . showMixed oneLine{displayColour=color_, displayMaxWidth=mmax} mmax = if no_elide_ then Nothing else Just 32