-- | This module provides tools to layout text as grid or table. Besides basic
-- things like specifying column positioning, alignment on the same character
-- and length restriction it also provides advanced features like justifying
-- text and fancy tables with styling support.
--
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Text.Layout.Table
    ( -- * Column Layout
      -- | Specify how a column is rendered with the combinators in this
      -- section. Sensible default values are provided with 'def'.

      module Data.Default.Class

      -- ** Columns
    , ColSpec
    , column
    , numCol
    , fixedCol
    , fixedLeftCol
    , defColSpec
      -- ** Length of Columns
    , LenSpec
    , expand
    , fixed
    , expandUntil
    , fixedUntil
    , expandBetween
      -- ** Positional Alignment
    , Position
    , H
    , left
    , right
    , center
    , beginning
      -- ** Alignment of Cells at Characters
    , AlignSpec
    , noAlign
    , charAlign
    , predAlign
    , dotAlign
      -- ** Cut Marks
    , CutMark
    , noCutMark
    , singleCutMark
    , doubleCutMark
    , ellipsisCutMark

      -- * Grids
      -- ** Rendering
    , Row
    , grid
    , gridB
    , gridBWithCMIs
    , gridLines
    , gridLinesB
    , gridString
    , gridStringB

      -- ** Concatenating
    , concatRow
    , concatLines
    , concatGrid

      -- ** Modification Functions
    , altLines
    , checkeredCells

      -- * Tables
      -- ** Grouping Rows
      -- | Rows in character-based tables are separated by separator lines.
      -- This section provides the tools to decide when this separation is
      -- happening.  Thus, several text rows may be in the same row of the
      -- table.
    , RowGroup
    , rowsG
    , rowG

    -- *** Columns as Row Groups
    -- | [Text justification](#text) may be used to turn text into
    -- length-limited columns. Such columns may be turned into a 'RowGroup'
    -- with 'colsG' or 'colsAllG'.
    , colsG
    , colsAllG

      -- ** Specifying Tables
      -- | The most basic `TableSpec` may be constructed by using `simpleTableS`.
    , module Text.Layout.Table.Spec.TableSpec

      -- ** Rendering
      -- | Render a 'TableSpec'.
    , tableLines
    , tableLinesB
    , tableLinesBWithCMIs
    , tableString
    , tableStringB

      -- ** Headers
    , HeaderColSpec
    , headerColumn
    , HeaderSpec
    , noneSepH
    , noneH
    , fullSepH
    , fullH
    , titlesH
    , groupH
    , headerH
    , defHeaderColSpec

      -- ** Styles
    , module Text.Layout.Table.Style
    , module Text.Layout.Table.LineStyle


      -- * Multi-Row Cell Rendering
      -- ** Text Justification
      -- | #text# Split text and turn it into a column.  Such columns may be
      -- combined with other columns.
    , justify
    , justifyText

      -- ** Vertical Column Positioning
      -- | Turn rows of columns into a grid by aligning the columns.
    , V
    , top
    , bottom
    , Col
    , colsAsRowsAll
    , colsAsRows

      -- * Custom Layout Generation
      -- ** Column Modification Functions
    , pad
    , trim
    , trimOrPad
    , trimOrPadBetween
    , align
    , alignFixed
    , buildCellMod
    , adjustCell

      -- ** Column Modifaction Primitives
      -- | These functions are provided to be reused. For example if someone
      -- wants to render their own kind of tables.
    , ColModInfo
    , widthCMI
    , unalignedCMI
    , ensureWidthCMI
    , ensureWidthOfCMI
    , columnModifier
    , AlignInfo
    , widthAI
    , deriveColModInfosFromGrid
    , deriveColModInfosFromColumns
    , deriveAlignInfo
    , OccSpec

      -- ** Table Headers
    , zipHeader
    , flattenHeader
    , headerContents
    ) where

-- TODO AlignSpec:   multiple alignment points - useful?
-- TODO RowGroup:    optional: provide extra layout for a RowGroup
-- TODO ColSpec:     add some kind of combinator to construct ColSpec values (e.g. via Monoid, see optparse-applicative)

import           Data.Bifunctor
import           Data.Default.Class
import           Data.List
import           Data.Maybe
import           Data.Semigroup

import           Text.Layout.Table.Cell
import           Text.Layout.Table.Justify
import           Text.Layout.Table.LineStyle
import           Text.Layout.Table.Primitives.AlignInfo
import           Text.Layout.Table.Primitives.ColumnModifier
import           Text.Layout.Table.Primitives.Header
import           Text.Layout.Table.Primitives.Table
import           Text.Layout.Table.Spec.AlignSpec
import           Text.Layout.Table.Spec.ColSpec
import           Text.Layout.Table.Spec.CutMark
import           Text.Layout.Table.Spec.HeaderColSpec
import           Text.Layout.Table.Spec.HeaderSpec
import           Text.Layout.Table.Spec.LenSpec
import           Text.Layout.Table.Spec.OccSpec
import           Text.Layout.Table.Spec.Position
import           Text.Layout.Table.Spec.RowGroup
import           Text.Layout.Table.Spec.TableSpec
import           Text.Layout.Table.Spec.Util
import           Text.Layout.Table.StringBuilder
import           Text.Layout.Table.Style
import           Text.Layout.Table.Vertical

-------------------------------------------------------------------------------
-- Layout types and combinators
-------------------------------------------------------------------------------

-- | Align all text at the first dot from the left. This is most useful for
-- floating point numbers.
dotAlign :: AlignSpec
dotAlign :: AlignSpec
dotAlign = Char -> AlignSpec
charAlign Char
'.'

-- | Numbers are positioned on the right and aligned on the floating point dot.
numCol :: ColSpec
numCol :: ColSpec
numCol = LenSpec -> Position H -> AlignSpec -> CutMark -> ColSpec
column LenSpec
expand Position H
right AlignSpec
dotAlign CutMark
ellipsisCutMark

-- | Fixes the column length and positions according to the given 'Position'.
fixedCol :: Int -> Position H -> ColSpec
fixedCol :: Int -> Position H -> ColSpec
fixedCol Int
l Position H
pS = LenSpec -> Position H -> AlignSpec -> CutMark -> ColSpec
column (Int -> LenSpec
fixed Int
l) Position H
pS AlignSpec
noAlign CutMark
ellipsisCutMark

-- | Fixes the column length and positions on the left.
fixedLeftCol :: Int -> ColSpec
fixedLeftCol :: Int -> ColSpec
fixedLeftCol Int
i = Int -> Position H -> ColSpec
fixedCol Int
i Position H
left

-------------------------------------------------------------------------------
-- Basic layout
-------------------------------------------------------------------------------

-- | Modifies cells according to the column specification.
gridB :: (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> [Row b]
gridB :: forall a b.
(Cell a, StringBuilder b) =>
[ColSpec] -> [Row a] -> [Row b]
gridB [ColSpec]
specs = ([Row b], [ColModInfo]) -> [Row b]
forall a b. (a, b) -> a
fst (([Row b], [ColModInfo]) -> [Row b])
-> ([Row a] -> ([Row b], [ColModInfo])) -> [Row a] -> [Row b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ColSpec] -> [Row a] -> ([Row b], [ColModInfo])
forall a b.
(Cell a, StringBuilder b) =>
[ColSpec] -> [Row a] -> ([Row b], [ColModInfo])
gridBWithCMIs [ColSpec]
specs

-- | Modifies cells according to the column specification, also returning the
-- 'ColModInfo' used to generate the grid.
gridBWithCMIs :: (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> ([Row b], [ColModInfo])
gridBWithCMIs :: forall a b.
(Cell a, StringBuilder b) =>
[ColSpec] -> [Row a] -> ([Row b], [ColModInfo])
gridBWithCMIs [ColSpec]
specs [Row a]
tab = ((Position H -> CutMark -> ColModInfo -> a -> b)
-> [Position H] -> [CutMark] -> [ColModInfo] -> Row a -> [b]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 Position H -> CutMark -> ColModInfo -> a -> b
forall a b.
(Cell a, StringBuilder b) =>
Position H -> CutMark -> ColModInfo -> a -> b
columnModifier [Position H]
positions [CutMark]
cms [ColModInfo]
cMIs (Row a -> [b]) -> [Row a] -> [[b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row a]
tab, [ColModInfo]
cMIs)
  where
    cMIs :: [ColModInfo]
cMIs = [ColSpec] -> [Row a] -> [ColModInfo]
forall a. Cell a => [ColSpec] -> [Row a] -> [ColModInfo]
deriveColModInfosFromGrid [ColSpec]
specs [Row a]
tab
    positions :: [Position H]
positions = (ColSpec -> Position H) -> [ColSpec] -> [Position H]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> Position H
position [ColSpec]
specs
    cms :: [CutMark]
cms = (ColSpec -> CutMark) -> [ColSpec] -> [CutMark]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> CutMark
cutMark [ColSpec]
specs

-- | A version of 'gridB' specialized to 'String'.
grid :: Cell a => [ColSpec] -> [Row a] -> [Row String]
grid :: forall a. Cell a => [ColSpec] -> [Row a] -> [Row String]
grid = [ColSpec] -> [Row a] -> [Row String]
forall a b.
(Cell a, StringBuilder b) =>
[ColSpec] -> [Row a] -> [Row b]
gridB

-- | A version of 'gridB' that joins the cells of a row with one space.
gridLinesB :: (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> [b]
gridLinesB :: forall a b.
(Cell a, StringBuilder b) =>
[ColSpec] -> [Row a] -> [b]
gridLinesB [ColSpec]
specs = (Row b -> b) -> [Row b] -> Row b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Row b -> b
forall b. StringBuilder b => Int -> Row b -> b
concatRow Int
1)([Row b] -> Row b) -> ([Row a] -> [Row b]) -> [Row a] -> Row b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ColSpec] -> [Row a] -> [Row b]
forall a b.
(Cell a, StringBuilder b) =>
[ColSpec] -> [Row a] -> [Row b]
gridB [ColSpec]
specs

-- | A version of 'gridLinesB' specialized to 'String'.
gridLines :: Cell a => [ColSpec] -> [Row a] -> [String]
gridLines :: forall a. Cell a => [ColSpec] -> [Row a] -> Row String
gridLines = [ColSpec] -> [Row a] -> Row String
forall a b.
(Cell a, StringBuilder b) =>
[ColSpec] -> [Row a] -> [b]
gridLinesB

-- | A version of 'gridLinesB' that also concatenates the lines.
gridStringB :: (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> b
gridStringB :: forall a b. (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> b
gridStringB [ColSpec]
specs = [b] -> b
forall b. StringBuilder b => [b] -> b
concatLines ([b] -> b) -> ([Row a] -> [b]) -> [Row a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ColSpec] -> [Row a] -> [b]
forall a b.
(Cell a, StringBuilder b) =>
[ColSpec] -> [Row a] -> [b]
gridLinesB [ColSpec]
specs

-- | A version of 'gridStringB' specialized to 'String'.
gridString :: Cell a => [ColSpec] -> [Row a] -> String
gridString :: forall a. Cell a => [ColSpec] -> [Row a] -> String
gridString = [ColSpec] -> [Row a] -> String
forall a b. (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> b
gridStringB

concatLines :: StringBuilder b => [b] -> b
concatLines :: forall b. StringBuilder b => [b] -> b
concatLines = [b] -> b
forall a. Monoid a => [a] -> a
mconcat ([b] -> b) -> ([b] -> [b]) -> [b] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [b] -> [b]
forall a. a -> [a] -> [a]
intersperse (Char -> b
forall a. StringBuilder a => Char -> a
charB Char
'\n')

-- | Concatenates a row with a given amount of spaces.
concatRow
    :: StringBuilder b
    => Int
    -> Row b
    -> b
concatRow :: forall b. StringBuilder b => Int -> Row b -> b
concatRow Int
n Row b
bs = Row b -> b
forall a. Monoid a => [a] -> a
mconcat (Row b -> b) -> Row b -> b
forall a b. (a -> b) -> a -> b
$ b -> Row b -> Row b
forall a. a -> [a] -> [a]
intersperse (Int -> Char -> b
forall a. StringBuilder a => Int -> Char -> a
replicateCharB Int
n Char
' ') Row b
bs

-- | Concatenates a whole grid with the given amount of horizontal spaces
-- between columns.
concatGrid :: StringBuilder b => Int -> [Row b] -> b
concatGrid :: forall b. StringBuilder b => Int -> [Row b] -> b
concatGrid Int
n = [b] -> b
forall b. StringBuilder b => [b] -> b
concatLines ([b] -> b) -> ([[b]] -> [b]) -> [[b]] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b] -> b) -> [[b]] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [b] -> b
forall b. StringBuilder b => Int -> Row b -> b
concatRow Int
n)

-------------------------------------------------------------------------------
-- Grid modification functions
-------------------------------------------------------------------------------

-- | Applies functions to given lines in a alternating fashion. This makes it
-- easy to color lines to improve readability in a row.
altLines :: [a -> b] -> [a] -> [b]
altLines :: forall a b. [a -> b] -> [a] -> [b]
altLines = ((a -> b) -> a -> b) -> [a -> b] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) ([a -> b] -> [a] -> [b])
-> ([a -> b] -> [a -> b]) -> [a -> b] -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a -> b] -> [a -> b]
forall a. [a] -> [a]
cycle

-- | Applies functions to cells in a alternating fashion for every line, every
-- other line gets shifted by one. This is useful for distinguishability of
-- single cells in a grid arrangement.
checkeredCells  :: (a -> b) -> (a -> b) -> [[a]] -> [[b]]
checkeredCells :: forall a b. (a -> b) -> (a -> b) -> [[a]] -> [[b]]
checkeredCells a -> b
f a -> b
g = ([a -> b] -> [a] -> [b]) -> [[a -> b]] -> [[a]] -> [[b]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a -> b] -> [a] -> [b]
forall a b. [a -> b] -> [a] -> [b]
altLines ([[a -> b]] -> [[a]] -> [[b]]) -> [[a -> b]] -> [[a]] -> [[b]]
forall a b. (a -> b) -> a -> b
$ [[a -> b]] -> [[a -> b]]
forall a. [a] -> [a]
cycle [[a -> b
f, a -> b
g], [a -> b
g, a -> b
f]]

-------------------------------------------------------------------------------
-- Advanced layout
-------------------------------------------------------------------------------

-- | Create a 'RowGroup' by aligning the columns vertically. The position is
-- specified for each column.
colsG :: [Position V] -> [Col a] -> RowGroup a
colsG :: forall a. [Position V] -> [Col a] -> RowGroup a
colsG [Position V]
ps = [Row (Maybe a)] -> RowGroup a
forall a. [Row (Maybe a)] -> RowGroup a
nullableRowsG ([Row (Maybe a)] -> RowGroup a)
-> ([Col a] -> [Row (Maybe a)]) -> [Col a] -> RowGroup a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Position V] -> [Col a] -> [Row (Maybe a)]
forall a. [Position V] -> [Col a] -> [Row (Maybe a)]
colsAsRows [Position V]
ps

