Layout.hs

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

module Text.Colour.Layout where

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

layoutAsTable :: [[Chunk]] -> [Chunk]
layoutAsTable = renderTable . table

table :: [[Chunk]] -> Table
table cs =
  Table
    { tableCells = cs,
      tableColumnSeparator = " ",
      tableBackground = Nothing
    }

data Table = Table
  { -- | A list of rows. They must be of the same length.
    tableCells :: [[Chunk]],
    tableColumnSeparator :: Chunk,
    tableBackground :: Maybe TableBackground
  }
  deriving (Show, Eq, Generic)

instance Validity Table

data TableBackground
  = SingleColour Colour
  | Bicolour
      (Maybe Colour) -- Even-numbered table rows (0-indexed)
      (Maybe Colour) -- Odd-numbered table rows
  deriving (Show, Eq, Generic)

instance Validity TableBackground

renderTable :: Table -> [Chunk]
renderTable Table {..} =
  let asColumns = transpose (padRows tableCells)
      addLengthsToColumn :: [Chunk] -> [(Int, Chunk)]
      addLengthsToColumn = map (\c -> (T.length (chunkText c), c))
      maxLengthOfColum :: [(Int, Chunk)] -> Int
      maxLengthOfColum = maximum . map fst
      padColumn :: Int -> [(Int, Chunk)] -> [(Chunk, Chunk)]
      padColumn maxLength = map (\(l, c) -> (c, paddingChunk (maxLength - l) ' '))
      padEntireColumn :: [(Int, Chunk)] -> [(Chunk, Chunk)]
      padEntireColumn col =
        let maxLength = maxLengthOfColum col
         in padColumn maxLength col
      paddedColumns :: [[(Chunk, Chunk)]]
      paddedColumns = map (padEntireColumn . addLengthsToColumn) asColumns
      paddedRows :: [[(Chunk, Chunk)]]
      paddedRows = transpose paddedColumns
      withBg :: Int -> Chunk -> Chunk
      withBg i = possiblyAddBackground $ backgroundForRow i tableBackground
      renderRow :: Int -> [(Chunk, Chunk)] -> [Chunk]
      renderRow i = go
        where
          go [] = ["\n"]
          go [(c, p)] = withBg i c : withBg i p : go []
          go ((c1, p1) : t2 : rest) = withBg i c1 : withBg i p1 : withBg i tableColumnSeparator : go (t2 : rest)
   in concat $ iterateLikeInPython renderRow paddedRows

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

padRows :: [[Chunk]] -> [[Chunk]]
padRows [] = []
padRows css =
  let withLengths = map (\ls -> (length ls, ls)) css
      maximumLength = maximum $ map fst withLengths
      pad (l, cs) = cs ++ replicate (maximumLength - l) ""
   in map pad withLengths

paddingChunk :: Int -> Char -> Chunk
paddingChunk l c = chunk $ T.pack $ replicate l c

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

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