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

{-# LANGUAGE OverloadedStrings #-}

module Text.Tabular.AsciiWide
( module Text.Tabular

, TableOpts(..)
, render
, renderTable
, renderTableB
, renderTableByRowsB
, renderRow
, renderRowB
, renderColumns

, Cell(..)
, Align(..)
, emptyCell
, textCell
, textsCell
, cellWidth
, concatTables
) where

import Data.Bifunctor (bimap)
import Data.Maybe (fromMaybe)
import Data.Default (Default(..))
import Data.List (intercalate, intersperse, transpose)
import Data.Semigroup (stimesMonoid)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText)
import Safe (maximumMay)
import Text.Tabular
import Text.WideString (WideBuilder(..), wbFromText)


-- | 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TableOpts] -> ShowS
$cshowList :: [TableOpts] -> ShowS
show :: TableOpts -> [Char]
$cshow :: TableOpts -> [Char]
showsPrec :: Int -> TableOpts -> ShowS
$cshowsPrec :: Int -> TableOpts -> ShowS
Show)

instance Default TableOpts where
  def :: TableOpts
def = 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 [WideBuilder]

-- | How to align text in a cell
data Align = TopRight | BottomRight | BottomLeft | TopLeft
  deriving (Int -> Align -> ShowS
[Align] -> ShowS
Align -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Align] -> ShowS
$cshowList :: [Align] -> ShowS
show :: Align -> [Char]
$cshow :: Align -> [Char]
showsPrec :: Int -> Align -> ShowS
$cshowsPrec :: Int -> Align -> ShowS
Show)

emptyCell :: Cell
emptyCell :: Cell
emptyCell = Align -> [WideBuilder] -> Cell
Cell Align
TopRight []

-- | Create a single-line cell from the given contents with its natural width.
textCell :: Align -> Text -> Cell
textCell :: Align -> Text -> Cell
textCell Align
a Text
x = Align -> [WideBuilder] -> Cell
Cell Align
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> WideBuilder
wbFromText forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
x then [Text
""] else Text -> [Text]
T.lines Text
x

-- | Create a multi-line cell from the given contents with its natural width.
textsCell :: Align -> [Text] -> Cell
textsCell :: Align -> [Text] -> Cell
textsCell Align
a = Align -> [WideBuilder] -> Cell
Cell Align
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> WideBuilder
wbFromText

-- | Return the width of a Cell.
cellWidth :: Cell -> Int
cellWidth :: Cell -> Int
cellWidth (Cell Align
_ [WideBuilder]
xs) = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Maybe a
maximumMay forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map WideBuilder -> Int
wbWidth [WideBuilder]
xs


-- | Render a table according to common options, for backwards compatibility
render :: Bool -> (rh -> Text) -> (ch -> Text) -> (a -> Text) -> Table rh ch a -> TL.Text
render :: forall rh ch a.
Bool
-> (rh -> Text)
-> (ch -> Text)
-> (a -> Text)
-> Table rh ch a
-> Text
render Bool
pretty rh -> Text
fr ch -> Text
fc a -> Text
f = forall rh ch a.
TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> Text
renderTable forall a. Default a => a
def{prettyTable :: Bool
prettyTable=Bool
pretty} (Text -> Cell
cell forall b c a. (b -> c) -> (a -> b) -> a -> c
. rh -> Text
fr) (Text -> Cell
cell forall b c a. (b -> c) -> (a -> b) -> a -> c
. ch -> Text
fc) (Text -> Cell
cell forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
f)
  where cell :: Text -> Cell
cell = Align -> Text -> Cell
textCell 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
            -> TL.Text
renderTable :: forall rh ch a.
TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> Text
renderTable TableOpts
topts rh -> Cell
fr ch -> Cell
fc a -> Cell
f = Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rh ch a.
TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> Builder
renderTableB TableOpts
topts rh -> Cell
fr ch -> Cell
fc a -> Cell
f

-- | A version of renderTable which returns the underlying Builder.
renderTableB :: 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
             -> Builder
renderTableB :: forall rh ch a.
TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> Builder
renderTableB TableOpts
topts rh -> Cell
fr ch -> Cell
fc a -> Cell
f = forall ch rh a.
TableOpts
-> ([ch] -> [Cell])
-> ((rh, [a]) -> (Cell, [Cell]))
-> Table rh ch a
-> Builder
renderTableByRowsB TableOpts
topts (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ch -> Cell
fc) forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap rh -> Cell
fr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Cell
f)

