{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StrictData        #-}

{-|
Module      : Headroom.UI.Table
Description : UI components for rendering tables
Copyright   : (c) 2019-2022 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module providing UI components for tables.
-}

module Headroom.UI.Table where

import qualified Headroom.Data.Text                 as T
import           RIO
import qualified RIO.List.Partial                   as LP
import qualified RIO.Text                           as T


-- | Represents two columns wide table.
newtype Table2 = Table2 [(Text, Text)] deriving (Table2 -> Table2 -> Bool
(Table2 -> Table2 -> Bool)
-> (Table2 -> Table2 -> Bool) -> Eq Table2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table2 -> Table2 -> Bool
$c/= :: Table2 -> Table2 -> Bool
== :: Table2 -> Table2 -> Bool
$c== :: Table2 -> Table2 -> Bool
Eq, Int -> Table2 -> ShowS
[Table2] -> ShowS
Table2 -> String
(Int -> Table2 -> ShowS)
-> (Table2 -> String) -> ([Table2] -> ShowS) -> Show Table2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table2] -> ShowS
$cshowList :: [Table2] -> ShowS
show :: Table2 -> String
$cshow :: Table2 -> String
showsPrec :: Int -> Table2 -> ShowS
$cshowsPrec :: Int -> Table2 -> ShowS
Show)

instance Display Table2 where
  textDisplay :: Table2 -> Text
textDisplay (Table2 [(Text, Text)]
rows) =
    let maxWidth :: Int
maxWidth = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> ([(Text, Text)] -> Int) -> [(Text, Text)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall p. (Num p, Ord p) => [p] -> p
maximum' ([Int] -> Int)
-> ([(Text, Text)] -> [Int]) -> [(Text, Text)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Int) -> [(Text, Text)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Int
T.length (Text -> Int) -> ((Text, Text) -> Text) -> (Text, Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Text)] -> Int) -> [(Text, Text)] -> Int
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
rows
        aligned :: [Text]
aligned  = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
c1, Text
c2) -> Int -> Char -> Text -> Text
T.justifyLeft Int
maxWidth Char
' ' Text
c1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c2) [(Text, Text)]
rows
    in  [Text] -> Text
T.fromLines [Text]
aligned
   where
    maximum' :: [p] -> p
maximum' [] = p
0
    maximum' [p]
xs = [p] -> p
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
LP.maximum [p]
xs