-- | 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 #-}
module Text.Layout.Table
    ( -- * Layout combinators
      -- | 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
      -- ** Length of columns
    , LenSpec
    , expand
    , fixed
    , expandUntil
    , fixedUntil
      -- ** Positional alignment
    , Position
    , H
    , left
    , right
    , center
      -- ** Alignment of cells at characters
    , AlignSpec
    , noAlign
    , charAlign
    , predAlign
    , dotAlign
      -- ** Cut marks
    , CutMark
    , noCutMark
    , singleCutMark
    , doubleCutMark

      -- * Basic grid layout
    , Row
    , grid
    , gridLines
    , gridString
    , concatRow
    , concatLines
    , concatGrid

      -- * Grid modification functions
    , altLines
    , checkeredCells

      -- * Table layout
      -- ** Grouping rows
    , RowGroup
    , rowsG
    , rowG
    , colsG
    , colsAllG

      -- ** Headers
    , HeaderColSpec
    , headerColumn
    , HeaderSpec
    , fullH
    , titlesH

      -- ** Layout
    , tableLines
    , tableString

      -- * Text justification
      -- $justify
    , justify
    , justifyText

      -- * Vertical column positioning
    , Col
    , colsAsRowsAll
    , colsAsRows
    , top
    , bottom
    , V

      -- * Table styles
    , module Text.Layout.Table.Style

      -- * Column modification functions
    , pad
    , trimOrPad
    , align
    , alignFixed

      -- * 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
    , deriveColModInfos
    , deriveAlignInfo
    , OccSpec
    ) where

-- TODO AlignSpec:   multiple alignment points - useful?
-- TODO RowGroup:    optional: vertical group labels
-- 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.List
import           Data.Default.Class
import           Data.Default.Instances.Base                 ()

import           Text.Layout.Table.Cell
import           Text.Layout.Table.Justify
import           Text.Layout.Table.Primitives.AlignInfo
import           Text.Layout.Table.Primitives.Basic
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.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
forall a. Default a => a
def Position H
right AlignSpec
dotAlign CutMark
forall a. Default a => a
def

-- | 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
forall a. Default a => a
def CutMark
forall a. Default a => a
def

-- | 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.
grid :: Cell a => [ColSpec] -> [Row a] -> [Row String]
grid :: [ColSpec] -> [Row a] -> [Row String]
grid [ColSpec]
specs [Row a]
tab = ((a -> String) -> a -> String)
-> [a -> String] -> Row a -> Row String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
($) ([ColSpec] -> [Row a] -> [a -> String]
forall a b.
(Cell a, StringBuilder b) =>
[ColSpec] -> [Row a] -> [a -> b]
deriveColMods [ColSpec]
specs [Row a]
tab) (Row a -> Row String) -> [Row a] -> [Row String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row a]
tab

-- | Behaves like 'grid' but produces lines by joining with whitespace.
gridLines :: Cell a => [ColSpec] -> [Row a] -> [String]
gridLines :: [ColSpec] -> [Row a] -> Row String
gridLines [ColSpec]
specs = (Row String -> String) -> [Row String] -> Row String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Row String -> String
unwords ([Row String] -> Row String)
-> ([Row a] -> [Row String]) -> [Row a] -> Row String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ColSpec] -> [Row a] -> [Row String]
forall a. Cell a => [ColSpec] -> [Row a] -> [Row String]
grid [ColSpec]
specs

-- | Behaves like 'gridLines' but produces a string by joining with the newline
-- character.
gridString :: Cell a => [ColSpec] -> [Row a] -> String
gridString :: [ColSpec] -> [Row a] -> String
gridString [ColSpec]
specs = Row String -> String
forall b. StringBuilder b => [b] -> b
concatLines (Row String -> String)
-> ([Row a] -> Row String) -> [Row a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ColSpec] -> [Row a] -> Row String
forall a. Cell a => [ColSpec] -> [Row a] -> Row String
gridLines [ColSpec]
specs