-- | A version of renderTable that operates on rows (including the 'row' of
-- column headers) and returns the underlying Builder.
renderTableByRowsB :: TableOpts      -- ^ Options controlling Table rendering
             -> ([ch] -> [Cell])     -- ^ Rendering function for column headers
             -> ((rh, [a]) -> (Cell, [Cell])) -- ^ Rendering function for row and row header
             -> Table rh ch a
             -> Builder
renderTableByRowsB :: forall ch rh a.
TableOpts
-> ([ch] -> [Cell])
-> ((rh, [a]) -> (Cell, [Cell]))
-> Table rh ch a
-> Builder
renderTableByRowsB topts :: TableOpts
topts@TableOpts{prettyTable :: TableOpts -> Bool
prettyTable=Bool
pretty, tableBorders :: TableOpts -> Bool
tableBorders=Bool
borders} [ch] -> [Cell]
fc (rh, [a]) -> (Cell, [Cell])
f (Table Header rh
rh Header ch
ch [[a]]
cells) =
   [Builder] -> Builder
unlinesB forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> [Builder]
addBorders forall a b. (a -> b) -> a -> b
$
     TableOpts -> [Int] -> Header Cell -> Builder
renderColumns TableOpts
topts [Int]
sizes Header Cell
ch2
     forall a. a -> [a] -> [a]
: VPos -> Properties -> Builder
bar VPos
VM Properties
DoubleLine   -- +======================================+
     forall a. a -> [a] -> [a]
: Header Builder -> [Builder]
renderRs (([Cell], Cell) -> Builder
renderR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader [] [[Cell]]
cellContents Header Cell
rowHeaders)
 where
  renderR :: ([Cell], Cell) -> Builder
  renderR :: ([Cell], Cell) -> Builder
renderR ([Cell]
cs,Cell
h) = TableOpts -> [Int] -> Header Cell -> Builder
renderColumns TableOpts
topts [Int]
sizes forall a b. (a -> b) -> a -> b
$ forall h. Properties -> [Header h] -> Header h
Group Properties
DoubleLine
                     [ forall h. h -> Header h
Header Cell
h
                     , forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Cell
emptyCell [Cell]
cs Header Cell
colHeaders
                     ]

  rows :: ([Cell], [[Cell]])
rows         = forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (rh, [a]) -> (Cell, [Cell])
f forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall h. Header h -> [h]
headerContents Header rh
rh) [[a]]
cells
  rowHeaders :: Header Cell
rowHeaders   = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Cell
emptyCell (forall a b. (a, b) -> a
fst ([Cell], [[Cell]])
rows) Header rh
rh
  colHeaders :: Header Cell
colHeaders   = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Cell
emptyCell ([ch] -> [Cell]
fc forall a b. (a -> b) -> a -> b
$ forall h. Header h -> [h]
headerContents Header ch
ch) Header ch
ch
  cellContents :: [[Cell]]
cellContents = forall a b. (a, b) -> b
snd ([Cell], [[Cell]])
rows

  -- ch2 and cell2 include the row and column labels
  ch2 :: Header Cell
ch2 = forall h. Properties -> [Header h] -> Header h
Group Properties
DoubleLine [forall h. h -> Header h
Header Cell
emptyCell, Header Cell
colHeaders]
  cells2 :: [[Cell]]
cells2 = forall h. Header h -> [h]
headerContents Header Cell
ch2 forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (:) (forall h. Header h -> [h]
headerContents Header Cell
rowHeaders) [[Cell]]
cellContents

  -- maximum width for each column
  sizes :: [Int]
sizes = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Maybe a
maximumMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Cell -> Int
cellWidth) forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose [[Cell]]
cells2
  renderRs :: Header Builder -> [Builder]
renderRs (Header Builder
s)   = [Builder
s]
  renderRs (Group Properties
p [Header Builder]
hs) = forall a. [a] -> [[a]] -> [a]
intercalate [Builder]
sep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Header Builder -> [Builder]
renderRs [Header Builder]
hs
    where sep :: [Builder]
sep = forall a.
VPos
-> Bool -> Bool -> [Int] -> Header a -> Properties -> [Builder]
renderHLine VPos
VM Bool
borders Bool
pretty [Int]
sizes Header Cell
ch2 Properties
p

  -- borders and bars
  addBorders :: [Builder] -> [Builder]