-- | Create a 'RowGroup' by aligning the columns vertically. Each column uses
-- the same position.
colsAllG :: Position V -> [Col a] -> RowGroup a
colsAllG :: forall a. Position V -> [Col a] -> RowGroup a
colsAllG Position V
p = [Row (Maybe a)] -> RowGroup a
forall a. [Row (Maybe a)] -> RowGroup a
nullableRowsG ([Row (Maybe a)] -> RowGroup a)
-> ([Col a] -> [Row (Maybe a)]) -> [Col a] -> RowGroup a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position V -> [Col a] -> [Row (Maybe a)]
forall a. Position V -> [Col a] -> [Row (Maybe a)]
colsAsRowsAll Position V
p

-- | Renders a table as 'StringBuilder' lines. Note that providing fewer layout
-- specifications than columns or vice versa will result in not showing the
-- redundant ones.
tableLinesB :: (Cell a, Cell r, Cell c, StringBuilder b)
            => TableSpec rowSep colSep r c a
            -> [b]
tableLinesB :: forall a r c b rowSep colSep.
(Cell a, Cell r, Cell c, StringBuilder b) =>
TableSpec rowSep colSep r c a -> [b]
tableLinesB = ([b], [ColModInfo]) -> [b]
forall a b. (a, b) -> a
fst (([b], [ColModInfo]) -> [b])
-> (TableSpec rowSep colSep r c a -> ([b], [ColModInfo]))
-> TableSpec rowSep colSep r c a
-> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableSpec rowSep colSep r c a -> ([b], [ColModInfo])
forall rowSep r colSep c a b.
(Cell a, Cell r, Cell c, StringBuilder b) =>
TableSpec rowSep colSep r c a -> ([b], [ColModInfo])
tableLinesBWithCMIs

