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

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

module Text.Tabular.AsciiWide where

import Data.Maybe (fromMaybe)
import Data.Default (Default(..))
import Data.List (intersperse, transpose)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
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(..), textWidth)


-- | 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 [WideBuilder]

-- | 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 -> [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 ([WideBuilder] -> Cell)
-> ([Text] -> [WideBuilder]) -> [Text] -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> WideBuilder) -> [Text] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Builder -> Int -> WideBuilder
WideBuilder (Text -> Builder
fromText Text
x) (Text -> Int
textWidth Text
x)) ([Text] -> Cell) -> [Text] -> Cell
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
x then [Text
""] else Text -> [Text]
T.lines Text
x

-- | Return the width of a Cell.
cellWidth :: Cell -> Int
cellWidth :: Cell -> Int
cellWidth (Cell Align
_ [WideBuilder]
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
$ (WideBuilder -> Int) -> [WideBuilder] -> [Int]
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 :: Bool
-> (rh -> Text)
-> (ch -> Text)
-> (a -> Text)
-> Table rh ch a
-> Text
render Bool
pretty rh -> Text
fr ch -> Text
fc a -> Text
f = TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> Text
forall rh ch a.
TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> Text
renderTable TableOpts
forall a. Default a => a
def{prettyTable :: Bool
prettyTable=Bool
pretty} (Text -> Cell
cell (Text -> Cell) -> (rh -> Text) -> rh -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rh -> Text
fr) (Text -> Cell
cell (Text -> Cell) -> (ch -> Text) -> ch -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ch -> Text
fc) (Text -> Cell
cell (Text -> Cell) -> (a -> Text) -> a -> 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 :: 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 (Builder -> Text)
-> (Table rh ch a -> Builder) -> Table rh ch a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> Builder
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 :: TableOpts
-> (rh -> Cell)
-> (ch -> Cell)
-> (a -> Cell)
-> Table rh ch a
-> Builder
renderTableB 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) =
   [Builder] -> Builder
unlinesB ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> [Builder]
addBorders ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
     TableOpts -> [Int] -> Header Cell -> Builder
renderColumns TableOpts
topts [Int]
sizes Header Cell
ch2
     Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: VPos -> Properties -> Builder
bar VPos
VM Properties
DoubleLine   -- +======================================+
     Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Header Builder -> [Builder]
renderRs ((([Cell], Cell) -> Builder)
-> Header ([Cell], Cell) -> Header Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Cell], Cell) -> Builder
renderR (Header ([Cell], Cell) -> Header Builder)
-> Header ([Cell], Cell) -> Header Builder
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) -> Builder
renderR ([Cell]
cs,Cell
h) = TableOpts -> [Int] -> Header Cell -> Builder
renderColumns TableOpts
topts [Int]
sizes (Header Cell -> Builder) -> Header Cell -> Builder
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 Builder -> [Builder]
renderRs (Header Builder
s)   = [Builder
s]
  renderRs (Group Properties
p [Header Builder]
hs) = [[Builder]] -> [Builder]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Builder]] -> [Builder])
-> ([[Builder]] -> [[Builder]]) -> [[Builder]] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> [[Builder]] -> [[Builder]]
forall a. a -> [a] -> [a]
intersperse [Builder]
sep ([[Builder]] -> [Builder]) -> [[Builder]] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Header Builder -> [Builder]) -> [Header Builder] -> [[Builder]]
forall a b. (a -> b) -> [a] -> [b]
map Header Builder -> [Builder]
renderRs [Header Builder]
hs
    where sep :: [Builder]
sep = VPos
-> Bool -> Bool -> [Int] -> Header Cell -> Properties -> [Builder]
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 Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs [Builder] -> [Builder] -> [Builder]
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 = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ VPos
-> Bool -> Bool -> [Int] -> Header Cell -> Properties -> [Builder]
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 = (Builder -> Builder) -> [Builder] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Builder -> Builder -> Builder
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 (Builder -> Text)
-> (Header Cell -> Builder) -> Header Cell -> Text
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 = (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
$ 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 -> Builder
leftBar :: Bool -> Bool -> Builder
leftBar Bool
pretty Bool
True  = String -> Builder
fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Bool -> Char
verticalBar Bool
pretty Char -> ShowS
forall a. a -> [a] -> [a]
: String
" "
leftBar Bool
pretty Bool
False = Char -> Builder
singleton (Char -> Builder) -> Char -> Builder
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  = String -> Builder
fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: [Bool -> Char
verticalBar Bool
pretty]
rightBar Bool
pretty Bool
False = Char -> Builder
singleton (Char -> Builder) -> Char -> Builder
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  = String -> Builder
fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ 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 = Char -> Builder
singleton (Char -> Builder) -> Char -> Builder
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 (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ if Bool
pretty then Text
" ║ " else Text
" || "
doubleMidBar Bool
pretty Bool
False = Text -> Builder
fromText (Text -> Builder) -> Text -> Builder
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 =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Header Cell -> [Builder]) -> Header Cell -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
"\n"                   -- Put each line on its own line
    ([Builder] -> [Builder])
-> (Header Cell -> [Builder]) -> Header Cell -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Builder] -> Builder) -> [[Builder]] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder
addBorders (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat) ([[Builder]] -> [Builder])
-> (Header Cell -> [[Builder]]) -> Header Cell -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Builder]] -> [[Builder]]
forall a. [[a]] -> [[a]]
transpose     -- Change to a list of lines and add borders
    ([[Builder]] -> [[Builder]])
