--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Patat.Presentation.Display.Table
    ( Table (..)
    , prettyTable

    , themed
    ) where


--------------------------------------------------------------------------------
import           Data.List                           (intersperse, transpose)
import           Patat.Presentation.Display.Internal
import           Patat.PrettyPrint                   ((<$$>))
import qualified Patat.PrettyPrint                   as PP
import           Patat.Theme                         (Theme (..))
import           Prelude


--------------------------------------------------------------------------------
data Table = Table
    { Table -> Doc
tCaption :: PP.Doc
    , Table -> [Alignment]
tAligns  :: [PP.Alignment]
    , Table -> [Doc]
tHeaders :: [PP.Doc]
    , Table -> [[Doc]]
tRows    :: [[PP.Doc]]
    }


--------------------------------------------------------------------------------
prettyTable :: DisplaySettings -> Table -> PP.Doc
prettyTable :: DisplaySettings -> Table -> Doc
prettyTable DisplaySettings
ds Table {[[Doc]]
[Doc]
[Alignment]
Doc
tCaption :: Table -> Doc
tAligns :: Table -> [Alignment]
tHeaders :: Table -> [Doc]
tRows :: Table -> [[Doc]]
tCaption :: Doc
tAligns :: [Alignment]
tHeaders :: [Doc]
tRows :: [[Doc]]
..} =
    Indentation Doc -> Indentation Doc -> Doc -> Doc
PP.indent Indentation Doc
indentation Indentation Doc
indentation (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Bool -> Doc -> Doc
lineIf (Bool -> Bool
not Bool
isHeaderLess) (Int -> [Doc] -> Doc
hcat2 Int
headerHeight
            [ DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeTableHeader (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                Int -> Alignment -> Doc -> Doc
PP.align Int
w Alignment
a (Int -> Doc -> Doc
vpad Int
headerHeight Doc
header)
            | (Int
w, Alignment
a, Doc
header) <- [Int] -> [Alignment] -> [Doc] -> [(Int, Alignment, Doc)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
columnWidths [Alignment]
tAligns [Doc]
tHeaders
            ]) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        DisplaySettings -> [Int] -> Doc
dashedHeaderSeparator DisplaySettings
ds [Int]
columnWidths Doc -> Doc -> Doc
<$$>
        [Doc] -> Doc
joinRows
            [ Int -> [Doc] -> Doc
hcat2 Int
rowHeight
                [ Int -> Alignment -> Doc -> Doc
PP.align Int
w Alignment
a (Int -> Doc -> Doc
vpad Int
rowHeight Doc
cell)
                | (Int
w, Alignment
a, Doc
cell) <- [Int] -> [Alignment] -> [Doc] -> [(Int, Alignment, Doc)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
columnWidths [Alignment]
tAligns [Doc]
row
                ]
            | (Int
rowHeight, [Doc]
row) <- [Int] -> [[Doc]] -> [(Int, [Doc])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
rowHeights [[Doc]]
tRows
            ] Doc -> Doc -> Doc
<$$>
        Bool -> Doc -> Doc
lineIf Bool
isHeaderLess (DisplaySettings -> [Int] -> Doc
dashedHeaderSeparator DisplaySettings
ds [Int]
columnWidths) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        Bool -> Doc -> Doc
lineIf
            (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Doc -> Bool
PP.null Doc
tCaption) (Doc
PP.hardline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"Table: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
tCaption)
  where
    indentation :: Indentation Doc
indentation = Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
2 Doc
forall a. Monoid a => a
mempty

    lineIf :: Bool -> Doc -> Doc
lineIf Bool
cond Doc
line = if Bool
cond then Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline else Doc
forall a. Monoid a => a
mempty

    joinRows :: [Doc] -> Doc
joinRows
        | ([Doc] -> Bool) -> [[Doc]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Doc -> Bool) -> [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Doc -> Bool
isSimpleCell) [[Doc]]
tRows = [Doc] -> Doc
PP.vcat
        | Bool
otherwise                    = [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
""

    isHeaderLess :: Bool
isHeaderLess = (Doc -> Bool) -> [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Doc -> Bool
PP.null [Doc]
tHeaders

    headerDimensions :: [(Int, Int)]
headerDimensions = (Doc -> (Int, Int)) -> [Doc] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> (Int, Int)
PP.dimensions [Doc]
tHeaders :: [(Int, Int)]
    rowDimensions :: [[(Int, Int)]]
rowDimensions    = ([Doc] -> [(Int, Int)]) -> [[Doc]] -> [[(Int, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> (Int, Int)) -> [Doc] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> (Int, Int)
PP.dimensions) [[Doc]]
tRows :: [[(Int, Int)]]

    columnWidths :: [Int]
    columnWidths :: [Int]
columnWidths =
        [ [Int] -> Int
safeMax (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
col)
        | [(Int, Int)]
col <- [[(Int, Int)]] -> [[(Int, Int)]]
forall a. [[a]] -> [[a]]
transpose ([(Int, Int)]
headerDimensions [(Int, Int)] -> [[(Int, Int)]] -> [[(Int, Int)]]
forall a. a -> [a] -> [a]
: [[(Int, Int)]]
rowDimensions)
        ]

    rowHeights :: [Int]
rowHeights   = ([(Int, Int)] -> Int) -> [[(Int, Int)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
safeMax ([Int] -> Int) -> ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst) [[(Int, Int)]]
rowDimensions :: [Int]
    headerHeight :: Int
headerHeight = [Int] -> Int
safeMax (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
headerDimensions)    :: Int

    vpad :: Int -> PP.Doc -> PP.Doc
    vpad :: Int -> Doc -> Doc
vpad Int
height Doc
doc =
        let (Int
actual, Int
_) = Doc -> (Int, Int)
PP.dimensions Doc
doc in
        Doc
doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
actual) Doc
PP.hardline)

    safeMax :: [Int] -> Int
safeMax = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0

    hcat2 :: Int -> [PP.Doc] -> PP.Doc
    hcat2 :: Int -> [Doc] -> Doc
hcat2 Int
rowHeight = [Doc] -> Doc
PP.paste ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (Int -> Doc
spaces2 Int
rowHeight)

    spaces2 :: Int -> PP.Doc
    spaces2 :: Int -> Doc
spaces2 Int
rowHeight =
        [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
PP.hardline ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
        Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate Int
rowHeight (String -> Doc
PP.string String
"  ")


--------------------------------------------------------------------------------
isSimpleCell :: PP.Doc -> Bool
isSimpleCell :: Doc -> Bool
isSimpleCell = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1) (Int -> Bool) -> (Doc -> Int) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Doc -> (Int, Int)) -> Doc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> (Int, Int)
PP.dimensions


--------------------------------------------------------------------------------
dashedHeaderSeparator :: DisplaySettings -> [Int] -> PP.Doc
dashedHeaderSeparator :: DisplaySettings -> [Int] -> Doc
dashedHeaderSeparator DisplaySettings
ds [Int]
columnWidths =
    [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
PP.string String
"  ")
        [ DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeTableSeparator (String -> Doc
PP.string (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
'-'))
        | Int
w <- [Int]
columnWidths
        ]