-- | Renders a table as 'StringBuilder' lines, providing the 'ColModInfo' for
-- each column. Note that providing fewer layout specifications than columns or
-- vice versa will result in not showing the redundant ones.
tableLinesBWithCMIs :: forall rowSep r colSep c a b.
                       (Cell a, Cell r, Cell c, StringBuilder b)
                    => TableSpec rowSep colSep r c a
                    -> ([b], [ColModInfo])
tableLinesBWithCMIs :: forall rowSep r colSep c a b.
(Cell a, Cell r, Cell c, StringBuilder b) =>
TableSpec rowSep colSep r c a -> ([b], [ColModInfo])
tableLinesBWithCMIs TableSpec { tableStyle :: forall rowSep colSep r c a.
TableSpec rowSep colSep r c a -> TableStyle rowSep colSep
tableStyle = TableStyle { String
rowSep -> String
rowSep -> rowSep -> String
rowSep -> colSep -> String
colSep -> String
colSep -> colSep -> String
groupBottomH :: forall rowSep colSep. TableStyle rowSep colSep -> String
groupBottomR :: forall rowSep colSep. TableStyle rowSep colSep -> String
groupBottomL :: forall rowSep colSep. TableStyle rowSep colSep -> String
groupBottomC :: forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
groupTopH :: forall rowSep colSep. TableStyle rowSep colSep -> String
groupTopR :: forall rowSep colSep. TableStyle rowSep colSep -> String
groupTopL :: forall rowSep colSep. TableStyle rowSep colSep -> String
groupTopC :: forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
groupSepRC :: forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
groupSepLC :: forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
groupSepC :: forall rowSep colSep.
TableStyle rowSep colSep -> rowSep -> colSep -> String
groupSepH :: forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
groupC :: forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
groupR :: forall rowSep colSep. TableStyle rowSep colSep -> String
groupL :: forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersB :: forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersT :: forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersR :: forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersL :: forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersBR :: forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersBL :: forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersTR :: forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersTL :: forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderC :: forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
rowHeaderB :: forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderT :: forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderLeftC :: forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
rowHeaderLeftB :: forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderLeftT :: forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderLeftV :: forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderSepC :: forall rowSep colSep.
TableStyle rowSep colSep -> rowSep -> rowSep -> String
rowHeaderSepBC :: forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderSepTC :: forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderSepV :: forall rowSep colSep. TableStyle rowSep colSep -> String
headerC :: forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
headerR :: forall rowSep colSep. TableStyle rowSep colSep -> String
headerL :: forall rowSep colSep. TableStyle rowSep colSep -> String
headerTopC :: forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
headerTopR :: forall rowSep colSep. TableStyle rowSep colSep -> String
headerTopL :: forall rowSep colSep. TableStyle rowSep colSep -> String
headerTopH :: forall rowSep colSep. TableStyle rowSep colSep -> String
headerSepC :: forall rowSep colSep.
TableStyle rowSep colSep -> colSep -> colSep -> String
headerSepRC :: forall rowSep colSep. TableStyle rowSep colSep -> String
headerSepLC :: forall rowSep colSep. TableStyle rowSep colSep -> String
headerSepH :: forall rowSep colSep. TableStyle rowSep colSep -> String
groupBottomH :: String
groupBottomR :: String
groupBottomL :: String
groupBottomC :: colSep -> String
groupTopH :: String
groupTopR :: String
groupTopL :: String
groupTopC :: colSep -> String
groupSepRC :: rowSep -> String
groupSepLC :: rowSep -> String
groupSepC :: rowSep -> colSep -> String
groupSepH :: rowSep -> String
groupC :: colSep -> String
groupR :: String
groupL :: String
bothHeadersB :: String
bothHeadersT :: String
bothHeadersR :: String
bothHeadersL :: String
bothHeadersBR :: String
bothHeadersBL :: String
bothHeadersTR :: String
bothHeadersTL :: String
rowHeaderC :: rowSep -> String
rowHeaderB :: String
rowHeaderT :: String
rowHeaderLeftC :: rowSep -> String
rowHeaderLeftB :: String
rowHeaderLeftT :: String
rowHeaderLeftV :: String
rowHeaderSepC :: rowSep -> rowSep -> String
rowHeaderSepBC :: String
rowHeaderSepTC :: String
rowHeaderSepV :: String
headerC :: colSep -> String
headerR :: String
headerL :: String
headerTopC :: colSep -> String
headerTopR :: String
headerTopL :: String
headerTopH :: String
headerSepC :: colSep -> colSep -> String
headerSepRC :: String
headerSepLC :: String
headerSepH :: String
.. }, [ColSpec]
[RowGroup a]
HeaderSpec rowSep r
HeaderSpec colSep c
rowGroups :: forall rowSep colSep r c a.
TableSpec rowSep colSep r c a -> [RowGroup a]
colHeader :: forall rowSep colSep r c a.
TableSpec rowSep colSep r c a -> HeaderSpec colSep c
rowHeader :: forall rowSep colSep r c a.
TableSpec rowSep colSep r c a -> HeaderSpec rowSep r
colSpecs :: forall rowSep colSep r c a.
TableSpec rowSep colSep r c a -> [ColSpec]
rowGroups :: [RowGroup a]
colHeader :: HeaderSpec colSep c
rowHeader :: HeaderSpec rowSep r
colSpecs :: [ColSpec]
..  } =
    ( (Row b -> Row b)
-> (b -> Row b -> Row b) -> Maybe b -> Row b -> Row b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Row b -> Row b
forall a. a -> a
id (:) Maybe b
optTopLine (Row b -> Row b) -> (Row b -> Row b) -> Row b -> Row b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Row b -> Row b
addColHeader (Row b -> Row b) -> Row b -> Row b
forall a b. (a -> b) -> a -> b
$ (Row b -> Row b)
-> (b -> Row b -> Row b) -> Maybe b -> Row b -> Row b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Row b -> Row b
forall a. a -> a
id (\b
b -> (Row b -> Row b -> Row b
forall a. [a] -> [a] -> [a]
++[b
b])) Maybe b
optBottomLine Row b
rowGroupLines
    , [ColModInfo]
cMIs
    )
  where
    -- Helpers for horizontal lines that will put layout characters around and
    -- in between a row of the pre-formatted grid.

    -- | Generate columns filled with 'sym', or blank spaces if 'sym' is of width 0.
    -- If there is a rowHeader, keep that separate.
    fakeColumns :: String -> String -> (Maybe b, Row b)
    fakeColumns :: String -> String -> (Maybe b, Row b)
