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

lib: Expand Tabular.AsciiWide to allow multiline cells, either top or bottom aligned.

Browse Source
This commit is contained in:
Stephen Morgan 2020-11-03 22:31:02 +11:00
parent dcb884c5ff
commit a620ab9666
5 changed files with 179 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

@ -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
renderColumns :: TableOpts -- ^ rendering options for the table
-> [Int] -- ^ max width for each column
-> Header CellSpec
-> Header Cell
-> String
renderColumns borders pretty is h = addBorders coreLine
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
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
-- 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

71
hledger-lib/Text/WideString.hs Normal file
View File

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

5
hledger-lib/hledger-lib.cabal
View File

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

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

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