addBorders [Builder]
xs = if Bool
borders then VPos -> Properties -> Builder
bar VPos
VT Properties
SingleLine forall a. a -> [a] -> [a]
: [Builder]
xs forall a. [a] -> [a] -> [a]
++ [VPos -> Properties -> Builder
bar VPos
VB Properties
SingleLine] else [Builder]
xs
  bar :: VPos -> Properties -> Builder
bar VPos
vpos Properties
prop = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a.
VPos
-> Bool -> Bool -> [Int] -> Header a -> Properties -> [Builder]
renderHLine VPos
vpos Bool
borders Bool
pretty [Int]
sizes Header Cell
ch2 Properties
prop
  unlinesB :: [Builder] -> Builder
unlinesB = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'\n')

-- | Render a single row according to cell specifications.
renderRow :: TableOpts -> Header Cell -> TL.Text
renderRow :: TableOpts -> Header Cell -> Text
renderRow TableOpts
topts = Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableOpts -> Header Cell -> Builder
renderRowB TableOpts
topts

-- | A version of renderRow which returns the underlying Builder.
renderRowB:: TableOpts -> Header Cell -> Builder
renderRowB :: TableOpts -> Header Cell -> Builder
renderRowB TableOpts
topts Header Cell
h = TableOpts -> [Int] -> Header Cell -> Builder
renderColumns TableOpts
topts [Int]
is Header Cell
h
  where is :: [Int]
is = forall a b. (a -> b) -> [a] -> [b]
map Cell -> Int
cellWidth forall a b. (a -> b) -> a -> b
$ 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 -> Builder
leftBar :: Bool -> Bool -> Builder
leftBar Bool
pretty Bool
True  = [Char] -> Builder
fromString forall a b. (a -> b) -> a -> b
$ Bool -> Char
verticalBar Bool
pretty forall a. a -> [a] -> [a]
: [Char]
" "
leftBar Bool
pretty Bool
False = Char -> Builder
singleton forall a b. (a -> b) -> a -> b
$ Bool -> Char
verticalBar Bool
pretty

rightBar :: Bool -> Bool -> Builder
rightBar :: Bool -> Bool -> Builder
rightBar Bool
pretty Bool
True  = [Char] -> Builder
fromString forall a b. (a -> b) -> a -> b
$ Char
' ' forall a. a -> [a] -> [a]
: [Bool -> Char
verticalBar Bool
pretty]
rightBar Bool
pretty Bool
False = Char -> Builder
singleton forall a b. (a -> b) -> a -> b
$ Bool -> Char
verticalBar Bool
pretty

midBar :: Bool -> Bool -> Builder
midBar :: Bool -> Bool -> Builder
midBar Bool
pretty Bool
True  = [Char] -> Builder
fromString forall a b. (a -> b) -> a -> b
$ Char
' ' forall a. a -> [a] -> [a]
: Bool -> Char
verticalBar Bool
pretty forall a. a -> [a] -> [a]
: [Char]
" "
midBar Bool
pretty Bool
False = Char -> Builder
singleton forall a b. (a -> b) -> a -> b
$ Bool -> Char
verticalBar Bool
pretty

doubleMidBar :: Bool -> Bool -> Builder
doubleMidBar :: Bool -> Bool -> Builder
doubleMidBar Bool
pretty Bool
True  = Text -> Builder
fromText forall a b. (a -> b) -> a -> b
$ if Bool
pretty then Text
" ║ " else Text
" || "
doubleMidBar Bool
pretty Bool
False = Text -> Builder
fromText forall a b. (a -> b) -> a -> b
$ if Bool
pretty then Text
"║" else Text
"||"

-- | We stop rendering on the shortest list!
renderColumns :: TableOpts  -- ^ rendering options for the table
              -> [Int]      -- ^ max width for each column
              -> Header Cell
              -> Builder
renderColumns :: TableOpts -> [Int] -> Header Cell -> Builder
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 =
    forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Builder
