{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Text.Colour.Layout
  ( layoutAsTable,
    layoutAsTableLines,
    table,
    Table (..),
    TableBackground (..),
    renderTable,
    renderTableLines,
  )
where

import Control.Applicative
import Data.List
import qualified Data.Text as T
import Data.Validity
import GHC.Generics (Generic)
import Text.Colour
import Text.Colour.Chunk

-- | Render as a default-settings table.
layoutAsTable :: [[[Chunk]]] -> [Chunk]
layoutAsTable :: [[[Chunk]]] -> [Chunk]
layoutAsTable = Table -> [Chunk]
renderTable (Table -> [Chunk])
-> ([[[Chunk]]] -> Table) -> [[[Chunk]]] -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Chunk]]] -> Table
table

layoutAsTableLines :: [[[Chunk]]] -> [[Chunk]]
layoutAsTableLines :: [[[Chunk]]] -> [[Chunk]]
layoutAsTableLines = Table -> [[Chunk]]
renderTableLines (Table -> [[Chunk]])
-> ([[[Chunk]]] -> Table) -> [[[Chunk]]] -> [[Chunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Chunk]]] -> Table
table

-- | Make a table with default settings
--
-- You can then update table settings by changing the fields in the resulting 'Table'.
table :: [[[Chunk]]] -> Table
table :: [[[Chunk]]] -> Table
table [[[Chunk]]]
cs =
  Table
    { tableCells :: [[[Chunk]]]
tableCells = [[[Chunk]]]
cs,
      tableColumnSeparator :: Chunk
tableColumnSeparator = Chunk
" ",
      tableBackground :: Maybe TableBackground
tableBackground = Maybe TableBackground
forall a. Maybe a
Nothing
    }

-- | Table with separator and background settings
data Table = Table
  { -- | A list of rows. They must be of the same total length.
    Table -> [[[Chunk]]]
tableCells :: [[[Chunk]]],
    Table -> Chunk
tableColumnSeparator :: Chunk,
    Table -> Maybe TableBackground
tableBackground :: Maybe TableBackground
  }
  deriving (Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Table -> ShowS
showsPrec :: Int -> Table -> ShowS
$cshow :: Table -> String
show :: Table -> String
$cshowList :: [Table] -> ShowS
showList :: [Table] -> ShowS
Show, Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
/= :: Table -> Table -> Bool
Eq, (forall x. Table -> Rep Table x)
-> (forall x. Rep Table x -> Table) -> Generic Table
forall x. Rep Table x -> Table
forall x. Table -> Rep Table x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Table -> Rep Table x
from :: forall x. Table -> Rep Table x
$cto :: forall x. Rep Table x -> Table
to :: forall x. Rep Table x -> Table
Generic)

instance Validity Table

data TableBackground
  = SingleColour Colour
  | Bicolour
      -- Even-numbered table rows (0-indexed)
      (Maybe Colour)
      -- Odd-numbered table rows
      (Maybe Colour)
  deriving (Int -> TableBackground -> ShowS
[TableBackground] -> ShowS
TableBackground -> String
(Int -> TableBackground -> ShowS)
-> (TableBackground -> String)
-> ([TableBackground] -> ShowS)
-> Show TableBackground
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableBackground -> ShowS
showsPrec :: Int -> TableBackground -> ShowS
$cshow :: TableBackground -> String
show :: TableBackground -> String
$cshowList :: [TableBackground] -> ShowS
showList :: [TableBackground] -> ShowS
Show, TableBackground -> TableBackground -> Bool
(TableBackground -> TableBackground -> Bool)
-> (TableBackground -> TableBackground -> Bool)
-> Eq TableBackground
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableBackground -> TableBackground -> Bool
== :: TableBackground -> TableBackground -> Bool
$c/= :: TableBackground -> TableBackground -> Bool
/= :: TableBackground -> TableBackground -> Bool
Eq, (forall x. TableBackground -> Rep TableBackground x)
-> (forall x. Rep TableBackground x -> TableBackground)
-> Generic TableBackground
forall x. Rep TableBackground x -> TableBackground
forall x. TableBackground -> Rep TableBackground x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableBackground -> Rep TableBackground x
from :: forall x. TableBackground -> Rep TableBackground x
$cto :: forall x. Rep TableBackground x -> TableBackground
to :: forall x. Rep TableBackground x -> TableBackground
Generic)