fakeColumns String
headerSym String
groupSym =
        (String -> Int -> b
forall {a}. StringBuilder a => String -> Int -> a
replicateSym String
headerSym (Int -> b) -> (ColModInfo -> Int) -> ColModInfo -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColModInfo -> Int
widthCMI (ColModInfo -> b) -> Maybe ColModInfo -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ColModInfo
rowHeaderCMI, (Int -> b) -> [Int] -> Row b
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> b
forall {a}. StringBuilder a => String -> Int -> a
replicateSym String
groupSym) [Int]
colWidths)
      where
        replicateSym :: String -> Int -> a
replicateSym String
sym Int
w = Int -> a -> a
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid Int
q (String -> a
forall a. StringBuilder a => String -> a
stringB String
sym') a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> a
forall a. StringBuilder a => String -> a
stringB (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
r String
sym')
          where
            (Int
q, Int
r) = Int
w Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
l
            (String
sym', Int
l) = let l' :: Int
l' = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sym in if Int
l' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then (String
" ", Int
1) else (String
sym, Int
l')

    -- | Replace the content of a 'HeaderSpec' with the content of the rows or columns to be rendered,
    -- and flatten to a list of content interspersed with column/row separators. If given 'NoneHS', first
    -- replace it with the shape of the data.
    flattenWithContent :: HeaderSpec sep b -> [b] -> [a] -> [Either sep a]
flattenWithContent (NoneHS sep
sep) [b]
contentShape [a]
r = HeaderSpec sep a -> [Either sep a]
forall sep a. HeaderSpec sep a -> [Either sep a]
flattenHeader (HeaderSpec sep a -> [Either sep a])
-> (HeaderSpec sep b -> HeaderSpec sep a)
-> HeaderSpec sep b
-> [Either sep a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> a) -> HeaderSpec sep (a, b) -> HeaderSpec sep a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst (HeaderSpec sep (a, b) -> HeaderSpec sep a)
-> (HeaderSpec sep b -> HeaderSpec sep (a, b))
-> HeaderSpec sep b
-> HeaderSpec sep a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> HeaderSpec sep b -> HeaderSpec sep (a, b)
forall b sep a.
b -> [b] -> HeaderSpec sep a -> HeaderSpec sep (b, a)
zipHeader a
forall a. Monoid a => a
mempty [a]
r (HeaderSpec sep b -> [Either sep a])
-> HeaderSpec sep b -> [Either sep a]
forall a b. (a -> b) -> a -> b
$ sep -> [HeaderColSpec] -> [b] -> HeaderSpec sep b
forall sep a. sep -> [HeaderColSpec] -> [a] -> HeaderSpec sep a
fullSepH sep
sep (HeaderColSpec -> [HeaderColSpec]
forall a. a -> [a]
repeat HeaderColSpec
defHeaderColSpec) [b]
contentShape
    flattenWithContent HeaderSpec sep b
h            [b]
_            [a]
r = HeaderSpec sep a -> [Either sep a]
forall sep a. HeaderSpec sep a -> [Either sep a]
flattenHeader (HeaderSpec sep a -> [Either sep a])
-> (HeaderSpec sep (a, b) -> HeaderSpec sep a)
-> HeaderSpec sep (a, b)
-> [Either sep a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> a) -> HeaderSpec sep (a, b) -> HeaderSpec sep a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst (HeaderSpec sep (a, b) -> [Either sep a])
-> HeaderSpec sep (a, b) -> [Either sep a]
forall a b. (a -> b) -> a -> b
$ a -> [a] -> HeaderSpec sep b -> HeaderSpec sep (a, b)
forall b sep a.
b -> [b] -> HeaderSpec sep a -> HeaderSpec sep (b, a)
zipHeader a
forall a. Monoid a => a
mempty [a]
r HeaderSpec sep b
h

    -- | Intersperse a row with its rendered separators.
    withRowSeparators :: (rowSep -> Maybe b) -> [Row b] -> [Either (Maybe b) (Row b)]
    withRowSeparators :: (rowSep -> Maybe b) -> [Row b] -> [Either (Maybe b) (Row b)]
withRowSeparators rowSep -> Maybe b
renderDelimiter = (Either rowSep (Row b) -> Either (Maybe b) (Row b))
-> [Either rowSep (Row b)] -> [Either (Maybe b) (Row b)]
forall a b. (a -> b) -> [a] -> [b]
map ((rowSep -> Maybe b)
-> Either rowSep (Row b) -> Either (Maybe b) (Row b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first rowSep -> Maybe b
renderDelimiter) ([Either rowSep (Row b)] -> [Either (Maybe b) (Row b)])
-> ([Row b] -> [Either rowSep (Row b)])
-> [Row b]
-> [Either (Maybe b) (Row b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderSpec rowSep r
-> [RowGroup a] -> [Row b] -> [Either rowSep (Row b)]
forall {a} {sep} {b} {b}.
Monoid a =>
HeaderSpec sep b -> [b] -> [a] -> [Either sep a]
flattenWithContent HeaderSpec rowSep r
rowHeader [RowGroup a]
rowGroups

    -- | Intersperse a column with its rendered separators, including an optional row header.
    withColSeparators :: (colSep -> String) -> (Maybe b, Row b) -> (Maybe b, Row (Either String b))
    withColSeparators :: (colSep -> String)
-> (Maybe b, Row b) -> (Maybe b, Row (Either String b))
withColSeparators colSep -> String
renderDelimiter = (Row b -> Row (Either String b))
-> (Maybe b, Row b) -> (Maybe b, Row (Either String b))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Row b -> Row (Either String b)
renderRow
      where
        renderRow :: Row b -> Row (Either String b)
renderRow = (Either colSep b -> Either String b)
-> [Either colSep b] -> Row (Either String b)
forall a b. (a -> b) -> [a] -> [b]
map ((colSep -> String) -> Either colSep b -> Either String b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first colSep -> String
renderIfDrawn) ([Either colSep b] -> Row (Either String b))
-> (Row b -> [Either colSep b]) -> Row b -> Row (Either String b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderSpec colSep c -> [()] -> Row b -> [Either colSep b]
forall {a} {sep} {b} {b}.
Monoid a =>
HeaderSpec sep b -> [b] -> [a] -> [Either sep a]
flattenWithContent HeaderSpec colSep c
colHeader [()]
columns
        columns :: [()]
columns = [()] -> (RowGroup a -> [()]) -> Maybe (RowGroup a) -> [()]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] RowGroup a -> [()]
forall a. RowGroup a -> [()]
rowGroupShape (Maybe (RowGroup a) -> [()]) -> Maybe (RowGroup a) -> [()]
forall a b. (a -> b) -> a -> b
$ [RowGroup a] -> Maybe (RowGroup a)
forall a. [a] -> Maybe a
listToMaybe [RowGroup a]
rowGroups
        -- Render the delimiters of a column if it is drawn, otherwise return an empty string.
        renderIfDrawn :: colSep -> String
renderIfDrawn colSep
x
            -- If no delimiters are drawn in this column, return the empty string
            | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
headerV Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
groupV = String
""
            -- If this delimiter is not drawn, but others in the column are, pad with spaces
            | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
separator              = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (String -> Int
forall a. Cell a => a -> Int
visibleLength String
headerV) (String -> Int
forall a. Cell a => a -> Int
visibleLength String
groupV)) Char
' '
            -- Otherwise, just render the delimiter
            | Bool
otherwise                   = String
separator
          where
            separator :: String
separator = colSep -> String
renderDelimiter colSep
x
            headerV :: String
headerV   = colSep -> String
headerC colSep
x
            groupV :: String
groupV    = colSep -> String
groupC  colSep
x

    -- Draw a line using the specified delimiters, but only if the horizontal string is non-null
    optDrawLine :: String
-> String
-> String
-> String
-> String
-> (colSep -> String)
-> Maybe b
optDrawLine String
horizontal String
rowSep String
leftD String
rightD String
headerSepD colSep -> String
colSepD = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
horizontal Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rowSep
        then Maybe b
forall a. Maybe a
Nothing
        else b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b)
-> ((Maybe b, Row b) -> b) -> (Maybe b, Row b) -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> String
-> String
-> String
-> String
-> (Maybe b, Row (Either String b))
-> b
forall b.
StringBuilder b =>
String
-> String
-> String
-> String
-> String
-> (Maybe b, Row (Either String b))
-> b
horizontalDetailLine String
horizontal String
rowSep String
leftD String
rightD String
headerSepD ((Maybe b, Row (Either String b)) -> b)
-> ((Maybe b, Row b) -> (Maybe b, Row (Either String b)))
-> (Maybe b, Row b)
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (colSep -> String)
-> (Maybe b, Row b) -> (Maybe b, Row (Either String b))
withColSeparators colSep -> String
colSepD ((Maybe b, Row b) -> Maybe b) -> (Maybe b, Row b) -> Maybe b
forall a b. (a -> b) -> a -> b
$ String -> String -> (Maybe b, Row b)
fakeColumns String
rowSep String
horizontal
    -- Horizontal separator lines that occur in a table.
    optTopLine :: Maybe b
optTopLine        = String
-> String
-> String
-> String
-> String
-> (colSep -> String)
-> Maybe b
optDrawLine String
realTopH String
realRowHeaderT String
realTopL String
realTopR String
bothHeadersTR colSep -> String
realTopC
    optBottomLine :: Maybe b
optBottomLine     = String
-> String
-> String
-> String
-> String
-> (colSep -> String)
-> Maybe b
optDrawLine String
groupBottomH String
rowHeaderB String
realGroupBottomL String
groupBottomR String
rowHeaderSepBC colSep -> String
groupBottomC
    optGroupSepLine :: rowSep -> Maybe b
optGroupSepLine rowSep
s = String
-> String
-> String
-> String
-> String
-> (colSep -> String)
-> Maybe b
optDrawLine (rowSep -> String
groupSepH rowSep
s) (rowSep -> String
rowHeaderC rowSep
s) (rowSep -> String
realGroupSepLC rowSep
s) (rowSep -> String
groupSepRC rowSep
s) (rowSep -> rowSep -> String
rowHeaderSepC rowSep
s rowSep
s) (rowSep -> colSep -> String
groupSepC rowSep
s)
    optHeaderSepLine :: Maybe b
optHeaderSepLine  = String
-> String
-> String
-> String
-> String
-> (colSep -> String)
-> Maybe b
optDrawLine String
headerSepH String
bothHeadersB String
realHeaderSepLC String
headerSepRC String
bothHeadersBR (\colSep
x -> colSep -> colSep -> String
headerSepC colSep
x colSep
x)

    -- Vertical content lines
    rowGroupLines :: Row b
rowGroupLines = [Either (Maybe b) (Row b)] -> Row b
forall {b}. [Either (Maybe b) [b]] -> [b]
concatRowGroups ([Either (Maybe b) (Row b)] -> Row b)
-> [Either (Maybe b) (Row b)] -> Row b
forall a b. (a -> b) -> a -> b
$ (rowSep -> Maybe b) -> [Row b] -> [Either (Maybe b) (Row b)]
withRowSeparators rowSep -> Maybe b
optGroupSepLine [Row b]
linesPerRowGroup
    concatRowGroups :: [Either (Maybe b) [b]] -> [b]
concatRowGroups = (Either (Maybe b) [b] -> [b]) -> [Either (Maybe b) [b]] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Maybe b -> [b]) -> ([b] -> [b]) -> Either (Maybe b) [b] -> [b]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([b] -> (b -> [b]) -> Maybe b -> [b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] b -> [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [b] -> [b]
forall a. a -> a
id)
    linesPerRowGroup :: [Row b]
linesPerRowGroup = ((Maybe (HeaderColSpec, r), RowGroup a) -> Row b)
-> [(Maybe (HeaderColSpec, r), RowGroup a)] -> [Row b]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (HeaderColSpec, r), RowGroup a) -> Row b
rowGroupToLines ([(Maybe (HeaderColSpec, r), RowGroup a)] -> [Row b])
-> [(Maybe (HeaderColSpec, r), RowGroup a)] -> [Row b]
forall a b. (a -> b) -> a -> b
$ [RowGroup a] -> [(Maybe (HeaderColSpec, r), RowGroup a)]
forall {a}.
[RowGroup a] -> [(Maybe (HeaderColSpec, r), RowGroup a)]
addRowHeader [RowGroup a]
rowGroups
    rowGroupToLines :: (Maybe (HeaderColSpec, r), RowGroup a) -> [b]
    rowGroupToLines :: (Maybe (HeaderColSpec, r), RowGroup a) -> Row b
rowGroupToLines = ((Maybe b, Row b) -> b) -> [(Maybe b, Row b)] -> Row b
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String -> (Maybe b, Row (Either String b)) -> b
forall b.
StringBuilder b =>
String -> String -> String -> (Maybe b, Row (Either String b)) -> b
horizontalContentLine String
realLeftV String
groupR String
rowHeaderSepV ((Maybe b, Row (Either String b)) -> b)
-> ((Maybe b, Row b) -> (Maybe b, Row (Either String b)))
-> (Maybe b, Row b)
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (colSep -> String)
-> (Maybe b, Row b) -> (Maybe b, Row (Either String b))
withColSeparators colSep -> String
groupC) ([(Maybe b, Row b)] -> Row b)
-> ((Maybe (HeaderColSpec, r), RowGroup a) -> [(Maybe b, Row b)])
-> (Maybe (HeaderColSpec, r), RowGroup a)
-> Row b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (HeaderColSpec, r), RowGroup a) -> [(Maybe b, Row b)]
applyRowMods

    -- Optional values for the row header
    ([RowGroup a] -> [(Maybe (HeaderColSpec, r), RowGroup a)]
addRowHeader, Maybe ColModInfo
rowHeaderCMI, String
realLeftV, String
realHeaderTopL, String
realHeaderSepLC, rowSep -> String
realGroupSepLC, String
realGroupBottomL)
                  = case HeaderSpec rowSep r
