-- | This module provides predefined styles, combinators to modify them,
-- abstract style descriptions, and combinators for quickly turning them into
-- styles.
--
-- The following resource may be useful for constructing your own primitive
-- styles: <https://en.wikipedia.org/wiki/Box-drawing_character>.

{-# LANGUAGE RecordWildCards #-}

module Text.Layout.Table.Style
    ( -- * Pre-Constructed Table Styles
      -- ** ASCII
      -- These styles use only ASCII characters.
      asciiS
    , asciiRoundS
    , asciiDoubleS

      -- ** Unicode
    , unicodeS
    , unicodeBoldHeaderS
    , unicodeRoundS
    , unicodeBoldS
    , unicodeBoldStripedS
    , unicodeDoubleFrameS

      -- * Combinators
    , withoutBorders
    , withoutTopBorder
    , withoutBottomBorder
    , withoutLeftBorder
    , withoutRightBorder
    , withRoundCorners
    , inheritStyle
    , inheritStyleHeaderGroup

      -- * Construct Table Styles from an Abstract Specification
    , asciiTableStyleFromSpec
    , roundedAsciiTableStyleFromSpec
    , unicodeTableStyleFromSpec
    , tableStyleFromSpec

      -- ** Construct an Abstract Specifiction
    , TableStyleSpec(..)
    , simpleTableStyleSpec
    , setTableStyleSpecSeparator

      -- * Low-Level Styling Facility
    , TableStyle(..)
    ) where

import Text.Layout.Table.LineStyle

-- | Specifies the different letters to construct the non-content structure of a
-- table.
--
-- This is quite low-level and difficult to construct by hand. If you want to
-- construct your own, you may wish to use the higher-level interface provided
-- by (in increasing order of detail):
--
--   1. 'simpleTableStyleSpec'
--   2. 'TableStyleSpec'
--   3. 'unicodeTableStyleFromSpec'
--   4. 'asciiTableStyleFromSpec'
--   5. 'tableStyleFromSpec'
data TableStyle rowSep colSep
    = TableStyle
    -- Within the column header but not the row header (11 cases)
    { forall rowSep colSep. TableStyle rowSep colSep -> String
headerSepH     :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
headerSepLC    :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
headerSepRC    :: String
    , forall rowSep colSep.
TableStyle rowSep colSep -> colSep -> colSep -> String
headerSepC     :: colSep -> colSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
headerTopH     :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
headerTopL     :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
headerTopR     :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
headerTopC     :: colSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
headerL        :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
headerR        :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
headerC        :: colSep -> String
    -- Within the row header but not the column header (11 cases)
    , forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderSepV  :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderSepTC :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderSepBC :: String
    , forall rowSep colSep.
TableStyle rowSep colSep -> rowSep -> rowSep -> String
rowHeaderSepC  :: rowSep -> rowSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderLeftV :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderLeftT :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderLeftB :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
rowHeaderLeftC :: rowSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderT     :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
rowHeaderB     :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
rowHeaderC     :: rowSep -> String
    -- Within the intersection of the row and column headers (8 cases)
    , forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersTL  :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersTR  :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersBL  :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersBR  :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersL   :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersR   :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersT   :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
bothHeadersB   :: String
    -- Main body of the table, in neither the row or column headers (15 cases)
    , forall rowSep colSep. TableStyle rowSep colSep -> String
groupL         :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
groupR         :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
groupC         :: colSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
groupSepH      :: rowSep -> String
    , forall rowSep colSep.
TableStyle rowSep colSep -> rowSep -> colSep -> String
groupSepC      :: rowSep -> colSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
groupSepLC     :: rowSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
groupSepRC     :: rowSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
groupTopC      :: colSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
groupTopL      :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
groupTopR      :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
groupTopH      :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
groupBottomC   :: colSep -> String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
groupBottomL   :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
groupBottomR   :: String
    , forall rowSep colSep. TableStyle rowSep colSep -> String
groupBottomH   :: String
    }

-- | Inherit from a 'TableStyle' through a pair of functions.
inheritStyle :: (c -> a)        -- ^ The function to transform the row labels.
             -> (d -> b)        -- ^ The function to transform the column labels.
             -> TableStyle a b  -- ^ The 'TableStyle' to inherit from.
             -> TableStyle c d
inheritStyle :: forall c a d b.
(c -> a) -> (d -> b) -> TableStyle a b -> TableStyle c d
inheritStyle c -> a
f d -> b
g = (c -> a)
-> (c -> a)
-> (d -> b)
-> (d -> b)
-> TableStyle a b
-> TableStyle c d
forall c a d b.
(c -> a)
-> (c -> a)
-> (d -> b)
-> (d -> b)
-> TableStyle a b
-> TableStyle c d
inheritStyleHeaderGroup c -> a
f c -> a
f d -> b
g d -> b
g

-- | Inherit from a 'TableStyle' using a triple of functions, specifying the
-- correspondence for row separators, column heading separators, and column separators.
inheritStyleHeaderGroup :: (c -> a)        -- ^ The function to transform the row labels in the header.
                        -> (c -> a)        -- ^ The function to transform the row labels in the body.
                        -> (d -> b)        -- ^ The function to transform the column labels in the header.
                        -> (d -> b)        -- ^ The function to transform the column labels in the body.
                        -> TableStyle a b  -- ^ The 'TableStyle' to inherit from.
                        -> TableStyle c d
inheritStyleHeaderGroup :: forall c a d b.
(c -> a)
-> (c -> a)
-> (d -> b)
-> (d -> b)
-> TableStyle a b
-> TableStyle c d
inheritStyleHeaderGroup c -> a
rowHead c -> a
row d -> b
colHead d -> b
col TableStyle a b
ts =
    TableStyle a b
ts { headerSepC :: d -> d -> String
headerSepC     = \d
a d
b -> TableStyle a b -> b -> b -> String
forall rowSep colSep.
TableStyle rowSep colSep -> colSep -> colSep -> String
headerSepC TableStyle a b
ts (d -> b
colHead d
a) (d -> b
col d
b)
       , headerTopC :: d -> String
headerTopC     = TableStyle a b -> b -> String
forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
headerTopC     TableStyle a b
ts (b -> String) -> (d -> b) -> d -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> b
colHead
       , headerC :: d -> String
headerC        = TableStyle a b -> b -> String
forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
headerC        TableStyle a b
ts (b -> String) -> (d -> b) -> d -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> b
colHead
       , rowHeaderSepC :: c -> c -> String
rowHeaderSepC  = \c
a c
b -> TableStyle a b -> a -> a -> String
forall rowSep colSep.
TableStyle rowSep colSep -> rowSep -> rowSep -> String
rowHeaderSepC TableStyle a b
ts (c -> a
rowHead c
a) (c -> a
rowHead c
b)
       , rowHeaderLeftC :: c -> String
rowHeaderLeftC = TableStyle a b -> a -> String
forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
rowHeaderLeftC TableStyle a b
ts (a -> String) -> (c -> a) -> c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> a
rowHead
       , rowHeaderC :: c -> String
rowHeaderC     = TableStyle a b -> a -> String
forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
rowHeaderC     TableStyle a b
ts (a -> String) -> (c -> a) -> c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> a
rowHead
       , groupC :: d -> String
groupC         = TableStyle a b -> b -> String
forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
groupC         TableStyle a b
ts (b -> String) -> (d -> b) -> d -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> b
col
       , groupSepH :: c -> String
groupSepH      = TableStyle a b -> a -> String
forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
groupSepH      TableStyle a b
ts (a -> String) -> (c -> a) -> c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> a
row
       , groupSepC :: c -> d -> String
groupSepC      = \c
a d
b -> TableStyle a b -> a -> b -> String
forall rowSep colSep.
TableStyle rowSep colSep -> rowSep -> colSep -> String
groupSepC TableStyle a b
ts (c -> a
row c
a) (d -> b
col d
b)
       , groupSepLC :: c -> String
groupSepLC     = TableStyle a b -> a -> String
forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
groupSepLC     TableStyle a b
ts (a -> String) -> (c -> a) -> c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> a
row
       , groupSepRC :: c -> String
groupSepRC     = TableStyle a b -> a -> String
forall rowSep colSep. TableStyle rowSep colSep -> rowSep -> String
groupSepRC     TableStyle a b
ts (a -> String) -> (c -> a) -> c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> a
row
       , groupTopC :: d -> String
groupTopC      = TableStyle a b -> b -> String
forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
groupTopC      TableStyle a b
ts (b -> String) -> (d -> b) -> d -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> b
col
       , groupBottomC :: d -> String
groupBottomC   = TableStyle a b -> b -> String
forall rowSep colSep. TableStyle rowSep colSep -> colSep -> String
groupBottomC   TableStyle a b
ts (b -> String) -> (d -> b) -> d -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> b
col
       }

-- | Remove the top, bottom, left, and right borders from a 'TableStyle'.
withoutBorders :: TableStyle a b -> TableStyle a b
withoutBorders :: forall a b. TableStyle a b -> TableStyle a b
withoutBorders = TableStyle a b -> TableStyle a b
forall a b. TableStyle a b -> TableStyle a b
withoutTopBorder (TableStyle a b -> TableStyle a b)
-> (TableStyle a b -> TableStyle a b)
-> TableStyle a b
-> TableStyle a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableStyle a b -> TableStyle a b
forall a b. TableStyle a b -> TableStyle a b
withoutBottomBorder (TableStyle a b -> TableStyle a b)
-> (TableStyle a b -> TableStyle a b)
-> TableStyle a b
-> TableStyle a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableStyle a b -> TableStyle a b
forall a b. TableStyle a b -> TableStyle a b
withoutLeftBorder (TableStyle a b -> TableStyle a b)
-> (TableStyle a b -> TableStyle a b)
-> TableStyle a b
-> TableStyle a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableStyle a b -> TableStyle a b
forall a b. TableStyle a b -> TableStyle a b
withoutRightBorder

-- | Remove the top border from a 'TableStyle'.
withoutTopBorder :: TableStyle a b -> TableStyle a b
withoutTopBorder :: forall a b. TableStyle a b -> TableStyle a b
withoutTopBorder TableStyle a b
ts = TableStyle a b
ts { headerTopH :: String
headerTopH = String
"", headerTopL :: String
headerTopL = String
"", headerTopR :: String
headerTopR = String
"", headerTopC :: b -> String
headerTopC = String -> b -> String
forall a b. a -> b -> a
const String
""
                         , rowHeaderLeftT :: String
rowHeaderLeftT = String
"", rowHeaderT :: String
rowHeaderT = String
"", rowHeaderSepTC :: String
rowHeaderSepTC = String
""
                         , bothHeadersTL :: String
bothHeadersTL = String
"", bothHeadersTR :: String
bothHeadersTR = String
"", bothHeadersT :: String
bothHeadersT = String
""
                         , groupTopC :: b -> String
groupTopC = String -> b -> String
forall a b. a -> b -> a
const String
"", groupTopL :: String
groupTopL = String
"", groupTopR :: String
groupTopR = String
"", groupTopH :: String
groupTopH = String
""
                         }

-- | Remove the bottom border from a 'TableStyle'.
withoutBottomBorder :: TableStyle a b -> TableStyle a b
withoutBottomBorder :: forall a b. TableStyle a b -> TableStyle a b
withoutBottomBorder TableStyle a b
ts = TableStyle a b
ts { rowHeaderLeftB :: String
rowHeaderLeftB = String
"", rowHeaderB :: String
rowHeaderB = String
"", rowHeaderSepBC :: String
rowHeaderSepBC = String
""
                            , groupBottomC :: b -> String
groupBottomC = String -> b -> String
forall a b. a -> b -> a
const String
"", groupBottomL :: String
groupBottomL = String
"", groupBottomR :: String
groupBottomR = String
"", groupBottomH :: String
groupBottomH = String
"" }

-- | Remove the left border from a 'TableStyle'.
withoutLeftBorder :: TableStyle a b -> TableStyle a b
withoutLeftBorder :: forall a b. TableStyle a b -> TableStyle a b
withoutLeftBorder TableStyle a b
ts = TableStyle a b
ts { headerSepLC :: String
headerSepLC = String
"", headerTopL :: String
headerTopL = String
"", headerL :: String
headerL = String
""
                          , rowHeaderLeftV :: String
rowHeaderLeftV = String
"", rowHeaderLeftT :: String
rowHeaderLeftT = String
"", rowHeaderLeftB :: String
rowHeaderLeftB = String
"", rowHeaderLeftC :: a -> String
rowHeaderLeftC = String -> a -> String
forall a b. a -> b -> a
const String
""
                          , bothHeadersTL :: String
bothHeadersTL = String
"", bothHeadersBL :: String
bothHeadersBL = String
"", bothHeadersL :: String
bothHeadersL = String
""
                          , groupL :: String
groupL = String
"", groupSepLC :: a -> String
groupSepLC = String -> a -> String
forall a b. a -> b -> a
const String
"", groupTopL :: String
groupTopL = String
"", groupBottomL :: String
groupBottomL = String
""
                          }

-- | Remove the right border from a 'TableStyle'.
withoutRightBorder :: TableStyle a b -> TableStyle a b
withoutRightBorder :: forall a b. TableStyle a b -> TableStyle a b
withoutRightBorder TableStyle a b
ts = TableStyle a b
ts { headerSepRC :: String
headerSepRC = String
"", headerTopR :: String
headerTopR = String
"", headerR :: String
headerR = String
""
                           , groupR :: String
groupR = String
"", groupSepRC :: a -> String
groupSepRC = String -> a -> String
forall a b. a -> b -> a
const String
"", groupTopR :: String
groupTopR = String
"", groupBottomR :: String
groupBottomR = String
""
                           }

-- | Modify a 'TableStyle' to use Unicode rounded corners.
withRoundCorners :: TableStyle a b -> TableStyle a b
withRoundCorners :: forall a b. TableStyle a b -> TableStyle a b
withRoundCorners TableStyle a b
ts = TableStyle a b
ts { headerTopL :: String
headerTopL     = String
"╭"
                         , rowHeaderLeftT :: String
rowHeaderLeftT = String
"╭"
                         , bothHeadersTL :: String
bothHeadersTL  = String
"╭"
                         , groupTopL :: String
groupTopL      = String
"╭"
                         , headerTopR :: String
headerTopR     = String
"╮"
                         , groupTopR :: String
groupTopR      = String
"╮"
                         , rowHeaderLeftB :: String
rowHeaderLeftB = String
"╰"
                         , groupBottomL :: String
groupBottomL   = String
"╰"
                         , groupBottomR :: String
groupBottomR   = String
"╯"
                         }

-- | A short-hand specification for generating Unicode table styles, by
-- specifying the line type of each of the main lines.
data TableStyleSpec
    = TableStyleSpec
    { TableStyleSpec -> LineStyle
headerSep         :: LineStyle
    , TableStyleSpec -> LineStyle
headerTop         :: LineStyle
    , TableStyleSpec -> LineStyle
headerLeft        :: LineStyle
    , TableStyleSpec -> LineStyle
headerRight       :: LineStyle
    , TableStyleSpec -> LineStyle
rowHeaderSep      :: LineStyle
    , TableStyleSpec -> LineStyle
rowHeaderLeft     :: LineStyle
    , TableStyleSpec -> LineStyle
rowHeaderTop      :: LineStyle
    , TableStyleSpec -> LineStyle
rowHeaderBottom   :: LineStyle
    , TableStyleSpec -> LineStyle
bothHeadersTop    :: LineStyle
    , TableStyleSpec -> LineStyle
bothHeadersBottom :: LineStyle
    , TableStyleSpec -> LineStyle
bothHeadersLeft   :: LineStyle
    , TableStyleSpec -> LineStyle
bothHeadersRight  :: LineStyle
    , TableStyleSpec -> LineStyle
groupLeft         :: LineStyle
    , TableStyleSpec -> LineStyle
groupRight        :: LineStyle
    , TableStyleSpec -> LineStyle
groupTop          :: LineStyle
    , TableStyleSpec -> LineStyle
groupBottom       :: LineStyle
    }

-- | Constructs a simple 'TableStyleSpec' which uses the given 'LineStyle's in
-- the headers and group, respectively.
simpleTableStyleSpec :: LineStyle -> LineStyle -> TableStyleSpec
simpleTableStyleSpec :: LineStyle -> LineStyle -> TableStyleSpec
simpleTableStyleSpec LineStyle
headerStyle LineStyle
groupStyle
    = TableStyleSpec :: LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> LineStyle
-> TableStyleSpec
TableStyleSpec
    { headerSep :: LineStyle
headerSep         = LineStyle
headerStyle
    , headerTop :: LineStyle
headerTop         = LineStyle
headerStyle
    , headerLeft :: LineStyle
headerLeft        = LineStyle
headerStyle
    , headerRight :: LineStyle
headerRight       = LineStyle
headerStyle
    , rowHeaderSep :: LineStyle
rowHeaderSep      = LineStyle
headerStyle
    , rowHeaderLeft :: LineStyle
rowHeaderLeft     = LineStyle
headerStyle
    , rowHeaderTop :: LineStyle
rowHeaderTop      = LineStyle
headerStyle
    , rowHeaderBottom :: LineStyle
rowHeaderBottom   = LineStyle
headerStyle
    , bothHeadersTop :: LineStyle
bothHeadersTop    = LineStyle
headerStyle
    , bothHeadersBottom :: LineStyle
bothHeadersBottom = LineStyle
headerStyle
    , bothHeadersLeft :: LineStyle
bothHeadersLeft   = LineStyle
headerStyle
    , bothHeadersRight :: LineStyle
bothHeadersRight  = LineStyle
headerStyle
    , groupLeft :: LineStyle
groupLeft         = LineStyle
groupStyle
    , groupRight :: LineStyle
groupRight        = LineStyle
groupStyle
    , groupTop :: LineStyle
groupTop          = LineStyle
groupStyle
    , groupBottom :: LineStyle
groupBottom       = LineStyle
groupStyle
    }

-- Generate an ASCII 'TableStyle' from a 'TableStyleSpec' using pluses for joins.
asciiTableStyleFromSpec :: TableStyleSpec -> TableStyle LineStyle LineStyle
asciiTableStyleFromSpec :: TableStyleSpec -> TableStyle LineStyle LineStyle
asciiTableStyleFromSpec = (LineStyle -> String)
-> (LineStyle -> String)
-> (LineStyle -> LineStyle -> LineStyle -> LineStyle -> String)
-> TableStyleSpec
-> TableStyle LineStyle LineStyle
tableStyleFromSpec LineStyle -> String
asciiHorizontal LineStyle -> String
asciiVertical LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
asciiJoinString4

-- Generate an ASCII 'TableStyle' from a 'TableStyleSpec' using rounded joins.
roundedAsciiTableStyleFromSpec :: TableStyleSpec -> TableStyle LineStyle LineStyle
roundedAsciiTableStyleFromSpec :: TableStyleSpec -> TableStyle LineStyle LineStyle
roundedAsciiTableStyleFromSpec = (LineStyle -> String)
-> (LineStyle -> String)
-> (LineStyle -> LineStyle -> LineStyle -> LineStyle -> String)
-> TableStyleSpec
-> TableStyle LineStyle LineStyle
tableStyleFromSpec LineStyle -> String
asciiHorizontal LineStyle -> String
asciiVertical LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
roundedAsciiJoinString4

-- Generate a unicode 'TableStyle' from a 'TableStyleSpec'.
unicodeTableStyleFromSpec :: TableStyleSpec -> TableStyle LineStyle LineStyle
unicodeTableStyleFromSpec :: TableStyleSpec -> TableStyle LineStyle LineStyle
unicodeTableStyleFromSpec = (LineStyle -> String)
-> (LineStyle -> String)
-> (LineStyle -> LineStyle -> LineStyle -> LineStyle -> String)
-> TableStyleSpec
-> TableStyle LineStyle LineStyle
tableStyleFromSpec LineStyle -> String
unicodeHorizontal LineStyle -> String
unicodeVertical LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
unicodeJoinString4

-- | Generate a 'TableStyle from a given 'TableStyleSpec', along with functions
-- to construct horizontal and vertical lines and joins.
-- The function for constructing join strings takes its arguments in the order
-- west, east, north, south.
tableStyleFromSpec :: (LineStyle -> String) -> (LineStyle -> String)
                   -> (LineStyle -> LineStyle -> LineStyle -> LineStyle -> String)
                   -> TableStyleSpec
                   -> TableStyle LineStyle LineStyle
tableStyleFromSpec :: (LineStyle -> String)
-> (LineStyle -> String)
-> (LineStyle -> LineStyle -> LineStyle -> LineStyle -> String)
-> TableStyleSpec
-> TableStyle LineStyle LineStyle
tableStyleFromSpec LineStyle -> String
hString LineStyle -> String
vString LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString TableStyleSpec { LineStyle
groupBottom :: LineStyle
groupTop :: LineStyle
groupRight :: LineStyle
groupLeft :: LineStyle
bothHeadersRight :: LineStyle
bothHeadersLeft :: LineStyle
bothHeadersBottom :: LineStyle
bothHeadersTop :: LineStyle
rowHeaderBottom :: LineStyle
rowHeaderTop :: LineStyle
rowHeaderLeft :: LineStyle
rowHeaderSep :: LineStyle
headerRight :: LineStyle
headerLeft :: LineStyle
headerTop :: LineStyle
headerSep :: LineStyle
groupBottom :: TableStyleSpec -> LineStyle
groupTop :: TableStyleSpec -> LineStyle
groupRight :: TableStyleSpec -> LineStyle
groupLeft :: TableStyleSpec -> LineStyle
bothHeadersRight :: TableStyleSpec -> LineStyle
bothHeadersLeft :: TableStyleSpec -> LineStyle
bothHeadersBottom :: TableStyleSpec -> LineStyle
bothHeadersTop :: TableStyleSpec -> LineStyle
rowHeaderBottom :: TableStyleSpec -> LineStyle
rowHeaderTop :: TableStyleSpec -> LineStyle
rowHeaderLeft :: TableStyleSpec -> LineStyle
rowHeaderSep :: TableStyleSpec -> LineStyle
headerRight :: TableStyleSpec -> LineStyle
headerLeft :: TableStyleSpec -> LineStyle
headerTop :: TableStyleSpec -> LineStyle
headerSep :: TableStyleSpec -> LineStyle
.. }
    = TableStyle :: forall rowSep colSep.
String
-> String
-> String
-> (colSep -> colSep -> String)
-> String
-> String
-> String
-> (colSep -> String)
-> String
-> String
-> (colSep -> String)
-> String
-> String
-> String
-> (rowSep -> rowSep -> String)
-> String
-> String
-> String
-> (rowSep -> String)
-> String
-> String
-> (rowSep -> String)
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> (colSep -> String)
-> (rowSep -> String)
-> (rowSep -> colSep -> String)
-> (rowSep -> String)
-> (rowSep -> String)
-> (colSep -> String)
-> String
-> String
-> String
-> (colSep -> String)
-> String
-> String
-> String
-> TableStyle rowSep colSep
TableStyle
    { headerSepH :: String
headerSepH     = LineStyle -> String
hString LineStyle
headerSep
    , headerSepLC :: String
headerSepLC    = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
headerSep LineStyle
headerLeft LineStyle
groupLeft
    , headerSepRC :: String
headerSepRC    = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
headerSep LineStyle
NoLine LineStyle
headerRight LineStyle
groupRight
    , headerSepC :: LineStyle -> LineStyle -> String
headerSepC     = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
headerSep LineStyle
headerSep
    , headerTopH :: String
headerTopH     = LineStyle -> String
hString LineStyle
headerTop
    , headerTopL :: String
headerTopL     = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
headerTop LineStyle
NoLine LineStyle
headerLeft
    , headerTopR :: String
headerTopR     = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
headerTop LineStyle
NoLine LineStyle
NoLine LineStyle
headerRight
    , headerTopC :: LineStyle -> String
headerTopC     = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
headerTop LineStyle
headerTop LineStyle
NoLine
    , headerL :: String
headerL        = LineStyle -> String
vString LineStyle
headerLeft
    , headerR :: String
headerR        = LineStyle -> String
vString LineStyle
headerRight
    , headerC :: LineStyle -> String
headerC        = LineStyle -> String
vString
    , rowHeaderSepV :: String
rowHeaderSepV  = LineStyle -> String
vString LineStyle
rowHeaderSep
    , rowHeaderSepTC :: String
rowHeaderSepTC = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
rowHeaderTop LineStyle
groupTop LineStyle
NoLine LineStyle
rowHeaderSep
    , rowHeaderSepBC :: String
rowHeaderSepBC = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
rowHeaderBottom LineStyle
groupBottom LineStyle
rowHeaderSep LineStyle
NoLine
    , rowHeaderSepC :: LineStyle -> LineStyle -> String
rowHeaderSepC  = \LineStyle
h LineStyle
g -> LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
h LineStyle
g LineStyle
rowHeaderSep LineStyle
rowHeaderSep
    , rowHeaderLeftV :: String
rowHeaderLeftV = LineStyle -> String
vString LineStyle
rowHeaderLeft
    , rowHeaderLeftT :: String
rowHeaderLeftT = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
rowHeaderTop LineStyle
NoLine LineStyle
rowHeaderLeft
    , rowHeaderLeftB :: String
rowHeaderLeftB = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
rowHeaderBottom LineStyle
rowHeaderLeft LineStyle
NoLine
    , rowHeaderLeftC :: LineStyle -> String
rowHeaderLeftC = \LineStyle
h -> LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
h LineStyle
rowHeaderLeft LineStyle
rowHeaderLeft
    , rowHeaderT :: String
rowHeaderT     = LineStyle -> String
hString LineStyle
rowHeaderTop
    , rowHeaderB :: String
rowHeaderB     = LineStyle -> String
hString LineStyle
rowHeaderBottom
    , rowHeaderC :: LineStyle -> String
rowHeaderC     = LineStyle -> String
hString
    , bothHeadersTL :: String
bothHeadersTL  = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
bothHeadersTop LineStyle
NoLine LineStyle
bothHeadersLeft
    , bothHeadersTR :: String
bothHeadersTR  = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
bothHeadersTop LineStyle
headerTop LineStyle
NoLine LineStyle
bothHeadersRight
    , bothHeadersBL :: String
bothHeadersBL  = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
bothHeadersBottom LineStyle
bothHeadersLeft LineStyle
rowHeaderLeft
    , bothHeadersBR :: String
bothHeadersBR  = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
bothHeadersBottom LineStyle
headerSep LineStyle
bothHeadersRight LineStyle
rowHeaderSep
    , bothHeadersL :: String
bothHeadersL   = LineStyle -> String
vString LineStyle
bothHeadersLeft
    , bothHeadersR :: String
bothHeadersR   = LineStyle -> String
vString LineStyle
bothHeadersRight
    , bothHeadersT :: String
bothHeadersT   = LineStyle -> String
hString LineStyle
bothHeadersTop
    , bothHeadersB :: String
bothHeadersB   = LineStyle -> String
hString LineStyle
bothHeadersBottom
    , groupL :: String
groupL         = LineStyle -> String
vString LineStyle
groupLeft
    , groupR :: String
groupR         = LineStyle -> String
vString LineStyle
groupRight
    , groupC :: LineStyle -> String
groupC         = LineStyle -> String
vString
    , groupSepH :: LineStyle -> String
groupSepH      = LineStyle -> String
hString
    , groupSepC :: LineStyle -> LineStyle -> String
groupSepC      = \LineStyle
h LineStyle
v -> LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
h LineStyle
h LineStyle
v LineStyle
v
    , groupSepLC :: LineStyle -> String
groupSepLC     = \LineStyle
h -> LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
h LineStyle
groupLeft LineStyle
groupLeft
    , groupSepRC :: LineStyle -> String
groupSepRC     = \LineStyle
h -> LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
h LineStyle
NoLine LineStyle
groupRight LineStyle
groupRight
    , groupTopC :: LineStyle -> String
groupTopC      = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
groupTop LineStyle
groupTop LineStyle
NoLine
    , groupTopL :: String
groupTopL      = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
groupTop LineStyle
NoLine LineStyle
groupLeft
    , groupTopR :: String
groupTopR      = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
groupTop LineStyle
NoLine LineStyle
NoLine LineStyle
groupRight
    , groupTopH :: String
groupTopH      = LineStyle -> String
hString LineStyle
groupTop
    , groupBottomC :: LineStyle -> String
groupBottomC   = \LineStyle
v -> LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
groupBottom LineStyle
groupBottom LineStyle
v LineStyle
NoLine
    , groupBottomL :: String
groupBottomL   = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
NoLine LineStyle
groupBottom LineStyle
groupLeft LineStyle
NoLine
    , groupBottomR :: String
groupBottomR   = LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
joinString LineStyle
groupBottom LineStyle
NoLine LineStyle
groupRight LineStyle
NoLine
    , groupBottomH :: String
groupBottomH   = LineStyle -> String
hString LineStyle
groupBottom
    }

-- | Modify a 'TableStyleSpec' to use the given 'LineStyle' for header separators.
setTableStyleSpecSeparator :: LineStyle -> TableStyleSpec -> TableStyleSpec
setTableStyleSpecSeparator :: LineStyle -> TableStyleSpec -> TableStyleSpec
setTableStyleSpecSeparator LineStyle
sep TableStyleSpec
spec =
    TableStyleSpec
spec { headerSep :: LineStyle
headerSep = LineStyle
sep, rowHeaderSep :: LineStyle
rowHeaderSep = LineStyle
sep, bothHeadersBottom :: LineStyle
bothHeadersBottom = LineStyle
sep, bothHeadersRight :: LineStyle
bothHeadersRight = LineStyle
sep }

-- | My usual ASCII table style.
asciiRoundS :: TableStyle LineStyle LineStyle
asciiRoundS :: TableStyle LineStyle LineStyle
asciiRoundS = (LineStyle -> String)
-> (LineStyle -> String)
-> (LineStyle -> LineStyle -> LineStyle -> LineStyle -> String)
-> TableStyleSpec
-> TableStyle LineStyle LineStyle
tableStyleFromSpec LineStyle -> String
asciiHorizontal LineStyle -> String
asciiVertical LineStyle -> LineStyle -> LineStyle -> LineStyle -> String
roundedAsciiJoinString4 (TableStyleSpec -> TableStyle LineStyle LineStyle)
-> TableStyleSpec -> TableStyle LineStyle LineStyle
forall a b. (a -> b) -> a -> b
$
    LineStyle -> LineStyle -> TableStyleSpec
simpleTableStyleSpec LineStyle
SingleLine LineStyle
SingleLine

-- | Uses lines and plus for joints.
asciiS :: TableStyle LineStyle LineStyle
asciiS :: TableStyle LineStyle LineStyle
asciiS = TableStyleSpec -> TableStyle LineStyle LineStyle
asciiTableStyleFromSpec (TableStyleSpec -> TableStyle LineStyle LineStyle)
-> TableStyleSpec -> TableStyle LineStyle LineStyle
forall a b. (a -> b) -> a -> b
$ LineStyle -> LineStyle -> TableStyleSpec
simpleTableStyleSpec LineStyle
SingleLine LineStyle
SingleLine

-- | Like 'asciiS', but uses double lines and double pluses for borders.
asciiDoubleS :: TableStyle LineStyle LineStyle
asciiDoubleS :: TableStyle LineStyle LineStyle
asciiDoubleS = TableStyleSpec -> TableStyle LineStyle LineStyle
asciiTableStyleFromSpec (TableStyleSpec -> TableStyle LineStyle LineStyle)
-> TableStyleSpec -> TableStyle LineStyle LineStyle
forall a b. (a -> b) -> a -> b
$ LineStyle -> LineStyle -> TableStyleSpec
simpleTableStyleSpec LineStyle
DoubleLine LineStyle
SingleLine

-- | Uses special unicode characters to draw clean thin boxes.
unicodeS :: TableStyle LineStyle LineStyle
unicodeS :: TableStyle LineStyle LineStyle
unicodeS = TableStyleSpec -> TableStyle LineStyle LineStyle
unicodeTableStyleFromSpec (TableStyleSpec -> TableStyle LineStyle LineStyle)
-> (TableStyleSpec -> TableStyleSpec)
-> TableStyleSpec
-> TableStyle LineStyle LineStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineStyle -> TableStyleSpec -> TableStyleSpec
setTableStyleSpecSeparator LineStyle
DoubleLine (TableStyleSpec -> TableStyle LineStyle LineStyle)
-> TableStyleSpec -> TableStyle LineStyle LineStyle
forall a b. (a -> b) -> a -> b
$
    LineStyle -> LineStyle -> TableStyleSpec
simpleTableStyleSpec LineStyle
SingleLine LineStyle
SingleLine

-- | Same as 'unicodeS' but uses bold headers.
unicodeBoldHeaderS :: TableStyle LineStyle LineStyle
unicodeBoldHeaderS :: TableStyle LineStyle LineStyle
unicodeBoldHeaderS = (LineStyle -> LineStyle)
-> (LineStyle -> LineStyle)
-> (LineStyle -> LineStyle)
-> (LineStyle -> LineStyle)
-> TableStyle LineStyle LineStyle
-> TableStyle LineStyle LineStyle
forall c a d b.
(c -> a)
-> (c -> a)
-> (d -> b)
-> (d -> b)
-> TableStyle a b
-> TableStyle c d
inheritStyleHeaderGroup LineStyle -> LineStyle
makeLineBold LineStyle -> LineStyle
forall a. a -> a
id LineStyle -> LineStyle
makeLineBold LineStyle -> LineStyle
forall a. a -> a
id (TableStyle LineStyle LineStyle -> TableStyle LineStyle LineStyle)
-> (TableStyleSpec -> TableStyle LineStyle LineStyle)
-> TableStyleSpec
-> TableStyle LineStyle LineStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    TableStyleSpec -> TableStyle LineStyle LineStyle
unicodeTableStyleFromSpec (TableStyleSpec -> TableStyle LineStyle LineStyle)
-> TableStyleSpec -> TableStyle LineStyle LineStyle
forall a b. (a -> b) -> a -> b
$ LineStyle -> LineStyle -> TableStyleSpec
simpleTableStyleSpec LineStyle
HeavyLine LineStyle
SingleLine

-- | Like 'unicodeS' but with rounded edges.
unicodeRoundS :: TableStyle LineStyle LineStyle
unicodeRoundS :: TableStyle LineStyle LineStyle
unicodeRoundS = TableStyle LineStyle LineStyle -> TableStyle LineStyle LineStyle
forall a b. TableStyle a b -> TableStyle a b
withRoundCorners TableStyle LineStyle LineStyle
unicodeS

-- | Uses bold lines.
unicodeBoldS :: TableStyle LineStyle LineStyle
unicodeBoldS :: TableStyle LineStyle LineStyle
unicodeBoldS = TableStyleSpec -> TableStyle LineStyle LineStyle
unicodeTableStyleFromSpec (TableStyleSpec -> TableStyle LineStyle LineStyle)
-> TableStyleSpec -> TableStyle LineStyle LineStyle
forall a b. (a -> b) -> a -> b
$ LineStyle -> LineStyle -> TableStyleSpec
simpleTableStyleSpec LineStyle
HeavyLine LineStyle
HeavyLine

-- | Uses bold lines with the exception of group separators, which are striped.
unicodeBoldStripedS :: TableStyle LineStyle LineStyle
unicodeBoldStripedS :: TableStyle LineStyle LineStyle
unicodeBoldStripedS = TableStyle LineStyle LineStyle
unicodeBoldS
                    { groupSepLC :: LineStyle -> String
groupSepLC = String -> LineStyle -> String
forall a b. a -> b -> a
const (String -> LineStyle -> String) -> String -> LineStyle -> String
forall a b. (a -> b) -> a -> b
$ LineStyle -> String
unicodeVertical LineStyle
HeavyLine
                    , groupSepRC :: LineStyle -> String
groupSepRC = String -> LineStyle -> String
forall a b. a -> b -> a
const (String -> LineStyle -> String) -> String -> LineStyle -> String
forall a b. (a -> b) -> a -> b
$ LineStyle -> String
unicodeVertical LineStyle
HeavyLine
                    , groupSepC :: LineStyle -> LineStyle -> String
groupSepC  = (LineStyle -> String) -> LineStyle -> LineStyle -> String
forall a b. a -> b -> a
const LineStyle -> String
unicodeVertical
                    }

-- | Draw every line with a double frame.
unicodeDoubleFrameS :: TableStyle LineStyle LineStyle
unicodeDoubleFrameS :: TableStyle LineStyle LineStyle
unicodeDoubleFrameS = TableStyleSpec -> TableStyle LineStyle LineStyle
unicodeTableStyleFromSpec (TableStyleSpec -> TableStyle LineStyle LineStyle)
-> TableStyleSpec -> TableStyle LineStyle LineStyle
forall a b. (a -> b) -> a -> b
$ LineStyle -> LineStyle -> TableStyleSpec
simpleTableStyleSpec LineStyle
DoubleLine LineStyle
DoubleLine