instance Validity TableBackground

-- | Render a table to chunks that can be rendered to text.
renderTable :: Table -> [Chunk]
renderTable :: Table -> [Chunk]
renderTable = [[Chunk]] -> [Chunk]
unlinesChunks ([[Chunk]] -> [Chunk]) -> (Table -> [[Chunk]]) -> Table -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> [[Chunk]]
renderTableLines

renderTableLines :: Table -> [[Chunk]]
renderTableLines :: Table -> [[Chunk]]
renderTableLines Table {[[[Chunk]]]
Maybe TableBackground
Chunk
tableCells :: Table -> [[[Chunk]]]
tableColumnSeparator :: Table -> Chunk
tableBackground :: Table -> Maybe TableBackground
tableCells :: [[[Chunk]]]
tableColumnSeparator :: Chunk
tableBackground :: Maybe TableBackground
..} =
  let asColumns :: [[[Chunk]]]
      asColumns :: [[[Chunk]]]
asColumns = [[[Chunk]]] -> [[[Chunk]]]
forall a. [[a]] -> [[a]]
transpose ([Chunk] -> [[[Chunk]]] -> [[[Chunk]]]
forall a. a -> [[a]] -> [[a]]
padRows [] [[[Chunk]]]
tableCells)

      addLengthsToColumn :: [[Chunk]] -> [(Int, [Chunk])]
      addLengthsToColumn :: [[Chunk]] -> [(Int, [Chunk])]
addLengthsToColumn = ([Chunk] -> (Int, [Chunk])) -> [[Chunk]] -> [(Int, [Chunk])]
forall a b. (a -> b) -> [a] -> [b]
map (\[Chunk]
c -> ([Chunk] -> Int
cellWidth [Chunk]
c, [Chunk]
c))
      maxLengthOfColum :: [(Int, [Chunk])] -> Int
      maxLengthOfColum :: [(Int, [Chunk])] -> Int
maxLengthOfColum = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int)
-> ([(Int, [Chunk])] -> [Int]) -> [(Int, [Chunk])] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [Chunk]) -> Int) -> [(Int, [Chunk])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Chunk]) -> Int
forall a b. (a, b) -> a
fst
      padColumn :: Int -> [(Int, [Chunk])] -> [[Chunk]]
      padColumn :: Int -> [(Int, [Chunk])] -> [[Chunk]]
padColumn Int
maxLength = ((Int, [Chunk]) -> [Chunk]) -> [(Int, [Chunk])] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
l, [Chunk]
c) -> [Chunk]
c [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [Int -> Char -> Chunk
paddingChunk (Int
maxLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Char
' '])
      padEntireColumn :: [(Int, [Chunk])] -> [[Chunk]]
      padEntireColumn :: [(Int, [Chunk])] -> [[Chunk]]
padEntireColumn [(Int, [Chunk])]
col =
        let maxLength :: Int
maxLength = [(Int, [Chunk])] -> Int
maxLengthOfColum [(Int, [Chunk])]
col
         in Int -> [(Int, [Chunk])] -> [[Chunk]]
padColumn Int
maxLength [(Int, [Chunk])]
col
      paddedColumns :: [[[Chunk]]]
      paddedColumns :: [[[Chunk]]]
paddedColumns = ([[Chunk]] -> [[Chunk]]) -> [[[Chunk]]] -> [[[Chunk]]]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, [Chunk])] -> [[Chunk]]
padEntireColumn ([(Int, [Chunk])] -> [[Chunk]])
-> ([[Chunk]] -> [(Int, [Chunk])]) -> [[Chunk]] -> [[Chunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Chunk]] -> [(Int, [Chunk])]
addLengthsToColumn) [[[Chunk]]]
asColumns
      paddedRows :: [[[Chunk]]]
      paddedRows :: [[[Chunk]]]
paddedRows = [[[Chunk]]] -> [[[Chunk]]]
forall a. [[a]] -> [[a]]
transpose [[[Chunk]]]
paddedColumns

      withBg :: Int -> Chunk -> Chunk
      withBg :: Int -> Chunk -> Chunk
