-- | This module provides primitives for generating tables. Tables are generated
-- line by line thus the functions in this module produce 'StringBuilder's that
-- contain a line.
module Text.Layout.Table.Primitives.Table where

import           Data.List

import           Text.Layout.Table.StringBuilder
import           Text.Layout.Table.Spec.Util


-- | Draw a horizontal line that will use the delimiters around the
-- appropriately and visually separate by 'hSpace'.
hLineDetail
    :: StringBuilder b
    => Char -- ^ The space character that is used as padding.
    -> Char -- ^ The delimiter that is used on the left side.
    -> Char -- ^ The delimiter that is used in between cells.
    -> Char -- ^ The delimiter that is sued on the right side.
    -> Row b -- ^ A row of builders.
    -> b -- ^ The formatted line as a 'StringBuilder'.
hLineDetail :: Char -> Char -> Char -> Char -> Row b -> b
hLineDetail Char
hSpace Char
delimL Char
delimM Char
delimR Row b
cells =
    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 (Char -> b
forall a. StringBuilder a => Char -> a
charB Char
hSpace) (Row b -> Row b) -> Row b -> Row b
forall a b. (a -> b) -> a -> b
$ Char -> b
forall a. StringBuilder a => Char -> a
charB Char
delimL b -> Row b -> Row b
forall a. a -> [a] -> [a]
: b -> Row b -> Row b
forall a. a -> [a] -> [a]
intersperse (Char -> b
forall a. StringBuilder a => Char -> a
charB Char
delimM) Row b
cells Row b -> Row b -> Row b
forall a. [a] -> [a] -> [a]
++ [Char -> b
forall a. StringBuilder a => Char -> a
charB Char
delimR]

-- | A simplified version of 'hLineDetail' that will use the same delimiter
-- for everything.
hLine
    :: StringBuilder b
    => Char -- ^ The space character that is used as padding.
    -> Char -- ^ The delimiter that is used for everything.
    -> Row b -- ^ A row of builders.
    -> b -- ^ The formatted line as a 'StringBuilder'.
hLine :: Char -> Char -> Row b -> b
hLine Char
hSpace Char
delim = Char -> Char -> Char -> Char -> Row b -> b
forall b.
StringBuilder b =>
Char -> Char -> Char -> Char -> Row b -> b
hLineDetail Char
hSpace Char
delim Char
delim Char
delim

-- | Render a line with actual content.
hLineContent
    :: StringBuilder b
    => Char -- ^ The delimiter that is used for everything.
    -> Row b -- ^ A row of builders.
    -> b
hLineContent :: Char -> Row b -> b
hLineContent = Char -> Char -> Row b -> b
forall b. StringBuilder b => Char -> Char -> Row b -> b
hLine Char
' '