concatLines :: StringBuilder b => [b] -> b
concatLines :: [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 :: 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

concatGrid :: StringBuilder b => Int -> [Row b] -> b
concatGrid :: Int -> [Row b] -> b
concatGrid Int
n = Row b -> b
forall b. StringBuilder b => [b] -> b
concatLines (Row b -> b) -> ([Row b] -> Row b) -> [Row b] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
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 :: [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 :: (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 :: Monoid a => [Position V] -> [Col a] -> RowGroup a
colsG :: [Position V] -> [Col a] -> RowGroup a
colsG [Position V]
ps = [Col a] -> RowGroup a
forall a. [Row a] -> RowGroup a
rowsG ([Col a] -> RowGroup a)
-> ([Col a] -> [Col a]) -> [Col a] -> RowGroup a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Position V] -> [Col a] -> [Col a]
forall a. Monoid a => [Position V] -> [Col a] -> [Col a]
colsAsRows [Position V]
ps

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

-- | Layouts a pretty table with an optional header. Note that providing fewer
-- layout specifications than columns or vice versa will result in not showing
-- the redundant ones.
tableLines :: Cell a
           => [ColSpec]  -- ^ Layout specification of columns
           -> TableStyle -- ^ Visual table style
           -> HeaderSpec -- ^ Optional header details
           -> [RowGroup a] -- ^ Rows which form a cell together
           -> [String]
tableLines :: [ColSpec] -> TableStyle -> HeaderSpec -> [RowGroup a] -> Row String
tableLines [ColSpec]
specs TableStyle { Char
groupBottomH :: TableStyle -> Char
groupBottomR :: TableStyle -> Char
groupBottomL :: TableStyle -> Char
groupBottomC :: TableStyle -> Char
groupTopH :: TableStyle -> Char
groupTopR :: TableStyle -> Char
groupTopL :: TableStyle -> Char
groupTopC :: TableStyle -> Char
groupSepRC :: TableStyle -> Char
groupSepLC :: TableStyle -> Char
groupSepC :: TableStyle -> Char
groupSepH :: TableStyle -> Char
groupV :: TableStyle -> Char
headerV :: TableStyle -> Char
headerTopH :: TableStyle -> Char
headerTopC :: TableStyle -> Char
headerTopR :: TableStyle -> Char
headerTopL :: TableStyle -> Char
headerSepC :: TableStyle -> Char
headerSepRC :: TableStyle -> Char
headerSepLC :: TableStyle -> Char
headerSepH :: TableStyle -> Char
groupBottomH :: Char
groupBottomR :: Char
groupBottomL :: Char
groupBottomC :: Char
groupTopH :: Char
groupTopR :: Char
groupTopL :: Char
groupTopC :: Char
groupSepRC :: Char
groupSepLC :: Char
groupSepC :: Char
groupSepH :: Char
groupV :: Char
headerV :: Char
headerTopH :: Char
headerTopC :: Char
headerTopR :: Char
headerTopL :: Char
headerSepC :: Char
headerSepRC :: Char
headerSepLC :: Char
headerSepH :: Char
.. } HeaderSpec
header [RowGroup a]
rowGroups =
    String
topLine String -> Row String -> Row String
forall a. a -> [a] -> [a]
: Row String -> Row String
addHeaderLines (Row String
rowGroupLines Row String -> Row String -> Row String
forall a. [a] -> [a] -> [a]
++ [String
bottomLine])
  where
    -- Helpers for horizontal lines that will put layout characters arround and
    -- in between a row of the pre-formatted grid.

    -- | Generate columns filled with 'sym'.
    fakeColumns :: Char -> Row String
fakeColumns Char
sym
                  = (Int -> String) -> [Int] -> Row String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char -> String
forall a. StringBuilder a => Int -> Char -> a
`replicateCharB` Char
sym) [Int]
colWidths

    -- Horizontal seperator lines that occur in a table.
    topLine :: String
topLine       = Char -> Char -> Char -> Char -> Row String -> String
forall b.
StringBuilder b =>
Char -> Char -> Char -> Char -> Row b -> b
hLineDetail Char
realTopH Char
realTopL Char
realTopC Char
realTopR (Row String -> String) -> Row String -> String
forall a b. (a -> b) -> a -> b
$ Char -> Row String
fakeColumns Char
realTopH
    bottomLine :: String
bottomLine    = Char -> Char -> Char -> Char -> Row String -> String
forall b.
StringBuilder b =>
Char -> Char -> Char -> Char -> Row b -> b
hLineDetail Char
groupBottomH Char
groupBottomL Char
groupBottomC Char
groupBottomR (Row String -> String) -> Row String -> String
forall a b. (a -> b) -> a -> b
$ Char -> Row String
fakeColumns Char
groupBottomH
    groupSepLine :: String
groupSepLine  = Char -> Char -> Char -> Char -> Row String -> String
forall b.
StringBuilder b =>
Char -> Char -> Char -> Char -> Row b -> b
hLineDetail Char
groupSepH Char
groupSepLC Char
groupSepC Char
groupSepRC (Row String -> String) -> Row String -> String
forall a b. (a -> b) -> a -> b
$ Char -> Row String
fakeColumns Char
groupSepH
    headerSepLine :: String
headerSepLine = Char -> Char -> Char -> Char -> Row String -> String
forall b.
StringBuilder b =>
Char -> Char -> Char -> Char -> Row b -> b
hLineDetail Char
headerSepH Char
headerSepLC Char
headerSepC Char
headerSepRC (Row String -> String) -> Row String -> String
forall a b. (a -> b) -> a -> b
$ Char -> Row String
fakeColumns Char
headerSepH

    -- Vertical content lines
    rowGroupLines :: Row String
rowGroupLines =
        Row String -> [Row String] -> Row String
forall a. [a] -> [[a]] -> [a]
intercalate [String
groupSepLine] ([Row String] -> Row String) -> [Row String] -> Row String
forall a b. (a -> b) -> a -> b
$ (RowGroup a -> Row String) -> [RowGroup a] -> [Row String]
forall a b. (a -> b) -> [a] -> [b]
map ((Row String -> String) -> [Row String] -> Row String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Row String -> String
forall b. StringBuilder b => Char -> Row b -> b
hLineContent Char
groupV) ([Row String] -> Row String)
-> (RowGroup a -> [Row String]) -> RowGroup a -> Row String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [Row String]
applyRowMods ([[a]] -> [Row String])
-> (RowGroup a -> [[a]]) -> RowGroup a -> [Row String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowGroup a -> [[a]]
forall a. RowGroup a -> [Row a]
rows) [RowGroup a]
rowGroups

    -- Optional values for the header
    (Row String -> Row String
addHeaderLines, [ColModInfo] -> [ColModInfo]
fitHeaderIntoCMIs, Char
realTopH, Char
realTopL, Char
realTopC, Char
realTopR)
                  = case HeaderSpec
header of
        HeaderHS [HeaderColSpec]
headerColSpecs Row String
hTitles
               ->
            let headerLine :: String
headerLine    = Char -> Row String -> String
forall b. StringBuilder b => Char -> Row b -> b
hLineContent Char
headerV (((String -> String) -> String -> String)
-> [String -> String] -> Row String -> Row String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
($) [String -> String]
headerRowMods Row String
hTitles)
                headerRowMods :: [String -> String]
headerRowMods = (HeaderColSpec -> CutMark -> ColModInfo -> String -> String)
-> [HeaderColSpec]
-> [CutMark]
-> [ColModInfo]
-> [String -> String]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 HeaderColSpec -> CutMark -> ColModInfo -> String -> String
headerCellModifier
                                         [HeaderColSpec]
headerColSpecs
                                         [CutMark]
cMSs
                                         [ColModInfo]
cMIs
            in
            ( (String
headerLine String -> Row String -> Row String
forall a. a -> [a] -> [a]
:) (Row String -> Row String)
-> (Row String -> Row String) -> Row String -> Row String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
headerSepLine String -> Row String -> Row String
forall a. a -> [a] -> [a]
:)
            , Row String -> [Position H] -> [ColModInfo] -> [ColModInfo]
fitTitlesCMI Row String
hTitles [Position H]
posSpecs
            , Char
headerTopH
            , Char
headerTopL
            , Char
headerTopC
            , Char
headerTopR
            )
        HeaderSpec
