mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-21 03:08:10 +03:00
lib: Expand Tabular.AsciiWide to allow multiline cells, either top or bottom aligned.
This commit is contained in:
parent
dcb884c5ff
commit
a620ab9666
@ -26,6 +26,7 @@ module Hledger.Reports.BudgetReport (
|
|||||||
where
|
where
|
||||||
|
|
||||||
import Data.Decimal
|
import Data.Decimal
|
||||||
|
import Data.Default (def)
|
||||||
import Data.HashMap.Strict (HashMap)
|
import Data.HashMap.Strict (HashMap)
|
||||||
import qualified Data.HashMap.Strict as HM
|
import qualified Data.HashMap.Strict as HM
|
||||||
import Data.List
|
import Data.List
|
||||||
@ -214,7 +215,8 @@ combineBudgetAndActual ropts j
|
|||||||
budgetReportAsText :: ReportOpts -> BudgetReport -> String
|
budgetReportAsText :: ReportOpts -> BudgetReport -> String
|
||||||
budgetReportAsText ropts@ReportOpts{..} budgetr =
|
budgetReportAsText ropts@ReportOpts{..} budgetr =
|
||||||
title ++ "\n\n" ++
|
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
|
where
|
||||||
multiperiod = interval_ /= NoInterval
|
multiperiod = interval_ /= NoInterval
|
||||||
title = printf "Budget performance in %s%s:"
|
title = printf "Budget performance in %s%s:"
|
||||||
@ -252,11 +254,9 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
|
|||||||
cols = transpose displaycells
|
cols = transpose displaycells
|
||||||
|
|
||||||
-- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells
|
-- 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) =
|
showcell (actualwidth, budgetwidth, percentwidth) ((actual,wa), mbudget) =
|
||||||
CellSpec (replicate (actualwidth - wa) ' ' ++ actual ++ budgetstr)
|
Cell TopRight [(replicate (actualwidth - wa) ' ' ++ actual ++ budgetstr, actualwidth + totalbudgetwidth)]
|
||||||
AlignRight
|
|
||||||
(actualwidth + totalbudgetwidth)
|
|
||||||
where
|
where
|
||||||
totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5
|
totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5
|
||||||
totalbudgetwidth = if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3
|
totalbudgetwidth = if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3
|
||||||
|
@ -3,30 +3,66 @@
|
|||||||
|
|
||||||
module Text.Tabular.AsciiWide where
|
module Text.Tabular.AsciiWide where
|
||||||
|
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Default (Default(..))
|
||||||
import Data.List (intersperse, transpose)
|
import Data.List (intersperse, transpose)
|
||||||
|
import Safe (maximumMay)
|
||||||
import Text.Tabular
|
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 a table according to common options, for backwards compatibility
|
||||||
render :: Bool -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String
|
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
|
-- | Render a table according to various cell specifications
|
||||||
renderTable :: Bool -- ^ Whether to display the outer borders
|
renderTable :: TableOpts -- ^ Options controlling Table rendering
|
||||||
-> Bool -- ^ Pretty tables
|
-> (rh -> Cell) -- ^ Rendering function for row headers
|
||||||
-> (rh -> CellSpec) -- ^ Rendering function for row headers
|
-> (ch -> Cell) -- ^ Rendering function for column headers
|
||||||
-> (ch -> CellSpec) -- ^ Rendering function for column headers
|
-> (a -> Cell) -- ^ Function determining the string and width of a cell
|
||||||
-> (a -> CellSpec) -- ^ Function determining the string and width of a cell
|
|
||||||
-> Table rh ch a
|
-> Table rh ch a
|
||||||
-> String
|
-> 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 $
|
unlines . addBorders $
|
||||||
renderColumns borders pretty sizes ch2
|
renderColumns topts sizes ch2
|
||||||
: bar VM DoubleLine -- +======================================+
|
: bar VM DoubleLine -- +======================================+
|
||||||
: renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders)
|
: renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders)
|
||||||
where
|
where
|
||||||
renderR (cs,h) = renderColumns borders pretty sizes $ Group DoubleLine
|
renderR (cs,h) = renderColumns topts sizes $ Group DoubleLine
|
||||||
[ Header h
|
[ Header h
|
||||||
, fmap fst $ zipHeader emptyCell cs colHeaders
|
, 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
|
cells2 = headerContents ch2 : zipWith (:) (headerContents rowHeaders) cellContents
|
||||||
|
|
||||||
-- maximum width for each column
|
-- 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 (Header s) = [s]
|
||||||
renderRs (Group p hs) = concat . intersperse sep $ map renderRs hs
|
renderRs (Group p hs) = concat . intersperse sep $ map renderRs hs
|
||||||
where sep = renderHLine VM borders pretty sizes ch2 p
|
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
|
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
|
bar vpos prop = concat $ renderHLine vpos borders pretty sizes ch2 prop
|
||||||
|
|
||||||
|
-- | Render a single row according to cell specifications.
|
||||||
data CellSpec = CellSpec
|
renderRow :: TableOpts -> Header Cell -> String
|
||||||
{ csString :: String
|
renderRow topts h = renderColumns topts is h
|
||||||
, csAlign :: Align
|
where is = map (\(Cell _ xs) -> fromMaybe 0 . maximumMay $ map snd xs) $ headerContents h
|
||||||
, 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)
|
|
||||||
|
|
||||||
|
|
||||||
verticalBar :: Bool -> Char
|
verticalBar :: Bool -> Char
|
||||||
verticalBar pretty = if pretty then '│' else '|'
|
verticalBar pretty = if pretty then '│' else '|'
|
||||||
|
|
||||||
leftBar :: Bool -> String
|
leftBar :: Bool -> Bool -> String
|
||||||
leftBar pretty = verticalBar pretty : " "
|
leftBar pretty True = verticalBar pretty : " "
|
||||||
|
leftBar pretty False = [verticalBar pretty]
|
||||||
|
|
||||||
rightBar :: Bool -> String
|
rightBar :: Bool -> Bool -> String
|
||||||
rightBar pretty = " " ++ [verticalBar pretty]
|
rightBar pretty True = ' ' : [verticalBar pretty]
|
||||||
|
rightBar pretty False = [verticalBar pretty]
|
||||||
|
|
||||||
midBar :: Bool -> String
|
midBar :: Bool -> Bool -> String
|
||||||
midBar pretty = " " ++ verticalBar pretty : " "
|
midBar pretty True = ' ' : verticalBar pretty : " "
|
||||||
|
midBar pretty False = [verticalBar pretty]
|
||||||
|
|
||||||
doubleMidBar :: Bool -> String
|
doubleMidBar :: Bool -> Bool -> String
|
||||||
doubleMidBar pretty = if pretty then " ║ " else " || "
|
doubleMidBar pretty True = if pretty then " ║ " else " || "
|
||||||
|
doubleMidBar pretty False = if pretty then "║" else "||"
|
||||||
|
|
||||||
-- | We stop rendering on the shortest list!
|
-- | We stop rendering on the shortest list!
|
||||||
renderColumns :: Bool -- ^ show outer borders
|
renderColumns :: TableOpts -- ^ rendering options for the table
|
||||||
-> Bool -- ^ pretty
|
-> [Int] -- ^ max width for each column
|
||||||
-> [Int] -- ^ max width for each column
|
-> Header Cell
|
||||||
-> Header CellSpec
|
|
||||||
-> String
|
-> String
|
||||||
renderColumns borders pretty is h = addBorders coreLine
|
renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=spaces} is h =
|
||||||
where
|
concat . intersperse "\n" -- Put each line on its own line
|
||||||
addBorders xs = if borders then leftBar pretty ++ xs ++ rightBar pretty else ' ' : xs ++ " "
|
. map (addBorders . concat) . transpose -- Change to a list of lines and add borders
|
||||||
coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h
|
. map (either hsep padCell) . flattenHeader -- We now have a matrix of strings
|
||||||
helper = either hsep (\(w, cs) -> case csAlign cs of
|
. zipHeader 0 is $ padRow <$> h -- Pad cell height and add width marker
|
||||||
AlignLeft -> csString cs ++ replicate (w - csWidth cs) ' '
|
where
|
||||||
AlignRight -> replicate (w - csWidth cs) ' ' ++ csString cs
|
-- Pad each cell to have the appropriate width
|
||||||
)
|
padCell (w, Cell TopLeft ls) = map (\(x,xw) -> x ++ replicate (w - xw) ' ') ls
|
||||||
hsep :: Properties -> String
|
padCell (w, Cell BottomLeft ls) = map (\(x,xw) -> x ++ replicate (w - xw) ' ') ls
|
||||||
hsep NoLine = " "
|
padCell (w, Cell TopRight ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls
|
||||||
hsep SingleLine = midBar pretty
|
padCell (w, Cell BottomRight ls) = map (\(x,xw) -> replicate (w - xw) ' ' ++ x) ls
|
||||||
hsep DoubleLine = doubleMidBar pretty
|
|
||||||
|
-- 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
|
renderHLine :: VPos
|
||||||
-> Bool -- ^ show outer borders
|
-> Bool -- ^ show outer borders
|
||||||
|
71
hledger-lib/Text/WideString.hs
Normal file
71
hledger-lib/Text/WideString.hs
Normal 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
|
@ -1,10 +1,10 @@
|
|||||||
cabal-version: 1.12
|
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
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: a604ce23a128bb6cf15351a33b24e7d1095f46624e7e066a5e07473c681da8da
|
-- hash: 24b8acde4649dda5e31d86c9f4f95744af97bae68f0e978144a55baf621d0bc8
|
||||||
|
|
||||||
name: hledger-lib
|
name: hledger-lib
|
||||||
version: 1.19.99
|
version: 1.19.99
|
||||||
@ -103,6 +103,7 @@ library
|
|||||||
Text.Tabular.AsciiWide
|
Text.Tabular.AsciiWide
|
||||||
other-modules:
|
other-modules:
|
||||||
Text.Megaparsec.Custom
|
Text.Megaparsec.Custom
|
||||||
|
Text.WideString
|
||||||
Paths_hledger_lib
|
Paths_hledger_lib
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
./.
|
./.
|
||||||
|
@ -253,8 +253,9 @@ module Hledger.Cli.Commands.Balance (
|
|||||||
,tests_Balance
|
,tests_Balance
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.List
|
import Data.Default (def)
|
||||||
import Data.Maybe
|
import Data.List (intercalate, transpose)
|
||||||
|
import Data.Maybe (fromMaybe, maybeToList)
|
||||||
--import qualified Data.Map as Map
|
--import qualified Data.Map as Map
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Lazy as TL
|
import qualified Data.Text.Lazy as TL
|
||||||
@ -608,10 +609,10 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
|
|||||||
-- unless --no-elide is used.
|
-- unless --no-elide is used.
|
||||||
balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String
|
balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String
|
||||||
balanceReportTableAsText ReportOpts{..} =
|
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
|
where
|
||||||
showamt a = CellSpec str AlignRight w
|
showamt = Cell TopRight . pure . showMixedOneLine showAmountWithoutPrice Nothing mmax color_
|
||||||
where (str, w) = showMixedOneLine showAmountWithoutPrice Nothing mmax color_ a
|
|
||||||
mmax = if no_elide_ then Nothing else Just 32
|
mmax = if no_elide_ then Nothing else Just 32
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user