{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Writers.Markdown
   Copyright   : © 2006-2024 John MacFarlane
   License     : GPL-2.0-or-later
   Maintainer  : John MacFarlane <jgm@berkeley.edu>

Create Markdown pipe-tables and pandoc-style tables.
-}
module Text.Pandoc.Writers.Markdown.Table
  ( pipeTable
  , pandocTable
  ) where

import Control.Monad.Reader (asks)
import Data.List (intersperse, transpose)
import Data.List.NonEmpty (nonEmpty)
import Data.Text (Text)
import qualified Data.Text as T
import Text.DocLayout
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition (Alignment (..))
import Text.Pandoc.Options (WriterOptions (writerColumns, writerWrapText),
                            WrapOption(WrapAuto))
import Text.Pandoc.Writers.Markdown.Types (MarkdownVariant(Markdown),
                                           WriterEnv(..), MD)

-- | Creates a Markdown pipe table.
pipeTable :: PandocMonad m
          => WriterOptions
          -> Bool            -- ^ headless?
          -> [Alignment]     -- ^ column alignments
          -> [Double]        -- ^ column widhts
          -> [Doc Text]      -- ^ table header cells
          -> [[Doc Text]]    -- ^ table body rows
          -> MD m (Doc Text)
pipeTable :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> MD m (Doc Text)
pipeTable WriterOptions
opts Bool
headless [Alignment]
aligns [Double]
widths [Doc Text]
rawHeaders [[Doc Text]]
rawRows = do
  let sp :: Doc Text
sp = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
  let contentWidths :: [Int]
contentWidths = ([Doc Text] -> Int) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
3 (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
3 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc Text] -> [Int]) -> [Doc Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Int) -> [Doc Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset) ([[Doc Text]] -> [Int]) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> a -> b
$
                       [[Doc Text]] -> [[Doc Text]]
forall a. [[a]] -> [[a]]
transpose ([Doc Text]
rawHeaders [Doc Text] -> [[Doc Text]] -> [[Doc Text]]
forall a. a -> [a] -> [a]
: [[Doc Text]]
rawRows)
  let colwidth :: Int
colwidth = WriterOptions -> Int
writerColumns WriterOptions
opts
  let numcols :: Int
numcols = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
contentWidths
  let maxwidth :: Int
maxwidth = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
contentWidths
  -- if cell contents are > COLUMNS, adding padding looks bad
  let pad :: Bool
pad = Int
maxwidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WriterOptions -> Int
writerColumns WriterOptions
opts
  let blockFor :: Alignment -> Int -> Doc Text -> Doc Text
blockFor Alignment
_ Int
_ Doc Text
y | Bool -> Bool
not Bool
pad = Doc Text
sp Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
y Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sp Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
0 Doc Text
forall a. Doc a
empty
      blockFor Alignment
AlignLeft   Int
x Doc Text
y = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Doc Text
sp Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
y) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
0 Doc Text
forall a. Doc a
empty
      blockFor Alignment
AlignCenter Int
x Doc Text
y = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
cblock (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Doc Text
sp Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
y Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sp) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
0 Doc Text
forall a. Doc a
empty
      blockFor Alignment
AlignRight  Int
x Doc Text
y = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
rblock (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Doc Text
y Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sp) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
0 Doc Text
forall a. Doc a
empty
      blockFor Alignment
AlignDefault Int
x Doc Text
y = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Doc Text
sp Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
y) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
0 Doc Text
forall a. Doc a
empty
  MarkdownVariant
variant <- (WriterEnv -> MarkdownVariant)
-> ReaderT WriterEnv (StateT WriterState m) MarkdownVariant
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> MarkdownVariant
envVariant
  let pipeWidths :: [Int]
pipeWidths = if MarkdownVariant
variant MarkdownVariant -> MarkdownVariant -> Bool
forall a. Eq a => a -> a -> Bool
== MarkdownVariant
Markdown Bool -> Bool -> Bool
&&
                      Bool -> Bool
not ((Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths) Bool -> Bool -> Bool
&&
                      Int
maxwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
colwidth
                      then (Double -> Int) -> [Double] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map
                            (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
colwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))))
                            [Double]
widths
                      else if Bool
pad
                              then [Int]
contentWidths
                              else (Double -> Int) -> [Double] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Double -> Int
forall a b. a -> b -> a
const Int
2) [Double]
widths
  let torow :: [Doc Text] -> Doc Text