-> (Header Cell -> [[Builder]]) -> Header Cell -> [[Builder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Properties (Int, Cell) -> [Builder])
-> [Either Properties (Int, Cell)] -> [[Builder]]
forall a b. (a -> b) -> [a] -> [b]
map ((Properties -> [Builder])
-> ((Int, Cell) -> [Builder])
-> Either Properties (Int, Cell)
-> [Builder]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> [Builder]
hsep (Int, Cell) -> [Builder]
padCell) ([Either Properties (Int, Cell)] -> [[Builder]])
-> (Header Cell -> [Either Properties (Int, Cell)])
-> Header Cell
-> [[Builder]]
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 -> Builder) -> Header Cell -> Builder
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) -> [Builder]
padCell (Int
w, Cell Align
TopLeft     [WideBuilder]
ls) = (WideBuilder -> Builder) -> [WideBuilder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\WideBuilder
x -> WideBuilder -> Builder
wbBuilder WideBuilder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
x) Text
" ")) [WideBuilder]
ls
    padCell (Int
w, Cell Align
BottomLeft  [WideBuilder]
ls) = (WideBuilder -> Builder) -> [WideBuilder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\WideBuilder
x -> WideBuilder -> Builder
wbBuilder WideBuilder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
x) Text
" ")) [WideBuilder]
ls
    padCell (Int
w, Cell Align
TopRight    [WideBuilder]
ls) = (WideBuilder -> Builder) -> [WideBuilder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\WideBuilder
x -> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
x) Text
" ") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WideBuilder -> Builder
wbBuilder WideBuilder
x) [WideBuilder]
ls
    padCell (Int
w, Cell Align
BottomRight [WideBuilder]
ls) = (WideBuilder -> Builder) -> [WideBuilder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\WideBuilder
x -> Text -> Builder
fromText (Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
x) Text
" ") Builder -> Builder -> Builder
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     ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
$ [WideBuilder]
ls [WideBuilder] -> [WideBuilder] -> [WideBuilder]
forall a. [a] -> [a] -> [a]
++ Int -> WideBuilder -> [WideBuilder]
forall a. Int -> a -> [a]
replicate (Int
nLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- [WideBuilder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
ls) WideBuilder
forall a. Monoid a => a
mempty
    padRow (Cell Align
TopRight    [WideBuilder]
ls) = Align -> [WideBuilder] -> Cell
Cell Align
TopRight    ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
$ [WideBuilder]
ls [WideBuilder] -> [WideBuilder] -> [WideBuilder]
forall a. [a] -> [a] -> [a]
++ Int -> WideBuilder -> [WideBuilder]
forall a. Int -> a -> [a]
replicate (Int
nLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- [WideBuilder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
ls) WideBuilder
forall a. Monoid a => a
mempty
    padRow (Cell Align
BottomLeft  [WideBuilder]
ls) = Align -> [WideBuilder] -> Cell
Cell Align
BottomLeft  ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
$ Int -> WideBuilder -> [WideBuilder]
forall a. Int -> a -> [a]
replicate (Int
nLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- [WideBuilder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
ls) WideBuilder
forall a. Monoid a => a
mempty [WideBuilder] -> [WideBuilder] -> [WideBuilder]
forall a. [a] -> [a] -> [a]
++ [WideBuilder]
ls
    padRow (Cell Align
BottomRight [WideBuilder]
ls) = Align -> [WideBuilder] -> Cell
Cell Align
BottomRight ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
$ Int -> WideBuilder -> [WideBuilder]
forall a. Int -> a -> [a]
replicate (Int
nLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- [WideBuilder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
ls) WideBuilder
forall a. Monoid a => a
mempty [WideBuilder] -> [WideBuilder] -> [WideBuilder]
forall a. [a] -> [a] -> [a]
++ [WideBuilder]
ls

    hsep :: Properties -> [Builder]
    hsep :: Properties -> [Builder]
hsep Properties
NoLine     = Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate Int
nLines (Builder -> [Builder]) -> Builder -> [Builder]
forall a b. (a -> b) -> a -> b
$ if Bool
spaces then Builder
"  " else Builder
""
    hsep Properties
SingleLine = Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate Int
nLines (Builder -> [Builder]) -> Builder -> [Builder]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Builder
midBar Bool
pretty Bool
spaces
    hsep Properties
DoubleLine = Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate Int
nLines (Builder -> [Builder]) -> Builder -> [Builder]
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Bool -> Builder
rightBar Bool
pretty Bool
spaces
                  | Bool
spaces    = Text -> Builder
fromText Text
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
" "
                  | Bool
otherwise = Builder
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
_ [WideBuilder]
ls) -> [WideBuilder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
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
            -> [Builder]
renderHLine :: 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 = [VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder
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' :: VPos -> Bool -> Bool -> Properties -> [Int] -> Header a -> Builder
renderHLine' VPos
vpos Bool
borders Bool
pretty Properties
prop [Int]
is Header a
h = Builder -> Builder
addBorders (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
sep Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
coreLine Builder -> Builder -> Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
xs Builder -> Builder -> Builder
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        = (Either Properties (Int, a) -> Builder)
-> [Either Properties (Int, a)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Either Properties (Int, a) -> Builder
forall b. Either Properties (Int, b) -> Builder
helper ([Either Properties (Int, a)] -> Builder)
-> [Either Properties (Int, a)] -> Builder
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) -> Builder
helper          = (Properties -> Builder)
-> ((Int, b) -> Builder) -> Either Properties (Int, b) -> Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> Builder
vsep (Int, b) -> Builder
forall b b. Integral b => (b, b) -> Builder
dashes
  dashes :: (b, b) -> Builder
dashes (b
i,b
_)    = b -> Builder -> Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sep
                      Properties
_      -> Builder
sep Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Properties -> Properties -> Builder
cross Properties
v Properties
prop Builder -> Builder -> Builder
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
_          = Builder -> Bool -> Builder
forall a b. a -> b -> a
const Builder
forall a. Monoid a => a
mempty