rowHeader of
        NoneHS rowSep
_ ->
            ( (RowGroup a -> (Maybe (HeaderColSpec, r), RowGroup a))
-> [RowGroup a] -> [(Maybe (HeaderColSpec, r), RowGroup a)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (HeaderColSpec, r)
forall a. Maybe a
Nothing,)
            , Maybe ColModInfo
forall a. Maybe a
Nothing
            , String
groupL
            , String
headerTopL
            , String
headerSepLC
            , rowSep -> String
groupSepLC
            , String
groupBottomL
            )
        HeaderSpec rowSep r
_ ->
            let attachRowHeader :: [RowGroup a] -> [(Maybe (HeaderColSpec, r), RowGroup a)]
attachRowHeader [RowGroup a]
grps = ((HeaderColSpec, (RowGroup a, r))
 -> (Maybe (HeaderColSpec, r), RowGroup a))
-> [(HeaderColSpec, (RowGroup a, r))]
-> [(Maybe (HeaderColSpec, r), RowGroup a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(HeaderColSpec
hSpec, (RowGroup a
grp, r
r)) -> ((HeaderColSpec, r) -> Maybe (HeaderColSpec, r)
forall a. a -> Maybe a
Just (HeaderColSpec
hSpec, r
r), RowGroup a
grp))
                                     ([(HeaderColSpec, (RowGroup a, r))]
 -> [(Maybe (HeaderColSpec, r), RowGroup a)])
-> (HeaderSpec rowSep (RowGroup a, r)
    -> [(HeaderColSpec, (RowGroup a, r))])
-> HeaderSpec rowSep (RowGroup a, r)
-> [(Maybe (HeaderColSpec, r), RowGroup a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderSpec rowSep (RowGroup a, r)
-> [(HeaderColSpec, (RowGroup a, r))]
forall sep a. HeaderSpec sep a -> [(HeaderColSpec, a)]
headerContents (HeaderSpec rowSep (RowGroup a, r)
 -> [(Maybe (HeaderColSpec, r), RowGroup a)])
-> HeaderSpec rowSep (RowGroup a, r)
-> [(Maybe (HeaderColSpec, r), RowGroup a)]
forall a b. (a -> b) -> a -> b
$ RowGroup a
-> [RowGroup a]
-> HeaderSpec rowSep r
-> HeaderSpec rowSep (RowGroup a, r)
forall b sep a.
b -> [b] -> HeaderSpec sep a -> HeaderSpec sep (b, a)
zipHeader (Row a -> RowGroup a
forall a. Row a -> RowGroup a
rowG []) [RowGroup a]
grps HeaderSpec rowSep r
rowHeader
                singleColCMI :: [r] -> Maybe ColModInfo
singleColCMI = ColModInfo -> Maybe ColModInfo
forall a. a -> Maybe a
Just (ColModInfo -> Maybe ColModInfo)
-> ([r] -> ColModInfo) -> [r] -> Maybe ColModInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LenSpec, AlignSpec) -> [r] -> ColModInfo
forall (col :: * -> *) a.
(Foldable col, Cell a) =>
(LenSpec, AlignSpec) -> col a -> ColModInfo
deriveColModInfoFromColumnLA (LenSpec
expand, AlignSpec
noAlign)
            in
            ( [RowGroup a] -> [(Maybe (HeaderColSpec, r), RowGroup a)]
forall {a}.
[RowGroup a] -> [(Maybe (HeaderColSpec, r), RowGroup a)]
attachRowHeader
            , [r] -> Maybe ColModInfo
singleColCMI ([r] -> Maybe ColModInfo)
-> ([(HeaderColSpec, r)] -> [r])
-> [(HeaderColSpec, r)]
-> Maybe ColModInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HeaderColSpec, r) -> r) -> [(HeaderColSpec, r)] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderColSpec, r) -> r
forall a b. (a, b) -> b
snd ([(HeaderColSpec, r)] -> Maybe ColModInfo)
-> [(HeaderColSpec, r)] -> Maybe ColModInfo
forall a b. (a -> b) -> a -> b
$ HeaderSpec rowSep r -> [(HeaderColSpec, r)]
forall sep a. HeaderSpec sep a -> [(HeaderColSpec, a)]
headerContents HeaderSpec rowSep r
rowHeader
            , String