"\n"                   -- Put each line on its own line
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder
addBorders forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose     -- Change to a list of lines and add borders
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> [Builder]
hsep (Int, Cell) -> [Builder]
padCell) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h. Header h -> [Either Properties h]
flattenHeader  -- We now have a matrix of strings
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Int
0 [Int]
is forall a b. (a -> b) -> a -> b
$ Cell -> Cell
padRow 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) -> [Builder]
padCell (Int
w, Cell Align
TopLeft     [WideBuilder]
ls) = forall a b. (a -> b) -> [a] -> [b]
map (\WideBuilder
x -> WideBuilder -> Builder
wbBuilder WideBuilder
x forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (Int
w forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
x) Text
" ")) [WideBuilder]
ls
    padCell (Int
w, Cell Align
BottomLeft  [WideBuilder]
ls) = forall a b. (a -> b) -> [a] -> [b]
map (\WideBuilder
x -> WideBuilder -> Builder
wbBuilder WideBuilder
x forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (Int
w forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
x) Text
" ")) [WideBuilder]
ls
    padCell (Int
w, Cell Align
TopRight    [WideBuilder]
ls) = forall a b. (a -> b) -> [a] -> [b]
map (\WideBuilder
x -> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (Int
w forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
x) Text
" ") forall a. Semigroup a => a -> a -> a
<> WideBuilder -> Builder
wbBuilder WideBuilder
x) [WideBuilder]
ls
    padCell (Int
w, Cell Align
BottomRight [WideBuilder]
ls) = forall a b. (a -> b) -> [a] -> [b]
map (\WideBuilder
x -> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (Int
w forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
x) Text
" ") forall a. Semigroup a => a -> a -> a
<> WideBuilder -> Builder
wbBuilder WideBuilder
x) [WideBuilder]
ls


    -- Pad each cell to have the same number of lines
    padRow :: Cell -> Cell
padRow (Cell Align
TopLeft     [WideBuilder]
ls) = Align -> [WideBuilder] -> Cell
Cell Align
TopLeft     forall a b. (a -> b) -> a -> b
$ [WideBuilder]
ls forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
nLines forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
ls) forall a. Monoid a => a
mempty
    padRow (Cell Align
TopRight    [WideBuilder]
ls) = Align -> [WideBuilder] -> Cell
Cell Align
TopRight    forall a b. (a -> b) -> a -> b
$ [WideBuilder]
ls forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
nLines forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
ls) forall a. Monoid a => a
mempty
    padRow (Cell Align
BottomLeft  [WideBuilder]
ls) = Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft  forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
nLines forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
ls) forall a. Monoid a => a
mempty forall a. [a] -> [a] -> [a]
++ [WideBuilder]
ls
    padRow (Cell Align
BottomRight [WideBuilder]
ls) = Align -> [WideBuilder] -> Cell
Cell Align
BottomRight forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
nLines forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
ls) forall a. Monoid a => a
mempty forall a. [a] -> [a] -> [a]
++ [WideBuilder]
ls

    hsep :: Properties -> [Builder]
    hsep :: Properties -> [Builder]
hsep Properties
NoLine     = forall a. Int -> a -> [a]
replicate Int
nLines forall a b. (a -> b) -> a -> b
$ if Bool
spaces then Builder
"  " else Builder
""
    hsep Properties
SingleLine = forall a. Int -> a -> [a]
replicate Int
nLines forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Builder
midBar Bool
pretty Bool
spaces
    hsep Properties
DoubleLine = forall a. Int -> a -> [a]
replicate Int
nLines forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Builder
doubleMidBar Bool
pretty Bool
spaces

    addBorders :: Builder -> Builder
addBorders Builder
xs | Bool
borders   = Bool -> Bool -> Builder
leftBar Bool
pretty Bool
spaces forall a. Semigroup a => a -> a -> a
<> Builder
xs forall a. Semigroup a => a -> a -> a
<> Bool -> Bool -> Builder
rightBar Bool
pretty Bool
spaces
                  | Bool
spaces    = Text -> Builder
fromText Text
" " forall a. Semigroup a => a -> a -> a
<> Builder
xs forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
" "
                  | Bool
otherwise = Builder
xs

    nLines :: Int
nLines = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Maybe a
maximumMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Cell Align
_ [WideBuilder]
ls) -> forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
ls) forall a b. (a -> b) -> a -> b
$ forall h. Header h -> [h]
headerContents Header Cell
h

renderHLine :: VPos
            -> Bool  -- ^ show outer borders
            -> Bool -- ^ pretty
            -> [Int] -- ^ width specifications
            -> Header a
            -> Properties
            -> [Builder]
