slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib,cli,ui: Use WideBuilder for Tabular.AsciiWide.

Browse Source 
Move WideBuilder to Text.WideString.
This commit is contained in:
Stephen Morgan 2020-12-24 11:18:25 +11:00
parent b9c00dce61
commit 13c111da73
7 changed files with 65 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -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 <> "]"

8
hledger-lib/Hledger/Utils/String.hs
View File

@ -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

22
hledger-lib/Hledger/Utils/Text.hs
View File

@ -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

31
hledger-lib/Text/Tabular/AsciiWide.hs
View File

@ -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 ""

29
hledger-lib/Text/WideString.hs
View File

@ -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

2
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -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.

22
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -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