rowHeaderLeftV
            , String
bothHeadersTL
            , String
bothHeadersBL
            , rowSep -> String
rowHeaderLeftC
            , String
rowHeaderLeftB
            )

    -- Optional values for the column header
    (Row b -> Row b
addColHeader, [ColModInfo] -> [ColModInfo]
fitHeaderIntoCMIs, String
realTopH, String
realTopL, colSep -> String
realTopC, String
realTopR, String
realRowHeaderT)
                  = case HeaderSpec colSep c
colHeader of
        NoneHS colSep
_ ->
            ( Row b -> Row b
forall a. a -> a
id
            , [ColModInfo] -> [ColModInfo]
forall a. a -> a
id
            , String
groupTopH
            , String
groupTopL
            , colSep -> String
groupTopC
            , String
groupTopR
            , String
rowHeaderT
            )
        HeaderSpec colSep c
_ ->
            let headerLine :: b
headerLine = String -> String -> String -> (Maybe b, Row (Either String b)) -> b
forall b.
StringBuilder b =>
String -> String -> String -> (Maybe b, Row (Either String b)) -> b
horizontalContentLine String
headerL String
headerR String
bothHeadersR ((Maybe b, Row (Either String b)) -> b)
-> (Maybe b, Row (Either String b)) -> b
forall a b. (a -> b) -> a -> b
$ (colSep -> String)
-> (Maybe b, Row b) -> (Maybe b, Row (Either String b))
withColSeparators colSep -> String
headerC
                               (ColModInfo -> b
emptyFromCMI (ColModInfo -> b) -> Maybe ColModInfo -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ColModInfo
rowHeaderCMI, [c] -> Row b
headerRowMods [c]
hTitles)
                headerRowMods :: [c] -> Row b
