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

lib: Refactor Text.Tabular.AsciiWide to allow custom width specification in rendering.

Browse Source
This commit is contained in:
Stephen Morgan 2020-09-14 21:07:25 +10:00
parent 57d7b223a2
commit e50a8c0f34
1 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,15 +7,17 @@ import Data.List (intersperse, transpose)
import Text.Tabular import Text.Tabular
import Hledger.Utils.String import Hledger.Utils.String
-- | for simplicity, we assume that each cell is rendered
-- on a single line render :: Bool -> (rh -> String) -> (ch -> String) -> (a -> String) -> Table rh ch a -> String
render :: Bool -- ^ pretty tables render pretty fr fc f = renderTable pretty fr fc (\a -> let str = f a in (str, strWidth str))
renderTable :: Bool -- ^ pretty tables
-> (rh -> String) -> (rh -> String)
-> (ch -> String) -> (ch -> String)
-> (a -> String) -> (a -> (String, Int)) -- ^ Function determining the string and width of a cell
-> Table rh ch a -> Table rh ch a
-> String -> String
render pretty fr fc f (Table rh ch cells) = renderTable pretty fr fc f (Table rh ch cells) =
unlines $ [ bar VT SingleLine -- +--------------------------------------+ unlines $ [ bar VT SingleLine -- +--------------------------------------+
, renderColumns pretty sizes ch2 , renderColumns pretty sizes ch2
, bar VM DoubleLine -- +======================================+ , bar VM DoubleLine -- +======================================+
@ -26,17 +28,17 @@ render pretty fr fc f (Table rh ch cells) =
bar vpos prop = concat (renderHLine vpos pretty sizes ch2 prop) bar vpos prop = concat (renderHLine vpos pretty sizes ch2 prop)
-- ch2 and cell2 include the row and column labels -- ch2 and cell2 include the row and column labels
ch2 = Group DoubleLine [Header "", fmap fc ch] ch2 = Group DoubleLine [Header "", fmap fc ch]
cells2 = headerContents ch2 cells2 = map (\h -> (h, strWidth h)) (headerContents ch2)
: zipWith (\h cs -> h : map f cs) rhStrings cells : zipWith (\h cs -> (h, strWidth h) : map f cs) rhStrings cells
-- --
renderR (cs,h) = renderColumns pretty sizes $ Group DoubleLine renderR (cs,h) = renderColumns pretty sizes $ Group DoubleLine
[ Header h [ Header h
, fmap fst $ zipHeader "" (map f cs) ch] , fmap fst $ zipHeader "" (map (fst . f) cs) ch]
rhStrings = map fr $ headerContents rh rhStrings = map fr $ headerContents rh
-- maximum width for each column -- maximum width for each column
sizes = map (maximum . map strWidth) . transpose $ cells2 sizes = map (maximum . map snd) $ 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 pretty sizes ch2 p where sep = renderHLine VM pretty sizes ch2 p
verticalBar :: Bool -> Char verticalBar :: Bool -> Char