--------------------------------------------------------------------------------

module Codeforces.App.Table
    ( Cell(..)
    , Row
    , Table
    , makeTable
    , ColConfig
    ) where

import           Data.Text                      ( Text )
import qualified Data.Text                     as T

import           System.Console.ANSI

--------------------------------------------------------------------------------

-- | A cell of a table consists of SGR styles and some text content
data Cell = Cell [SGR] Text

cellToText :: Cell -> Text
cellToText :: Cell -> Text
cellToText (Cell [SGR]
sgrs Text
x) =
    [Text] -> Text
T.concat [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [SGR] -> String
setSGRCode [SGR]
sgrs, Text
x, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [SGR] -> String
setSGRCode [SGR
Reset]]

--------------------------------------------------------------------------------

-- | Name and width of a column
type ColConfig = (Text, Int)

type Row = [Cell]

-- | The table output is a list of row strings.
type Table = [Text]

-- | `makeTable` @colConfigs rows@ returns a list of row strings including the
-- header row
makeTable :: [ColConfig] -> [Row] -> Table
makeTable :: [ColConfig] -> [Row] -> [Text]
makeTable [ColConfig]
hs [Row]
rs = [ColConfig] -> Text
makeHeader [ColConfig]
hs Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Row -> Text) -> [Row] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([ColConfig] -> Row -> Text
makeRow [ColConfig]
hs) [Row]
rs

makeHeader :: [ColConfig] -> Text
makeHeader :: [ColConfig] -> Text
makeHeader [ColConfig]
hs = Text -> [Text] -> Text
T.intercalate Text
colSep ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ColConfig -> Text) -> [ColConfig] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
s, Int
w) -> Int -> Text -> Text
pad Int
w Text
s) [ColConfig]
hs

-- | `makeRow` @colConfigs row@ makes a row string from the supplied column
-- widths and row cells.
makeRow :: [ColConfig] -> Row -> Text
makeRow :: [ColConfig] -> Row -> Text
makeRow [ColConfig]
hs Row
row = Text -> [Text] -> Text
T.intercalate Text
colSep [Text]
paddedCells
  where
    paddedCells :: [Text]
paddedCells = (ColConfig -> Cell -> Text) -> [ColConfig] -> Row -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Text
_, Int
w) Cell
cell -> Int -> Cell -> Text
fmtCell Int
w Cell
cell) [ColConfig]
hs Row
row
    fmtCell :: Int -> Cell -> Text
fmtCell Int
w (Cell [SGR]
sgrs Text
x) = Cell -> Text
cellToText (Cell -> Text) -> Cell -> Text
forall a b. (a -> b) -> a -> b
$ [SGR] -> Text -> Cell
Cell [SGR]
sgrs (Int -> Text -> Text
pad Int
w Text
x)

colSep :: Text
colSep :: Text
colSep = Text
"  "

pad :: Int -> Text -> Text
pad :: Int -> Text -> Text
pad Int
w Text
s | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w   = Int -> Text -> Text
T.take (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".."
        | Bool
otherwise = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Text
" "
    where len :: Int
len = Text -> Int
T.length Text
s

--------------------------------------------------------------------------------