{-# 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 :: [[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

table :: [[Chunk]] -> Table
table :: [[Chunk]] -> Table
table [[Chunk]]
cs =
  Table :: [[Chunk]] -> Chunk -> Maybe TableBackground -> Table
Table
    { tableCells :: [[Chunk]]
tableCells = [[Chunk]]
cs,
      tableColumnSeparator :: Chunk
tableColumnSeparator = Chunk
" ",
      tableBackground :: Maybe TableBackground
tableBackground = Maybe TableBackground
forall a. Maybe a
Nothing
    }

data Table = Table
  { -- | A list of rows. They must be of the same 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
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show, Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: 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
$cto :: forall x. Rep Table x -> Table
$cfrom :: forall x. Table -> Rep Table x
Generic)

instance Validity Table

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

instance Validity TableBackground

renderTable :: Table -> [Chunk]
renderTable :: Table -> [Chunk]
renderTable Table {[[Chunk]]
Maybe TableBackground
Chunk
tableBackground :: Maybe TableBackground
tableColumnSeparator :: Chunk
tableCells :: [[Chunk]]
tableBackground :: Table -> Maybe TableBackground
tableColumnSeparator :: Table -> Chunk
tableCells :: Table -> [[Chunk]]
..} =
  let asColumns :: [[Chunk]]
asColumns = [[Chunk]] -> [[Chunk]]
forall a. [[a]] -> [[a]]
transpose ([[Chunk]] -> [[Chunk]]
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 -> (Text -> Int
T.length (Chunk -> Text
chunkText Chunk
c), Chunk
c))
      maxLengthOfColum :: [(Int, Chunk)] -> Int
      maxLengthOfColum :: [(Int, Chunk)] -> Int
maxLengthOfColum = [Int] -> Int
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, Chunk)]
      padColumn :: Int -> [(Int, Chunk)] -> [(Chunk, Chunk)]
padColumn Int
maxLength = ((Int, Chunk) -> (Chunk, Chunk))
-> [(Int, Chunk)] -> [(Chunk, Chunk)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
l, Chunk
c) -> (Chunk
c, Int -> Char -> Chunk
paddingChunk (Int
maxLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Char
' '))
      padEntireColumn :: [(Int, Chunk)] -> [(Chunk, Chunk)]
      padEntireColumn :: [(Int, Chunk)] -> [(Chunk, Chunk)]
padEntireColumn [(Int, Chunk)]
col =
        let maxLength :: Int
maxLength = [(Int, Chunk)] -> Int
maxLengthOfColum [(Int, Chunk)]
col
         in Int -> [(Int, Chunk)] -> [(Chunk, Chunk)]
padColumn Int
maxLength [(Int, Chunk)]
col
      paddedColumns :: [[(Chunk, Chunk)]]
      paddedColumns :: [[(Chunk, Chunk)]]
paddedColumns = ([Chunk] -> [(Chunk, Chunk)]) -> [[Chunk]] -> [[(Chunk, Chunk)]]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, Chunk)] -> [(Chunk, Chunk)]
padEntireColumn ([(Int, Chunk)] -> [(Chunk, Chunk)])
-> ([Chunk] -> [(Int, Chunk)]) -> [Chunk] -> [(Chunk, Chunk)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> [(Int, Chunk)]
addLengthsToColumn) [[Chunk]]
asColumns
      paddedRows :: [[(Chunk, Chunk)]]
      paddedRows :: [[(Chunk, Chunk)]]
paddedRows = [[(Chunk, Chunk)]] -> [[(Chunk, Chunk)]]
forall a. [[a]] -> [[a]]
transpose [[(Chunk, 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)] -> [Chunk]
      renderRow :: Int -> [(Chunk, Chunk)] -> [Chunk]
renderRow Int
i = [(Chunk, Chunk)] -> [Chunk]
go
        where
          go :: [(Chunk, Chunk)] -> [Chunk]
go [] = [Chunk
"\n"]
          go [(Chunk
c, Chunk
p)] = Int -> Chunk -> Chunk
withBg Int
i Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: Int -> Chunk -> Chunk
withBg Int
i Chunk
p Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [(Chunk, Chunk)] -> [Chunk]
go []
          go ((Chunk
c1, Chunk
p1) : (Chunk, Chunk)
t2 : [(Chunk, Chunk)]
rest) = Int -> Chunk -> Chunk
withBg Int
i Chunk
c1 Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: Int -> Chunk -> Chunk
withBg Int
i Chunk
p1 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)] -> [Chunk]
go ((Chunk, Chunk)
t2 (Chunk, Chunk) -> [(Chunk, Chunk)] -> [(Chunk, Chunk)]
forall a. a -> [a] -> [a]
: [(Chunk, Chunk)]
rest)
   in [[Chunk]] -> [Chunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ (Int -> [(Chunk, Chunk)] -> [Chunk])
-> [[(Chunk, Chunk)]] -> [[Chunk]]
forall a b. (Int -> a -> b) -> [a] -> [b]
iterateLikeInPython Int -> [(Chunk, Chunk)] -> [Chunk]
renderRow [[(Chunk, Chunk)]]
paddedRows

iterateLikeInPython :: (Int -> a -> b) -> [a] -> [b]
iterateLikeInPython :: (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 ..]

padRows :: [[Chunk]] -> [[Chunk]]
padRows :: [[Chunk]] -> [[Chunk]]
padRows [] = []
padRows [[Chunk]]
css =
  let withLengths :: [(Int, [Chunk])]
withLengths = ([Chunk] -> (Int, [Chunk])) -> [[Chunk]] -> [(Int, [Chunk])]
forall a b. (a -> b) -> [a] -> [b]
map (\[Chunk]
ls -> ([Chunk] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Chunk]
ls, [Chunk]
ls)) [[Chunk]]
css
      maximumLength :: Int
maximumLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, [Chunk]) -> Int) -> [(Int, [Chunk])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Chunk]) -> Int
forall a b. (a, b) -> a
fst [(Int, [Chunk])]
withLengths
      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
""
   in ((Int, [Chunk]) -> [Chunk]) -> [(Int, [Chunk])] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Chunk]) -> [Chunk]
forall a. IsString a => (Int, [a]) -> [a]
pad [(Int, [Chunk])]
withLengths

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 :: Maybe Colour
chunkBackground = Chunk -> Maybe Colour
chunkBackground Chunk
c Maybe Colour -> Maybe Colour -> Maybe Colour
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Colour
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