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 Text.WideString (strWidth)
data TableOpts = TableOpts
{ TableOpts -> Bool
prettyTable :: Bool
, TableOpts -> Bool
tableBorders :: Bool
, TableOpts -> Bool
borderSpaces :: Bool
} deriving (Int -> TableOpts -> ShowS
[TableOpts] -> ShowS
TableOpts -> String
(Int -> TableOpts -> ShowS)
-> (TableOpts -> String)
-> ([TableOpts] -> ShowS)
-> Show TableOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableOpts] -> ShowS
$cshowList :: [TableOpts] -> ShowS
show :: TableOpts -> String
$cshow :: TableOpts -> String
showsPrec :: Int -> TableOpts -> ShowS
$cshowsPrec :: Int -> TableOpts -> ShowS
Show)
instance Default TableOpts where
def :: TableOpts
def = TableOpts :: Bool -> Bool -> Bool -> TableOpts
TableOpts { prettyTable :: Bool
prettyTable = Bool
False
, tableBorders :: Bool
tableBorders = Bool
True
, borderSpaces :: Bool
borderSpaces = Bool
True
}
data Cell = Cell Align [(String, Int)]
deriving (Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show)
data Align = TopRight | BottomRight | BottomLeft | TopLeft
deriving (Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
(Int -> Align -> ShowS)
-> (Align -> String) -> ([Align] -> ShowS) -> Show Align
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Align] -> ShowS
$cshowList :: [Align] -> ShowS
show :: Align -> String
$cshow :: Align -> String
showsPrec :: Int -> Align -> ShowS
$cshowsPrec :: Int -> Align -> ShowS
Show)
emptyCell :: Cell
emptyCell :: Cell
emptyCell = Align -> [(String, Int)] -> Cell
Cell Align
TopRight []
alignCell :: Align -> String -> Cell
alignCell :: Align -> String -> Cell
alignCell Align
a String
x = Align -> [(String, Int)] -> Cell
Cell Align
a [(String
x, String -> Int
strWidth String
x)]
cellWidth :: Cell -> Int
cellWidth :: Cell -> Int
cellWidth (Cell Align
_ [(String, Int)]
xs) = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> ([Int] -> Maybe Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
maximumMay ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd [(String, Int)]
xs
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 Bool
pretty rh -> String
fr ch -> String
fc a -> String
f = TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> String
forall rh ch a.
TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> String
renderTable TableOpts
forall a. Default a => a
def{prettyTable :: Bool
prettyTable=Bool
pretty} (String -> Cell
cell (String -> Cell) -> (rh -> String) -> rh -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rh -> String
fr) (String -> Cell
cell (String -> Cell) -> (ch -> String) -> ch -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ch -> String
fc) (String -> Cell
cell (String -> Cell) -> (a -> String) -> a -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
f)
where cell :: String -> Cell
cell = Align -> String -> Cell
alignCell Align
TopRight
renderTable :: TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> String
renderTable :: TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> String
renderTable topts :: TableOpts
topts@TableOpts{prettyTable :: TableOpts -> Bool
prettyTable=Bool
pretty, tableBorders :: TableOpts -> Bool
tableBorders=Bool
borders} rh -> Cell
fr ch -> Cell
fc a -> Cell
f (Table Header rh
rh Header ch
ch [[a]]
cells) =
[String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
addBorders ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
TableOpts -> [Int] -> Header Cell -> String
renderColumns TableOpts
topts [Int]
sizes Header Cell
ch2
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: VPos -> Properties -> String
bar VPos
VM Properties
DoubleLine
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Header String -> [String]
renderRs ((([Cell], Cell) -> String)
-> Header ([Cell], Cell) -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Cell], Cell) -> String
renderR (Header ([Cell], Cell) -> Header String)
-> Header ([Cell], Cell) -> Header String
forall a b. (a -> b) -> a -> b
$ [Cell] -> [[Cell]] -> Header Cell -> Header ([Cell], Cell)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader [] [[Cell]]
cellContents Header Cell
rowHeaders)
where
renderR :: ([Cell], Cell) -> String
renderR ([Cell]
cs,Cell
h) = TableOpts -> [Int] -> Header Cell -> String
renderColumns TableOpts
topts [Int]
sizes (Header Cell -> String) -> Header Cell -> String
forall a b. (a -> b) -> a -> b
$ Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
DoubleLine
[ Cell -> Header Cell
forall h. h -> Header h
Header Cell
h
, ((Cell, Cell) -> Cell) -> Header (Cell, Cell) -> Header Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Cell, Cell) -> Cell
forall a b. (a, b) -> a
fst (Header (Cell, Cell) -> Header Cell)
-> Header (Cell, Cell) -> Header Cell
forall a b. (a -> b) -> a -> b
$ Cell -> [Cell] -> Header Cell -> Header (Cell, Cell)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Cell
emptyCell [Cell]
cs Header Cell
colHeaders
]
rowHeaders :: Header Cell
rowHeaders = (rh -> Cell) -> Header rh -> Header Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap rh -> Cell
fr Header rh
rh
colHeaders :: Header Cell
colHeaders = (ch -> Cell) -> Header ch -> Header Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ch -> Cell
fc Header ch
ch
cellContents :: [[Cell]]
cellContents = ([a] -> [Cell]) -> [[a]] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Cell) -> [a] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map a -> Cell
f) [[a]]
cells
ch2 :: Header Cell
ch2 = Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
DoubleLine [Cell -> Header Cell
forall h. h -> Header h
Header Cell
emptyCell, Header Cell
colHeaders]
cells2 :: [[Cell]]
cells2 = Header Cell -> [Cell]
forall h. Header h -> [h]
headerContents Header Cell
ch2 [Cell] -> [[Cell]] -> [[Cell]]
forall a. a -> [a] -> [a]
: (Cell -> [Cell] -> [Cell]) -> [Cell] -> [[Cell]] -> [[Cell]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (:) (Header Cell -> [Cell]
forall h. Header h -> [h]
headerContents Header Cell
rowHeaders) [[Cell]]
cellContents
sizes :: [Int]
sizes = ([Cell] -> Int) -> [[Cell]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> ([Cell] -> Maybe Int) -> [Cell] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
maximumMay ([Int] -> Maybe Int) -> ([Cell] -> [Int]) -> [Cell] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell -> Int) -> [Cell] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Int
cellWidth) ([[Cell]] -> [Int]) -> [[Cell]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Cell]] -> [[Cell]]
forall a. [[a]] -> [[a]]
transpose [[Cell]]
cells2
renderRs :: Header String -> [String]
renderRs (Header String
s) = [String
s]
renderRs (Group Properties
p [Header String]
hs) = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> ([[String]] -> [[String]]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
intersperse [String]
sep ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (Header String -> [String]) -> [Header String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Header String -> [String]
renderRs [Header String]
hs
where sep :: [String]
sep = VPos
-> Bool -> Bool -> [Int] -> Header Cell -> Properties -> [String]
forall a.
VPos -> Bool -> Bool -> [Int] -> Header a -> Properties -> [String]
renderHLine VPos
VM Bool
borders Bool
pretty [Int]
sizes Header Cell
ch2 Properties
p
addBorders :: [String] -> [String]
addBorders [String]
xs = if Bool
borders then VPos -> Properties -> String
bar VPos
VT Properties
SingleLine String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [VPos -> Properties -> String
bar VPos
VB Properties
SingleLine] else [String]
xs
bar :: VPos -> Properties -> String
bar VPos
vpos Properties
prop = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ VPos
-> Bool -> Bool -> [Int] -> Header Cell -> Properties -> [String]
forall a.
VPos -> Bool -> Bool -> [Int] -> Header a -> Properties -> [String]
renderHLine VPos
vpos Bool
borders Bool
pretty [Int]
sizes Header Cell
ch2 Properties
prop
renderRow :: TableOpts -> Header Cell -> String
renderRow :: TableOpts -> Header Cell -> String
renderRow TableOpts
topts Header Cell
h = TableOpts -> [Int] -> Header Cell -> String
renderColumns TableOpts
topts [Int]
is Header Cell
h
where is :: [Int]
is = (Cell -> Int) -> [Cell] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Cell Align
_ [(String, Int)]
xs) -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> ([Int] -> Maybe Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
maximumMay ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd [(String, Int)]
xs) ([Cell] -> [Int]) -> [Cell] -> [Int]
forall a b. (a -> b) -> a -> b
$ Header Cell -> [Cell]
forall h. Header h -> [h]
headerContents Header Cell
h
verticalBar :: Bool -> Char
verticalBar :: Bool -> Char
verticalBar Bool
pretty = if Bool
pretty then Char
'│' else Char
'|'
leftBar :: Bool -> Bool -> String
leftBar :: Bool -> Bool -> String
leftBar Bool
pretty Bool
True = Bool -> Char
verticalBar Bool
pretty Char -> ShowS
forall a. a -> [a] -> [a]
: String
" "
leftBar Bool
pretty Bool
False = [Bool -> Char
verticalBar Bool
pretty]
rightBar :: Bool -> Bool -> String
rightBar :: Bool -> Bool -> String
rightBar Bool
pretty Bool
True = Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: [Bool -> Char
verticalBar Bool
pretty]
rightBar Bool
pretty Bool
False = [Bool -> Char
verticalBar Bool
pretty]
midBar :: Bool -> Bool -> String
midBar :: Bool -> Bool -> String
midBar Bool
pretty Bool
True = Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> Char
verticalBar Bool
pretty Char -> ShowS
forall a. a -> [a] -> [a]
: String
" "
midBar Bool
pretty Bool
False = [Bool -> Char
verticalBar Bool
pretty]
doubleMidBar :: Bool -> Bool -> String
doubleMidBar :: Bool -> Bool -> String
doubleMidBar Bool
pretty Bool
True = if Bool
pretty then String
" ║ " else String
" || "
doubleMidBar Bool
pretty Bool
False = if Bool
pretty then String
"║" else String
"||"
renderColumns :: TableOpts
-> [Int]
-> Header Cell
-> String
renderColumns :: TableOpts -> [Int] -> Header Cell -> String
renderColumns TableOpts{prettyTable :: TableOpts -> Bool
prettyTable=Bool
pretty, tableBorders :: TableOpts -> Bool
tableBorders=Bool
borders, borderSpaces :: TableOpts -> Bool
borderSpaces=Bool
spaces} [Int]
is Header Cell
h =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> (Header Cell -> [String]) -> Header Cell -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n"
([String] -> [String])
-> (Header Cell -> [String]) -> Header Cell -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
addBorders ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[String]] -> [String])
-> (Header Cell -> [[String]]) -> Header Cell -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose
([[String]] -> [[String]])
-> (Header Cell -> [[String]]) -> Header Cell -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Properties (Int, Cell) -> [String])
-> [Either Properties (Int, Cell)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((Properties -> [String])
-> ((Int, Cell) -> [String])
-> Either Properties (Int, Cell)
-> [String]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> [String]
hsep (Int, Cell) -> [String]
padCell) ([Either Properties (Int, Cell)] -> [[String]])
-> (Header Cell -> [Either Properties (Int, Cell)])
-> Header Cell
-> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (Int, Cell) -> [Either Properties (Int, Cell)]
forall h. Header h -> [Either Properties h]
flattenHeader
(Header (Int, Cell) -> [Either Properties (Int, Cell)])
-> (Header Cell -> Header (Int, Cell))
-> Header Cell
-> [Either Properties (Int, Cell)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> Header Cell -> Header (Int, Cell)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Int
0 [Int]
is (Header Cell -> String) -> Header Cell -> String
forall a b. (a -> b) -> a -> b
$ Cell -> Cell
padRow (Cell -> Cell) -> Header Cell -> Header Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Header Cell
h
where
padCell :: (Int, Cell) -> [String]
padCell (Int
w, Cell Align
TopLeft [(String, Int)]
ls) = ((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,Int
xw) -> String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xw) Char
' ') [(String, Int)]
ls
padCell (Int
w, Cell Align
BottomLeft [(String, Int)]
ls) = ((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,Int
xw) -> String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xw) Char
' ') [(String, Int)]
ls
padCell (Int
w, Cell Align
TopRight [(String, Int)]
ls) = ((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,Int
xw) -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xw) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x) [(String, Int)]
ls
padCell (Int
w, Cell Align
BottomRight [(String, Int)]
ls) = ((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,Int
xw) -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xw) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x) [(String, Int)]
ls
padRow :: Cell -> Cell
padRow (Cell Align
TopLeft [(String, Int)]
ls) = Align -> [(String, Int)] -> Cell
Cell Align
TopLeft ([(String, Int)] -> Cell) -> [(String, Int)] -> Cell
forall a b. (a -> b) -> a -> b
$ [(String, Int)]
ls [(String, Int)] -> [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> (String, Int) -> [(String, Int)]
forall a. Int -> a -> [a]
replicate (Int
nLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(String, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
ls) (String
"",Int
0)
padRow (Cell Align
TopRight [(String, Int)]
ls) = Align -> [(String, Int)] -> Cell
Cell Align
TopRight ([(String, Int)] -> Cell) -> [(String, Int)] -> Cell
forall a b. (a -> b) -> a -> b
$ [(String, Int)]
ls [(String, Int)] -> [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> (String, Int) -> [(String, Int)]
forall a. Int -> a -> [a]
replicate (Int
nLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(String, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
ls) (String
"",Int
0)
padRow (Cell Align
BottomLeft [(String, Int)]
ls) = Align -> [(String, Int)] -> Cell
Cell Align
BottomLeft ([(String, Int)] -> Cell) -> [(String, Int)] -> Cell
forall a b. (a -> b) -> a -> b
$ Int -> (String, Int) -> [(String, Int)]
forall a. Int -> a -> [a]
replicate (Int
nLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(String, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
ls) (String
"",Int
0) [(String, Int)] -> [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a] -> [a]
++ [(String, Int)]
ls
padRow (Cell Align
BottomRight [(String, Int)]
ls) = Align -> [(String, Int)] -> Cell
Cell Align
BottomRight ([(String, Int)] -> Cell) -> [(String, Int)] -> Cell
forall a b. (a -> b) -> a -> b
$ Int -> (String, Int) -> [(String, Int)]
forall a. Int -> a -> [a]
replicate (Int
nLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(String, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
ls) (String
"",Int
0) [(String, Int)] -> [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a] -> [a]
++ [(String, Int)]
ls
hsep :: Properties -> [String]
hsep :: Properties -> [String]
hsep Properties
NoLine = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
nLines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ if Bool
spaces then String
" " else String
""
hsep Properties
SingleLine = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
nLines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> String
midBar Bool
pretty Bool
spaces
hsep Properties
DoubleLine = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
nLines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> String
doubleMidBar Bool
pretty Bool
spaces
addBorders :: ShowS
addBorders String
xs | Bool
borders = Bool -> Bool -> String
leftBar Bool
pretty Bool
spaces String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> String
rightBar Bool
pretty Bool
spaces
| Bool
spaces = Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
| Bool
otherwise = String
xs
nLines :: Int
nLines = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> ([Cell] -> Maybe Int) -> [Cell] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
maximumMay ([Int] -> Maybe Int) -> ([Cell] -> [Int]) -> [Cell] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell -> Int) -> [Cell] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Cell Align
_ [(String, Int)]
ls) -> [(String, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
ls) ([Cell] -> Int) -> [Cell] -> Int
forall a b. (a -> b) -> a -> b
$ Header Cell -> [Cell]
forall h. Header h -> [h]
headerContents Header Cell
h
renderHLine :: VPos
-> Bool
-> Bool
-> [Int]
-> Header a
-> Properties
-> [String]
renderHLine :: VPos -> Bool -> Bool -> [Int] -> Header a -> Properties -> [String]
renderHLine VPos
_ Bool
_ Bool
_ [Int]
_ Header a
_ Properties
NoLine = []
renderHLine VPos
vpos Bool
borders Bool
pretty [Int]
w Header a
h Properties
prop = [VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> String
forall a.
VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> String
renderHLine' VPos
vpos Bool
borders Bool
pretty Properties
prop [Int]
w Header a
h]
renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> String
renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> String
renderHLine' VPos
vpos Bool
borders Bool
pretty Properties
prop [Int]
is Header a
h = ShowS
addBorders ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
sep String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
coreLine String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep
where
addBorders :: ShowS
addBorders String
xs = if Bool
borders then HPos -> String
edge HPos
HL String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ HPos -> String
edge HPos
HR else String
xs
edge :: HPos -> String
edge HPos
hpos = VPos -> HPos -> Properties -> Properties -> Bool -> String
boxchar VPos
vpos HPos
hpos Properties
SingleLine Properties
prop Bool
pretty
coreLine :: String
coreLine = (Either Properties (Int, a) -> String)
-> [Either Properties (Int, a)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either Properties (Int, a) -> String
forall b. Either Properties (Int, b) -> String
helper ([Either Properties (Int, a)] -> String)
-> [Either Properties (Int, a)] -> String
forall a b. (a -> b) -> a -> b
$ Header (Int, a) -> [Either Properties (Int, a)]
forall h. Header h -> [Either Properties h]
flattenHeader (Header (Int, a) -> [Either Properties (Int, a)])
-> Header (Int, a) -> [Either Properties (Int, a)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> Header a -> Header (Int, a)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Int
0 [Int]
is Header a
h
helper :: Either Properties (Int, b) -> String
helper = (Properties -> String)
-> ((Int, b) -> String) -> Either Properties (Int, b) -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> String
vsep (Int, b) -> String
forall b. (Int, b) -> String
dashes
dashes :: (Int, b) -> String
dashes (Int
i,b
_) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
i String
sep)
sep :: String
sep = VPos -> HPos -> Properties -> Properties -> Bool -> String
boxchar VPos
vpos HPos
HM Properties
NoLine Properties
prop Bool
pretty
vsep :: Properties -> String
vsep Properties
v = case Properties
v of
Properties
NoLine -> String
sep String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep
Properties
_ -> String
sep String -> ShowS
forall a. [a] -> [a] -> [a]
++ Properties -> Properties -> String
cross Properties
v Properties
prop String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep
cross :: Properties -> Properties -> String
cross Properties
v Properties
h = VPos -> HPos -> Properties -> Properties -> Bool -> String
boxchar VPos
vpos HPos
HM Properties
v Properties
h Bool
pretty
data VPos = VT | VM | VB
data HPos = HL | HM | HR
boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> String
boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> String
boxchar VPos
vpos HPos
hpos Properties
vert Properties
horiz = Properties
-> Properties -> Properties -> Properties -> Bool -> String
lineart Properties
u Properties
d Properties
l Properties
r
where
u :: Properties
u =
case VPos
vpos of
VPos
VT -> Properties
NoLine
VPos
_ -> Properties
vert
d :: Properties
d =
case VPos
vpos of
VPos
VB -> Properties
NoLine
VPos
_ -> Properties
vert
l :: Properties
l =
case HPos
hpos of
HPos
HL -> Properties
NoLine
HPos
_ -> Properties
horiz
r :: Properties
r =
case HPos
hpos of
HPos
HR -> Properties
NoLine
HPos
_ -> Properties
horiz
pick :: String -> String -> Bool -> String
pick :: String -> String -> Bool -> String
pick String
x String
_ Bool
True = String
x
pick String
_ String
x Bool
False = String
x
lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> String
lineart :: Properties
-> Properties -> Properties -> Properties -> Bool -> String
lineart Properties
SingleLine Properties
SingleLine Properties
SingleLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"┼" String
"+"
lineart Properties
SingleLine Properties
SingleLine Properties
SingleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"┤" String
"+"
lineart Properties
SingleLine Properties
SingleLine Properties
NoLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"├" String
"+"
lineart Properties
SingleLine Properties
NoLine Properties
SingleLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"┴" String
"+"
lineart Properties
NoLine Properties
SingleLine Properties
SingleLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"┬" String
"+"
lineart Properties
SingleLine Properties
NoLine Properties
NoLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"└" String
"+"
lineart Properties
SingleLine Properties
NoLine Properties
SingleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"┘" String
"+"
lineart Properties
NoLine Properties
SingleLine Properties
SingleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"┐" String
"+"
lineart Properties
NoLine Properties
SingleLine Properties
NoLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"┌" String
"+"
lineart Properties
SingleLine Properties
SingleLine Properties
NoLine Properties
NoLine = String -> String -> Bool -> String
pick String
"│" String
"|"
lineart Properties
NoLine Properties
NoLine Properties
SingleLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"─" String
"-"
lineart Properties
DoubleLine Properties
DoubleLine Properties
DoubleLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╬" String
"++"
lineart Properties
DoubleLine Properties
DoubleLine Properties
DoubleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"╣" String
"++"
lineart Properties
DoubleLine Properties
DoubleLine Properties
NoLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╠" String
"++"
lineart Properties
DoubleLine Properties
NoLine Properties
DoubleLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╩" String
"++"
lineart Properties
NoLine Properties
DoubleLine Properties
DoubleLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╦" String
"++"
lineart Properties
DoubleLine Properties
NoLine Properties
NoLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╚" String
"++"
lineart Properties
DoubleLine Properties
NoLine Properties
DoubleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"╝" String
"++"
lineart Properties
NoLine Properties
DoubleLine Properties
DoubleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"╗" String
"++"
lineart Properties
NoLine Properties
DoubleLine Properties
NoLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╔" String
"++"
lineart Properties
DoubleLine Properties
DoubleLine Properties
NoLine Properties
NoLine = String -> String -> Bool -> String
pick String
"║" String
"||"
lineart Properties
NoLine Properties
NoLine Properties
DoubleLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"═" String
"="
lineart Properties
DoubleLine Properties
NoLine Properties
NoLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"╙" String
"++"
lineart Properties
DoubleLine Properties
NoLine Properties
SingleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"╜" String
"++"
lineart Properties
NoLine Properties
DoubleLine Properties
SingleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"╖" String
"++"
lineart Properties
NoLine Properties
DoubleLine Properties
NoLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"╓" String
"++"
lineart Properties
SingleLine Properties
NoLine Properties
NoLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╘" String
"+"
lineart Properties
SingleLine Properties
NoLine Properties
DoubleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"╛" String
"+"
lineart Properties
NoLine Properties
SingleLine Properties
DoubleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"╕" String
"+"
lineart Properties
NoLine Properties
SingleLine Properties
NoLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╒" String
"+"
lineart Properties
DoubleLine Properties
DoubleLine Properties
SingleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"╢" String
"++"
lineart Properties
DoubleLine Properties
DoubleLine Properties
NoLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"╟" String
"++"
lineart Properties
DoubleLine Properties
NoLine Properties
SingleLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"╨" String
"++"
lineart Properties
NoLine Properties
DoubleLine Properties
SingleLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"╥" String
"++"
lineart Properties
SingleLine Properties
SingleLine Properties
DoubleLine Properties
NoLine = String -> String -> Bool -> String
pick String
"╡" String
"+"
lineart Properties
SingleLine Properties
SingleLine Properties
NoLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╞" String
"+"
lineart Properties
SingleLine Properties
NoLine Properties
DoubleLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╧" String
"+"
lineart Properties
NoLine Properties
SingleLine Properties
DoubleLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╤" String
"+"
lineart Properties
SingleLine Properties
SingleLine Properties
DoubleLine Properties
DoubleLine = String -> String -> Bool -> String
pick String
"╪" String
"+"
lineart Properties
DoubleLine Properties
DoubleLine Properties
SingleLine Properties
SingleLine = String -> String -> Bool -> String
pick String
"╫" String
"++"
lineart Properties
_ Properties
_ Properties
_ Properties
_ = String -> Bool -> String
forall a b. a -> b -> a
const String
""