cli:Render pretty line-art tables with smooth borders
This commit is contained in:
Eric Mertens
Simon Michael
parent
3dce879731
commit
011a864deb
@ -16,14 +16,14 @@ render :: Bool -- ^ pretty tables
|
||||
-> Table rh ch a
|
||||
-> String
|
||||
render pretty fr fc f (Table rh ch cells) =
|
||||
unlines $ [ bar SingleLine -- +--------------------------------------+
|
||||
unlines $ [ bar VT SingleLine -- +--------------------------------------+
|
||||
, renderColumns pretty sizes ch2
|
||||
, bar DoubleLine -- +======================================+
|
||||
, bar VM DoubleLine -- +======================================+
|
||||
] ++
|
||||
(renderRs $ fmap renderR $ zipHeader [] cells $ fmap fr rh) ++
|
||||
[ bar SingleLine ] -- +--------------------------------------+
|
||||
[ bar VB SingleLine ] -- +--------------------------------------+
|
||||
where
|
||||
bar = concat . renderHLine pretty sizes ch2
|
||||
bar vpos prop = concat (renderHLine vpos pretty sizes ch2 prop)
|
||||
-- ch2 and cell2 include the row and column labels
|
||||
ch2 = Group DoubleLine [Header "", fmap fc ch]
|
||||
cells2 = headerContents ch2
|
||||
@ -37,7 +37,7 @@ render pretty fr fc f (Table rh ch cells) =
|
||||
sizes = map (maximum . map strWidth) . transpose $ cells2
|
||||
renderRs (Header s) = [s]
|
||||
renderRs (Group p hs) = concat . intersperse sep . map renderRs $ hs
|
||||
where sep = renderHLine pretty sizes ch2 p
|
||||
where sep = renderHLine VM pretty sizes ch2 p
|
||||
|
||||
verticalBar :: Bool -> Char
|
||||
verticalBar pretty = if pretty then '│' else '|'
|
||||
@ -54,12 +54,6 @@ midBar pretty = " " ++ verticalBar pretty : " "
|
||||
doubleMidBar :: Bool -> String
|
||||
doubleMidBar pretty = if pretty then " ║ " else " || "
|
||||
|
||||
horizontalBar :: Bool -> Char
|
||||
horizontalBar pretty = if pretty then '─' else '-'
|
||||
|
||||
doubleHorizontalBar :: Bool -> Char
|
||||
doubleHorizontalBar pretty = if pretty then '═' else '='
|
||||
|
||||
-- | We stop rendering on the shortest list!
|
||||
renderColumns :: Bool -- ^ pretty
|
||||
-> [Int] -- ^ max width for each column
|
||||
@ -74,27 +68,102 @@ renderColumns pretty is h = leftBar pretty ++ coreLine ++ rightBar pretty
|
||||
hsep SingleLine = midBar pretty
|
||||
hsep DoubleLine = doubleMidBar pretty
|
||||
|
||||
renderHLine :: Bool -- ^ pretty
|
||||
renderHLine :: VPos
|
||||
-> Bool -- ^ pretty
|
||||
-> [Int] -- ^ width specifications
|
||||
-> Header String
|
||||
-> Properties
|
||||
-> [String]
|
||||
renderHLine _ _ _ NoLine = []
|
||||
renderHLine pretty w h SingleLine = [renderHLine' pretty SingleLine w (horizontalBar pretty) h]
|
||||
renderHLine pretty w h DoubleLine = [renderHLine' pretty DoubleLine w (doubleHorizontalBar pretty) h]
|
||||
renderHLine _ _ _ _ NoLine = []
|
||||
renderHLine vpos pretty w h prop = [renderHLine' vpos pretty prop w h]
|
||||
|
||||
renderHLine' :: Bool -> Properties -> [Int] -> Char -> Header String -> String
|
||||
renderHLine' pretty prop is sep h = edge ++ sep : coreLine ++ sep : edge
|
||||
renderHLine' :: VPos -> Bool -> Properties -> [Int] -> Header String -> String
|
||||
renderHLine' vpos pretty prop is h = edge HL ++ sep ++ coreLine ++ sep ++ edge HR
|
||||
where
|
||||
edge = cross SingleLine prop
|
||||
edge hpos = boxchar vpos hpos SingleLine prop pretty
|
||||
coreLine = concatMap helper $ flattenHeader $ zipHeader 0 is h
|
||||
helper = either vsep dashes
|
||||
dashes (i,_) = replicate i sep
|
||||
vsep v = sep : cross v prop ++ [sep]
|
||||
dashes (i,_) = concat (replicate i sep)
|
||||
sep = boxchar vpos HM NoLine prop pretty
|
||||
vsep v = sep ++ cross v prop ++ sep
|
||||
cross v h = boxchar vpos HM v h pretty
|
||||
|
||||
-- vertical horizontal
|
||||
cross SingleLine SingleLine = if pretty then "┼" else "+"
|
||||
cross SingleLine DoubleLine = if pretty then "╪" else "+"
|
||||
cross DoubleLine SingleLine = if pretty then "╫" else "++"
|
||||
cross DoubleLine DoubleLine = if pretty then "╬" else "++"
|
||||
cross _ _ = ""
|
||||
data VPos = VT | VM | VB -- top middle bottom
|
||||
data HPos = HL | HM | HR -- left middle right
|
||||
|
||||
boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> String
|
||||
boxchar vpos hpos vert horiz = lineart u d l r
|
||||
where
|
||||
u =
|
||||
case vpos of
|
||||
VT -> NoLine
|
||||
_ -> vert
|
||||
d =
|
||||
case vpos of
|
||||
VB -> NoLine
|
||||
_ -> vert
|
||||
l =
|
||||
case hpos of
|
||||
HL -> NoLine
|
||||
_ -> horiz
|
||||
r =
|
||||
case hpos of
|
||||
HR -> NoLine
|
||||
_ -> horiz
|
||||
|
||||
pick :: String -> String -> Bool -> String
|
||||
pick x _ True = x
|
||||
pick _ x False = x
|
||||
|
||||
lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> String
|
||||
-- up down left right
|
||||
lineart SingleLine SingleLine SingleLine SingleLine = pick "┼" "+"
|
||||
lineart SingleLine SingleLine SingleLine NoLine = pick "┤" "+"
|
||||
lineart SingleLine SingleLine NoLine SingleLine = pick "├" "+"
|
||||
lineart SingleLine NoLine SingleLine SingleLine = pick "┴" "+"
|
||||
lineart NoLine SingleLine SingleLine SingleLine = pick "┬" "+"
|
||||
lineart SingleLine NoLine NoLine SingleLine = pick "└" "+"
|
||||
lineart SingleLine NoLine SingleLine NoLine = pick "┘" "+"
|
||||
lineart NoLine SingleLine SingleLine NoLine = pick "┐" "+"
|
||||
lineart NoLine SingleLine NoLine SingleLine = pick "┌" "+"
|
||||
lineart SingleLine SingleLine NoLine NoLine = pick "│" "|"
|
||||
lineart NoLine NoLine SingleLine SingleLine = pick "─" "-"
|
||||
|
||||
lineart DoubleLine DoubleLine DoubleLine DoubleLine = pick "╬" "++"
|
||||
lineart DoubleLine DoubleLine DoubleLine NoLine = pick "╣" "++"
|
||||
lineart DoubleLine DoubleLine NoLine DoubleLine = pick "╠" "++"
|
||||
lineart DoubleLine NoLine DoubleLine DoubleLine = pick "╩" "++"
|
||||
lineart NoLine DoubleLine DoubleLine DoubleLine = pick "╦" "++"
|
||||
lineart DoubleLine NoLine NoLine DoubleLine = pick "╚" "++"
|
||||
lineart DoubleLine NoLine DoubleLine NoLine = pick "╝" "++"
|
||||
lineart NoLine DoubleLine DoubleLine NoLine = pick "╗" "++"
|
||||
lineart NoLine DoubleLine NoLine DoubleLine = pick "╔" "++"
|
||||
lineart DoubleLine DoubleLine NoLine NoLine = pick "║" "||"
|
||||
lineart NoLine NoLine DoubleLine DoubleLine = pick "═" "="
|
||||
|
||||
lineart DoubleLine NoLine NoLine SingleLine = pick "╙" "++"
|
||||
lineart DoubleLine NoLine SingleLine NoLine = pick "╜" "++"
|
||||
lineart NoLine DoubleLine SingleLine NoLine = pick "╖" "++"
|
||||
lineart NoLine DoubleLine NoLine SingleLine = pick "╓" "++"
|
||||
|
||||
lineart SingleLine NoLine NoLine DoubleLine = pick "╘" "+"
|
||||
lineart SingleLine NoLine DoubleLine NoLine = pick "╛" "+"
|
||||
lineart NoLine SingleLine DoubleLine NoLine = pick "╕" "+"
|
||||
lineart NoLine SingleLine NoLine DoubleLine = pick "╒" "+"
|
||||
|
||||
lineart DoubleLine DoubleLine SingleLine NoLine = pick "╢" "++"
|
||||
lineart DoubleLine DoubleLine NoLine SingleLine = pick "╟" "++"
|
||||
lineart DoubleLine NoLine SingleLine SingleLine = pick "╨" "++"
|
||||
lineart NoLine DoubleLine SingleLine SingleLine = pick "╥" "++"
|
||||
|
||||
lineart SingleLine SingleLine DoubleLine NoLine = pick "╡" "+"
|
||||
lineart SingleLine SingleLine NoLine DoubleLine = pick "╞" "+"
|
||||
lineart SingleLine NoLine DoubleLine DoubleLine = pick "╧" "+"
|
||||
lineart NoLine SingleLine DoubleLine DoubleLine = pick "╤" "+"
|
||||
|
||||
lineart SingleLine SingleLine DoubleLine DoubleLine = pick "╪" "+"
|
||||
lineart DoubleLine DoubleLine SingleLine SingleLine = pick "╫" "++"
|
||||
|
||||
lineart _ _ _ _ = const ""
|
||||
|
||||
--
|
||||
|
||||
Loading…
Reference in New Issue
Block a user