NoneHS ->
            ( Row String -> Row String
forall a. a -> a
id
            , [ColModInfo] -> [ColModInfo]
forall a. a -> a
id
            , Char
groupTopH
            , Char
groupTopL
            , Char
groupTopC
            , Char
groupTopR
            )

    cMSs :: [CutMark]
cMSs          = (ColSpec -> CutMark) -> [ColSpec] -> [CutMark]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> CutMark
cutMark [ColSpec]
specs
    posSpecs :: [Position H]
posSpecs      = (ColSpec -> Position H) -> [ColSpec] -> [Position H]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> Position H
position [ColSpec]
specs
    applyRowMods :: [[a]] -> [Row String]
applyRowMods  = ([a] -> Row String) -> [[a]] -> [Row String]
forall a b. (a -> b) -> [a] -> [b]
map (((a -> String) -> a -> String)
-> [a -> String] -> [a] -> Row String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
($) [a -> String]
rowMods)
    rowMods :: [a -> String]
rowMods       = (Position H -> CutMark -> ColModInfo -> a -> String)
-> [Position H] -> [CutMark] -> [ColModInfo] -> [a -> String]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Position H -> CutMark -> ColModInfo -> a -> String
forall a b.
(Cell a, StringBuilder b) =>
Position H -> CutMark -> ColModInfo -> a -> b
columnModifier [Position H]
posSpecs [CutMark]
cMSs [ColModInfo]
cMIs
    cMIs :: [ColModInfo]