torow [Doc Text]
cs = Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                    [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|") ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
                          (Alignment -> Int -> Doc Text -> Doc Text)
-> [Alignment] -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Alignment -> Int -> Doc Text -> Doc Text
blockFor [Alignment]
aligns [Int]
contentWidths ((Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp [Doc Text]
cs))
                    Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|"
  let toborder :: Alignment -> Int -> Doc Text
toborder Alignment
a Int
w = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ case Alignment
a of
                          Alignment
AlignLeft    -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"-"
                          Alignment
AlignCenter  -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
w Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
                          Alignment
AlignRight   -> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
                          Alignment
AlignDefault -> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Text
"-"
  -- note:  pipe tables can't completely lack a
  -- header; for a headerless table, we need a header of empty cells.
  -- see jgm/pandoc#1996.
  let header :: Doc Text
header = if Bool
headless
                  then [Doc Text] -> Doc Text
torow (Int -> Doc Text -> [Doc Text]
forall a. Int -> a -> [a]
replicate ([Alignment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns) Doc Text
forall a. Doc a
empty)
                  else [Doc Text] -> Doc Text
torow [Doc Text]
rawHeaders
  let border :: Doc Text
border = Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|") ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
                        (Alignment -> Int -> Doc Text)
-> [Alignment] -> [Int] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Alignment -> Int -> Doc Text
toborder [Alignment]
aligns [Int]
pipeWidths) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"|"
  let body :: Doc Text
body   = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Doc Text
torow [[Doc Text]]
rawRows
  Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
header Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
border Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body

-- | Write a pandoc-style Markdown table.
pandocTable :: PandocMonad m
            => WriterOptions
            -> Bool            -- ^ whether this is a multiline table
            -> Bool            -- ^ whether the table has a header
            -> [Alignment]     -- ^ column alignments
            -> [Double]        -- ^ column widths
            -> [Doc Text]      -- ^ table header cells
            -> [[Doc Text]]    -- ^ table body rows
            -> MD m (Doc Text)
pandocTable :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> MD m (Doc Text)
pandocTable WriterOptions
opts Bool
multiline Bool
headless [Alignment]
aligns [Double]
widths [Doc Text]
rawHeaders [[Doc Text]]
rawRows = do
  let isSimple :: Bool
isSimple = (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0) [Double]
widths
  let alignHeader :: Alignment -> Int -> Doc a -> Doc a
alignHeader Alignment
alignment = case Alignment
alignment of
                                Alignment
AlignLeft    -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock
                                Alignment
AlignCenter  -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
cblock
                                Alignment
AlignRight   -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
rblock
                                Alignment
AlignDefault -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock
  -- Number of characters per column necessary to output every cell
  -- without requiring a line break.
  -- The @+2@ is needed for specifying the alignment.
  let numChars :: [Doc Text] -> Int
numChars    = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc Text] -> [Int]) -> [Doc Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Int) -> [Doc Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset
  -- Number of characters per column necessary to output every cell
  -- without requiring a line break *inside a word*.
  -- The @+2@ is needed for specifying the alignment.
  let minNumChars :: [Doc Text] -> Int
minNumChars = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc Text] -> [Int]) -> [Doc Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Int) -> [Doc Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Int
forall a. HasChars a => Doc a -> Int
minOffset
  let columns :: [[Doc Text]]
columns = [[Doc Text]] -> [[Doc Text]]
forall a. [[a]] -> [[a]]
transpose ([Doc Text]
rawHeaders [Doc Text] -> [[Doc Text]] -> [[Doc Text]]
forall a. a -> [a] -> [a]
: [[Doc Text]]
rawRows)
  -- minimal column width without wrapping a single word
  let relWidth :: a -> [Doc Text] -> Int
relWidth a
w [Doc Text]
col =
         Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (a -> Int
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WriterOptions -> Int
writerColumns WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> a -> a
forall a. Num a => a -> a -> a
* a
w)
             (if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                 then [Doc Text] -> Int
minNumChars [Doc Text]
col
                 else [Doc Text] -> Int
numChars [Doc Text]
col)
  let widthsInChars :: [Int]
widthsInChars
        | Bool
isSimple  = ([Doc Text] -> Int) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Int
numChars [[Doc Text]]
columns
        | Bool
otherwise = (Double -> [Doc Text] -> Int) -> [Double] -> [[Doc Text]] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> [Doc Text] -> Int
forall {a}. RealFrac a => a -> [Doc Text] -> Int
relWidth [Double]
widths [[Doc Text]]
columns
  let makeRow :: [Doc Text] -> Doc Text
makeRow = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
1 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" ")) ([Doc Text] -> [Doc Text])
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Alignment -> Int -> Doc Text -> Doc Text)
-> [Alignment] -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Alignment -> Int -> Doc Text -> Doc Text
forall {a}. HasChars a => Alignment -> Int -> Doc a -> Doc a
alignHeader [Alignment]
aligns [Int]
widthsInChars
  let rows' :: [Doc Text]
rows' = ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Doc Text
makeRow [[Doc Text]]
rawRows
  let head' :: Doc Text
head' = [Doc Text] -> Doc Text
makeRow [Doc Text]
rawHeaders
  let underline :: Doc Text
underline = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" ") ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
                  (Int -> Doc Text) -> [Int] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
width -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
width Text
"-")) [Int]
widthsInChars
  let border :: Doc Text
border
        | Bool
multiline = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
widthsInChars Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                        [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
widthsInChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
"-")
        | Bool
headless  = Doc Text
underline
        | Bool
otherwise = Doc Text
forall a. Doc a
empty
  let head'' :: Doc Text
head'' = if Bool
headless
                  then Doc Text
forall a. Doc a
empty
                  else Doc Text
border Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
head'
  let body :: Doc Text
body = if Bool
multiline
                then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [Doc Text]
rows' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                     if [Doc Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
rows' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
                        then Doc Text
forall a. Doc a
blankline -- #4578
                        else Doc Text
forall a. Doc a
empty
                else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
  let bottom :: Doc Text
bottom = if Bool
headless
                  then Doc Text
underline
                  else Doc Text
border
  Doc Text -> MD m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MD m (Doc Text)) -> Doc Text -> MD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
head'' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
underline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
bottom