headerRowMods = (HeaderColSpec -> CutMark -> ColModInfo -> c -> b)
-> [HeaderColSpec] -> [CutMark] -> [ColModInfo] -> [c] -> Row b
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 HeaderColSpec -> CutMark -> ColModInfo -> c -> b
forall a b.
(Cell a, StringBuilder b) =>
HeaderColSpec -> CutMark -> ColModInfo -> a -> b
headerCellModifier
                                         [HeaderColSpec]
headerColSpecs
                                         [CutMark]
cMSs
                                         [ColModInfo]
cMIs
                ([HeaderColSpec]
headerColSpecs, [c]
hTitles) = [(HeaderColSpec, c)] -> ([HeaderColSpec], [c])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(HeaderColSpec, c)] -> ([HeaderColSpec], [c]))
-> [(HeaderColSpec, c)] -> ([HeaderColSpec], [c])
forall a b. (a -> b) -> a -> b
$ HeaderSpec colSep c -> [(HeaderColSpec, c)]
forall sep a. HeaderSpec sep a -> [(HeaderColSpec, a)]
headerContents HeaderSpec colSep c
colHeader
            in
            ( (b
headerLine b -> Row b -> Row b
forall a. a -> [a] -> [a]
:) (Row b -> Row b) -> (Row b -> Row b) -> Row b -> Row b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row b -> Row b)
-> (b -> Row b -> Row b) -> Maybe b -> Row b -> Row b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Row b -> Row b
forall a. a -> a
id (:) Maybe b
optHeaderSepLine
            , [c] -> [Position H] -> [ColModInfo] -> [ColModInfo]
forall a.
Cell a =>
[a] -> [Position H] -> [ColModInfo] -> [ColModInfo]
fitTitlesCMI [c]
hTitles [Position H]
posSpecs
            , String
headerTopH
            , String
realHeaderTopL
            , colSep -> String
headerTopC
            , String
headerTopR
            , String
bothHeadersT
            )

    emptyFromCMI :: ColModInfo -> b
