-- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat
-- wide characters as double width.

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)


-- | The options to use for rendering a table.
data TableOpts = TableOpts
  { TableOpts -> Bool
prettyTable  :: Bool  -- ^ Pretty tables
  , TableOpts -> Bool
tableBorders :: Bool  -- ^ Whether to display the outer borders
  , TableOpts -> Bool
borderSpaces :: Bool  -- ^ Whether to display spaces around bars
  } 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
                  }

-- | Cell contents along an alignment
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)

-- | How to align text in a cell
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 []

-- | Create a single-line cell from the given contents with its natural width.
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)]

-- | Return the width of a Cell.
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 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 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

-- | Render a table according to various cell specifications
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 :: 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 and cell2 include the row and column labels
  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

  -- maximum width for each column
  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

  -- borders and bars
  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

-- | Render a single row according to cell specifications.
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
"||"

-- | We stop rendering on the shortest list!
renderColumns :: TableOpts  -- ^ rendering options for the table
              -> [Int]      -- ^ max width for each column
              -> 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"                    -- Put each line on its own line
    ([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      -- Change to a list of lines and add borders
    ([[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  -- We now have a matrix of strings
    (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  -- Pad cell height and add width marker
  where
    -- Pad each cell to have the appropriate width
    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

    -- Pad each cell to have the same number of lines
    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  -- ^ show outer borders
            -> Bool -- ^ pretty
            -> [Int] -- ^ width specifications
            -> 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 -- top middle bottom
data HPos = HL | HM | HR -- left middle right

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
--      up         down       left      right
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
""

--