cMIs          = [ColModInfo] -> [ColModInfo]
fitHeaderIntoCMIs ([ColModInfo] -> [ColModInfo]) -> [ColModInfo] -> [ColModInfo]
forall a b. (a -> b) -> a -> b
$ [ColSpec] -> [[a]] -> [ColModInfo]
forall a. Cell a => [ColSpec] -> [Row a] -> [ColModInfo]
deriveColModInfos' [ColSpec]
specs ([[a]] -> [ColModInfo]) -> [[a]] -> [ColModInfo]
forall a b. (a -> b) -> a -> b
$ (RowGroup a -> [[a]]) -> [RowGroup a] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RowGroup a -> [[a]]
forall a. RowGroup a -> [Row a]
rows [RowGroup a]
rowGroups
    colWidths :: [Int]
colWidths     = (ColModInfo -> Int) -> [ColModInfo] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ColModInfo -> Int
widthCMI [ColModInfo]
cMIs

-- | Does the same as 'tableLines', but concatenates lines.
tableString :: Cell a
            => [ColSpec]  -- ^ Layout specification of columns
            -> TableStyle -- ^ Visual table style
            -> HeaderSpec -- ^ Optional header details
            -> [RowGroup a] -- ^ Rows which form a cell together
            -> String
tableString :: [ColSpec] -> TableStyle -> HeaderSpec -> [RowGroup a] -> String
tableString [ColSpec]
specs TableStyle
style HeaderSpec
header [RowGroup a]
rowGroups = Row String -> String
forall b. StringBuilder b => [b] -> b
concatLines (Row String -> String) -> Row String -> String
forall a b. (a -> b) -> a -> b
$ [ColSpec] -> TableStyle -> HeaderSpec -> [RowGroup a] -> Row String
forall a.
Cell a =>
[ColSpec] -> TableStyle -> HeaderSpec -> [RowGroup a] -> Row String
tableLines [ColSpec]
specs TableStyle
style HeaderSpec
header [RowGroup a]
rowGroups

-------------------------------------------------------------------------------
-- Text justification
-------------------------------------------------------------------------------

-- $justify
-- Text can easily be justified and distributed over multiple lines. Such
-- columns can be combined with other columns.