emptyFromCMI = Int -> b
forall a. StringBuilder a => Int -> a
spacesB (Int -> b) -> (ColModInfo -> Int) -> ColModInfo -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColModInfo -> Int
widthCMI

    cMSs :: [CutMark]
cMSs      = (ColSpec -> CutMark) -> [ColSpec] -> [CutMark]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> CutMark
cutMark [ColSpec]
colSpecs
    posSpecs :: [Position H]
posSpecs  = (ColSpec -> Position H) -> [ColSpec] -> [Position H]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> Position H
position [ColSpec]
colSpecs
    cMIs :: [ColModInfo]
cMIs      = [ColModInfo] -> [ColModInfo]
fitHeaderIntoCMIs ([ColModInfo] -> [ColModInfo]) -> [ColModInfo] -> [ColModInfo]
forall a b. (a -> b) -> a -> b
$ [ColSpec] -> [SegmentedColumn a] -> [ColModInfo]
forall (col :: * -> *) a.
(Foldable col, Cell a) =>
[ColSpec] -> [col a] -> [ColModInfo]
deriveColModInfosFromColumns [ColSpec]
colSpecs ([SegmentedColumn a] -> [ColModInfo])
-> [SegmentedColumn a] -> [ColModInfo]
forall a b. (a -> b) -> a -> b
$ [RowGroup a] -> [SegmentedColumn a]
forall a. Col (RowGroup a) -> [SegmentedColumn a]
transposeRowGroups [RowGroup a]
rowGroups
    rowMods :: [(b, a -> b)]
rowMods   = (Position H -> CutMark -> ColModInfo -> (b, a -> b))
-> [Position H] -> [CutMark] -> [ColModInfo] -> [(b, a -> b)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Position H
p CutMark
cm ColModInfo
cmi -> (ColModInfo -> b
emptyFromCMI ColModInfo
cmi, Position H -> CutMark -> ColModInfo -> a -> b
forall a b.
(Cell a, StringBuilder b) =>
Position H -> CutMark -> ColModInfo -> a -> b
columnModifier Position H
p CutMark
cm ColModInfo
cmi)) [Position H]
posSpecs [CutMark]
cMSs [ColModInfo]
cMIs

    rowBody :: RowGroup a -> [[b]]
    rowBody :: RowGroup a -> [Row b]
rowBody   = [(b, a -> b)] -> RowGroup a -> [Row b]
forall b a. [(b, a -> b)] -> RowGroup a -> [[b]]
mapRowGroupColumns [(b, a -> b)]
rowMods
    colWidths :: [Int]
colWidths = (ColModInfo -> Int) -> [ColModInfo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ColModInfo -> Int
widthCMI [ColModInfo]
cMIs

    -- Apply modifiers to rows, adding row headers to the first row in the group if needed
    applyRowMods  :: (Maybe (HeaderColSpec, r), RowGroup a) -> [(Maybe b, [b])]
    applyRowMods :: (Maybe (HeaderColSpec, r), RowGroup a) -> [(Maybe b, Row b)]
applyRowMods (Just (HeaderColSpec
hSpec, r
r), RowGroup a
grp) | Just ColModInfo
rCMI <- Maybe ColModInfo
rowHeaderCMI
        = [Maybe b] -> [Row b] -> [(Maybe b, Row b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (ColModInfo -> [Maybe b]
header ColModInfo
rCMI) (RowGroup a -> [Row b]
rowBody RowGroup a
grp)
      where
        header :: ColModInfo -> [Maybe b]
header ColModInfo
cMI = (b -> Maybe b) -> Row b -> [Maybe b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just (Row b -> [Maybe b]) -> Row b -> [Maybe b]
forall a b. (a -> b) -> a -> b
$ HeaderColSpec -> CutMark -> ColModInfo -> r -> b
forall a b.
(Cell a, StringBuilder b) =>
HeaderColSpec -> CutMark -> ColModInfo -> a -> b
headerCellModifier HeaderColSpec
hSpec CutMark
noCutMark ColModInfo
cMI r
r b -> Row b -> Row b
forall a. a -> [a] -> [a]
: b -> Row b
forall a. a -> [a]
repeat (ColModInfo -> b
emptyFromCMI ColModInfo
cMI)
    applyRowMods (Maybe (HeaderColSpec, r)
_, RowGroup a
grp) = (Row b -> (Maybe b, Row b)) -> [Row b] -> [(Maybe b, Row b)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe b
forall a. Maybe a
Nothing,) ([Row b] -> [(Maybe b, Row b)]) -> [Row b] -> [(Maybe b, Row b)]
forall a b. (a -> b) -> a -> b
$ RowGroup a -> [Row b]
rowBody RowGroup a
grp

-- | A version of 'tableLinesB' specialized to 'String'.
tableLines :: (Cell a, Cell r, Cell c)
           => TableSpec rowSep colSep r c a
           -> [String]
tableLines :: forall a r c rowSep colSep.
(Cell a, Cell r, Cell c) =>
TableSpec rowSep colSep r c a -> Row String
tableLines = TableSpec rowSep colSep r c a -> Row String
forall a r c b rowSep colSep.
(Cell a, Cell r, Cell c, StringBuilder b) =>
TableSpec rowSep colSep r c a -> [b]
tableLinesB

-- | A version of 'tableLinesB' that also concatenates the lines.
tableStringB :: (Cell a, Cell r, Cell c, StringBuilder b)
             => TableSpec rowSep colSep r c a
             -> b
tableStringB :: forall a r c b rowSep colSep.
(Cell a, Cell r, Cell c, StringBuilder b) =>
TableSpec rowSep colSep r c a -> b
tableStringB = [b] -> b
forall b. StringBuilder b => [b] -> b
concatLines ([b] -> b)
-> (TableSpec rowSep colSep r c a -> [b])
-> TableSpec rowSep colSep r c a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableSpec rowSep colSep r c a -> [b]
forall a r c b rowSep colSep.
(Cell a, Cell r, Cell c, StringBuilder b) =>
TableSpec rowSep colSep r c a -> [b]
tableLinesB

-- | A version of 'tableStringB' specialized to 'String'.
tableString :: (Cell a, Cell r, Cell c)
            => TableSpec rowSep colSep r c a
            -> String
tableString :: forall a r c rowSep colSep.
(Cell a, Cell r, Cell c) =>
TableSpec rowSep colSep r c a -> String
tableString = TableSpec rowSep colSep r c a -> String
forall a r c b rowSep colSep.
(Cell a, Cell r, Cell c, StringBuilder b) =>
TableSpec rowSep colSep r c a -> b
tableStringB