withBg Int
i = Maybe Colour -> Chunk -> Chunk
possiblyAddBackground (Maybe Colour -> Chunk -> Chunk) -> Maybe Colour -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Int -> Maybe TableBackground -> Maybe Colour
backgroundForRow Int
i Maybe TableBackground
tableBackground
      renderRow :: Int -> [[Chunk]] -> [Chunk]
      renderRow :: Int -> [[Chunk]] -> [Chunk]
renderRow Int
i = [[Chunk]] -> [Chunk]
go
        where
          go :: [[Chunk]] -> [Chunk]
          go :: [[Chunk]] -> [Chunk]
go [] = []
          go [[Chunk]
cs] = (Chunk -> Chunk) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Chunk -> Chunk
withBg Int
i) [Chunk]
cs [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [[Chunk]] -> [Chunk]
go []
          go ([Chunk]
cs1 : [Chunk]
cs2 : [[Chunk]]
rest) =
            (Chunk -> Chunk) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Chunk -> Chunk
withBg Int
i) [Chunk]
cs1
              [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [Int -> Chunk -> Chunk
withBg Int
i Chunk
tableColumnSeparator]
              [Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++ [[Chunk]] -> [Chunk]
go ([Chunk]
cs2 [Chunk] -> [[Chunk]] -> [[Chunk]]
forall a. a -> [a] -> [a]
: [[Chunk]]
rest)
   in (Int -> [[Chunk]] -> [Chunk]) -> [[[Chunk]]] -> [[Chunk]]
forall a b. (Int -> a -> b) -> [a] -> [b]
iterateLikeInPython Int -> [[Chunk]] -> [Chunk]
renderRow [[[Chunk]]]
paddedRows

iterateLikeInPython :: (Int -> a -> b) -> [a] -> [b]
iterateLikeInPython :: forall a b. (Int -> a -> b) -> [a] -> [b]
iterateLikeInPython Int -> a -> b
f = (Int -> a -> b) -> [Int] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> a -> b
f [Int
0 ..]

-- | Make every row contain the same number of cells, irrespective of the
-- width of the cells.
--
-- Use the first argument to fill as the extra cells.
padRows :: forall a. a -> [[a]] -> [[a]]
padRows :: forall a. a -> [[a]] -> [[a]]
padRows a
_ [] = []
padRows a
d [[a]]
css =
  let withLengths :: [(Int, [a])]
      withLengths :: [(Int, [a])]
withLengths = ([a] -> (Int, [a])) -> [[a]] -> [(Int, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\[a]
ls -> ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls, [a]
ls)) [[a]]
css
      maximumLength :: Int
      maximumLength :: Int
maximumLength = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, [a]) -> Int) -> [(Int, [a])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [a]) -> Int
forall a b. (a, b) -> a
fst [(Int, [a])]
withLengths
      pad :: (Int, [a]) -> [a]
      pad :: (Int, [a]) -> [a]
pad (Int
l, [a]
cs) = [a]
cs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
maximumLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) a
d
   in ((Int, [a]) -> [a]) -> [(Int, [a])] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [a]) -> [a]
pad [(Int, [a])]
withLengths

cellWidth :: [Chunk] -> Int
cellWidth :: [Chunk] -> Int
cellWidth = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Chunk] -> [Int]) -> [Chunk] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> Int) -> [Chunk] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Int
chunkWidth

paddingChunk :: Int -> Char -> Chunk
paddingChunk :: Int -> Char -> Chunk
paddingChunk Int
l Char
c = Text -> Chunk
chunk (Text -> Chunk) -> Text -> Chunk
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
l Char
c

possiblyAddBackground :: Maybe Colour -> Chunk -> Chunk
possiblyAddBackground :: Maybe Colour -> Chunk -> Chunk
possiblyAddBackground Maybe Colour
mb Chunk
c = Chunk
c {chunkBackground = chunkBackground c <|> mb}

backgroundForRow :: Int -> Maybe TableBackground -> Maybe Colour
backgroundForRow :: Int -> Maybe TableBackground -> Maybe Colour
backgroundForRow Int
_ Maybe TableBackground
Nothing = Maybe Colour
forall a. Maybe a
Nothing
backgroundForRow Int
_ (Just (SingleColour Colour
c)) = Colour -> Maybe Colour
forall a. a -> Maybe a
Just Colour
c
backgroundForRow Int
i (Just (Bicolour Maybe Colour
ec Maybe Colour
oc)) = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
i then Maybe Colour
ec else Maybe Colour
oc