renderHLine :: forall a.
VPos
-> Bool -> Bool -> [Int] -> Header a -> Properties -> [Builder]
renderHLine VPos
_ Bool
_ Bool
_ [Int]
_ Header a
_ Properties
NoLine = []
renderHLine VPos
vpos Bool
borders Bool
pretty [Int]
w Header a
h Properties
prop = [forall a.
VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder
renderHLine' VPos
vpos Bool
borders Bool
pretty Properties
prop [Int]
w Header a
h]

renderHLine' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder
renderHLine' :: forall a.
VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder
renderHLine' VPos
vpos Bool
borders Bool
pretty Properties
prop [Int]
is Header a
hdr = Builder -> Builder
addBorders forall a b. (a -> b) -> a -> b
$ Builder
sep forall a. Semigroup a => a -> a -> a
<> Builder
coreLine forall a. Semigroup a => a -> a -> a
<> Builder
sep
 where
  addBorders :: Builder -> Builder
addBorders Builder
xs   = if Bool
borders then HPos -> Builder
edge HPos
HL forall a. Semigroup a => a -> a -> a
<> Builder
xs forall a. Semigroup a => a -> a -> a
<> HPos -> Builder
edge HPos
HR else Builder
xs
  edge :: HPos -> Builder
edge HPos
hpos       = VPos -> HPos -> Properties -> Properties -> Bool -> Builder
boxchar VPos
vpos HPos
hpos Properties
SingleLine Properties
prop Bool
pretty
  coreLine :: Builder
coreLine        = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {b}. Either Properties (Int, b) -> Builder
helper forall a b. (a -> b) -> a -> b
$ forall h. Header h -> [Either Properties h]
flattenHeader forall a b. (a -> b) -> a -> b
$ forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Int
0 [Int]
is Header a
hdr
  helper :: Either Properties (Int, b) -> Builder
helper          = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> Builder
vsep forall {b} {b}. Integral b => (b, b) -> Builder
dashes
  dashes :: (b, b) -> Builder
dashes (b
i,b
_)    = forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid b
i Builder
sep
  sep :: Builder
sep             = VPos -> HPos -> Properties -> Properties -> Bool -> Builder
boxchar VPos
vpos HPos
HM Properties
NoLine Properties
prop Bool
pretty
  vsep :: Properties -> Builder
vsep Properties
v          = case Properties
v of
                      Properties
NoLine -> Builder
sep forall a. Semigroup a => a -> a -> a
<> Builder
sep
                      Properties
_      -> Builder
sep forall a. Semigroup a => a -> a -> a
<> Properties -> Properties -> Builder
cross Properties
v Properties
prop forall a. Semigroup a => a -> a -> a
<> Builder
sep
  cross :: Properties -> Properties -> Builder
cross Properties
v Properties
h       = VPos -> HPos -> Properties -> Properties -> Bool -> Builder
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 -> Builder
boxchar :: VPos -> HPos -> Properties -> Properties -> Bool -> Builder
boxchar VPos
vpos HPos
hpos Properties
vert Properties
horiz = Properties
-> Properties -> Properties -> Properties -> Bool -> Builder
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 :: Text -> Text -> Bool -> Builder
pick :: Text -> Text -> Bool -> Builder
pick Text
x Text
_ Bool
True  = Text -> Builder
fromText Text
x
pick Text
_ Text
x Bool
False = Text -> Builder
fromText Text
x

lineart :: Properties -> Properties -> Properties -> Properties -> Bool -> Builder
--      up         down       left      right
lineart :: Properties
-> Properties -> Properties -> Properties -> Bool -> Builder
lineart Properties
SingleLine Properties
SingleLine Properties
SingleLine Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"┼" Text
"+"
lineart Properties
SingleLine Properties
SingleLine Properties
SingleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"┤" Text
"+"
lineart Properties
SingleLine Properties
SingleLine Properties
NoLine     Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"├" Text
"+"
lineart Properties
SingleLine Properties
NoLine     Properties
SingleLine Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"┴" Text
"+"
lineart Properties
NoLine     Properties
SingleLine Properties
SingleLine Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"┬" Text
"+"
lineart Properties
SingleLine Properties
NoLine     Properties
NoLine     Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"└" Text
"+"
lineart Properties
SingleLine Properties
NoLine     Properties
SingleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"┘" Text
"+"
lineart Properties
NoLine     Properties
SingleLine Properties
SingleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"┐" Text
"+"
lineart Properties
NoLine     Properties
SingleLine Properties
NoLine     Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"┌" Text
"+"
lineart Properties
SingleLine Properties
SingleLine Properties
NoLine     Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"│" Text
"|"
lineart Properties
NoLine     Properties
NoLine     Properties
SingleLine Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"─" Text
"-"

lineart Properties
DoubleLine Properties
DoubleLine Properties
DoubleLine Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╬" Text
"++"
lineart Properties
DoubleLine Properties
DoubleLine Properties
DoubleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"╣" Text
"++"
lineart Properties
DoubleLine Properties
DoubleLine Properties
NoLine     Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╠" Text
"++"
lineart Properties
DoubleLine Properties
NoLine     Properties
DoubleLine Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╩" Text
"++"
lineart Properties
NoLine     Properties
DoubleLine Properties
DoubleLine Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╦" Text
"++"
lineart Properties
DoubleLine Properties
NoLine     Properties
NoLine     Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╚" Text
"++"
lineart Properties
DoubleLine Properties
NoLine     Properties
DoubleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"╝" Text
"++"
lineart Properties
NoLine     Properties
DoubleLine Properties
DoubleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"╗" Text
"++"
lineart Properties
NoLine     Properties
DoubleLine Properties
NoLine     Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╔" Text
"++"
lineart Properties
DoubleLine Properties
DoubleLine Properties
NoLine     Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"║" Text
"||"
lineart Properties
NoLine     Properties
NoLine     Properties
DoubleLine Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"═" Text
"="

lineart Properties
DoubleLine Properties
NoLine     Properties
NoLine     Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"╙" Text
"++"
lineart Properties
DoubleLine Properties
NoLine     Properties
SingleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"╜" Text
"++"
lineart Properties
NoLine     Properties
DoubleLine Properties
SingleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"╖" Text
"++"
lineart Properties
NoLine     Properties
DoubleLine Properties
NoLine     Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"╓" Text
"++"

lineart Properties
SingleLine Properties
NoLine     Properties
NoLine     Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╘" Text
"+"
lineart Properties
SingleLine Properties
NoLine     Properties
DoubleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"╛" Text
"+"
lineart Properties
NoLine     Properties
SingleLine Properties
DoubleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"╕" Text
"+"
lineart Properties
NoLine     Properties
SingleLine Properties
NoLine     Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╒" Text
"+"

lineart Properties
DoubleLine Properties
DoubleLine Properties
SingleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"╢" Text
"++"
lineart Properties
DoubleLine Properties
DoubleLine Properties
NoLine     Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"╟" Text
"++"
lineart Properties
DoubleLine Properties
NoLine     Properties
SingleLine Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"╨" Text
"++"
lineart Properties
NoLine     Properties
DoubleLine Properties
SingleLine Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"╥" Text
"++"

lineart Properties
SingleLine Properties
SingleLine Properties
DoubleLine Properties
NoLine     = Text -> Text -> Bool -> Builder
pick Text
"╡" Text
"+"
lineart Properties
SingleLine Properties
SingleLine Properties
NoLine     Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╞" Text
"+"
lineart Properties
SingleLine Properties
NoLine     Properties
DoubleLine Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╧" Text
"+"
lineart Properties
NoLine     Properties
SingleLine Properties
DoubleLine Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╤" Text
"+"

lineart Properties
SingleLine Properties
SingleLine Properties
DoubleLine Properties
DoubleLine = Text -> Text -> Bool -> Builder
pick Text
"╪" Text
"+"
lineart Properties
DoubleLine Properties
DoubleLine Properties
SingleLine Properties
SingleLine = Text -> Text -> Bool -> Builder
pick Text
"╫" Text
"++"

lineart Properties
_          Properties
_          Properties
_          Properties
_          = forall a b. a -> b -> a
const forall a. Monoid a => a
mempty


-- | Add the second table below the first, discarding its column headings.
concatTables :: Properties -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
concatTables :: forall rh ch a ch2.
Properties -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
concatTables Properties
prop (Table Header rh
hLeft Header ch
hTop [[a]]
dat) (Table Header rh
hLeft' Header ch2
_ [[a]]
dat') =
    forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table (forall h. Properties -> [Header h] -> Header h
Group Properties
prop [Header rh
hLeft, Header rh
hLeft']) Header ch
hTop ([[a]]
dat forall a. [a] -> [a] -> [a]
++ [[a]]
dat')