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

    , themed
    ) where


--------------------------------------------------------------------------------
import           Data.List         (intersperse, transpose)
import           Patat.PrettyPrint ((<$$>))
import qualified Patat.PrettyPrint as PP
import           Patat.Theme       (Theme (..))
import qualified Patat.Theme       as 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
    :: Theme -> Table -> PP.Doc
prettyTable :: Theme -> Table -> Doc
prettyTable theme :: Theme
theme@Theme {Maybe Text
Maybe SyntaxHighlighting
Maybe Style
themeSyntaxHighlighting :: Theme -> Maybe SyntaxHighlighting
themeImageTarget :: Theme -> Maybe Style
themeImageText :: Theme -> Maybe Style
themeMath :: Theme -> Maybe Style
themeQuoted :: Theme -> Maybe Style
themeStrikeout :: Theme -> Maybe Style
themeLinkTarget :: Theme -> Maybe Style
themeLinkText :: Theme -> Maybe Style
themeCode :: Theme -> Maybe Style
themeUnderline :: Theme -> Maybe Style
themeStrong :: Theme -> Maybe Style
themeEmph :: Theme -> Maybe Style
themeLineBlock :: Theme -> Maybe Style
themeTableSeparator :: Theme -> Maybe Style
themeTableHeader :: Theme -> Maybe Style
themeDefinitionList :: Theme -> Maybe Style
themeDefinitionTerm :: Theme -> Maybe Style
themeBlockQuote :: Theme -> Maybe Style
themeOrderedList :: Theme -> Maybe Style
themeBulletListMarkers :: Theme -> Maybe Text
themeBulletList :: Theme -> Maybe Style
themeCodeBlock :: Theme -> Maybe Style
themeHeader :: Theme -> Maybe Style
themeBorders :: Theme -> Maybe Style
themeSyntaxHighlighting :: Maybe SyntaxHighlighting
themeImageTarget :: Maybe Style
themeImageText :: Maybe Style
themeMath :: Maybe Style
themeQuoted :: Maybe Style
themeStrikeout :: Maybe Style
themeLinkTarget :: Maybe Style
themeLinkText :: Maybe Style
themeCode :: Maybe Style
themeUnderline :: Maybe Style
themeStrong :: Maybe Style
themeEmph :: Maybe Style
themeLineBlock :: Maybe Style
themeTableSeparator :: Maybe Style
themeTableHeader :: Maybe Style
themeDefinitionList :: Maybe Style
themeDefinitionTerm :: Maybe Style
themeBlockQuote :: Maybe Style
themeOrderedList :: Maybe Style
themeBulletListMarkers :: Maybe Text
themeBulletList :: Maybe Style
themeCodeBlock :: Maybe Style
themeHeader :: Maybe Style
themeBorders :: Maybe Style
..} Table {[[Doc]]
[Alignment]
[Doc]
Doc
tRows :: [[Doc]]
tHeaders :: [Doc]
tAligns :: [Alignment]
tCaption :: Doc
tRows :: Table -> [[Doc]]
tHeaders :: Table -> [Doc]
tAligns :: Table -> [Alignment]
tCaption :: Table -> Doc
..} =
    Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent (forall a. a -> Trimmable a
PP.Trimmable Doc
"  ") (forall a. a -> Trimmable a
PP.Trimmable Doc
"  ") forall a b. (a -> b) -> a -> b
$
        Bool -> Doc -> Doc
lineIf (Bool -> Bool
not Bool
isHeaderLess) (Int -> [Doc] -> Doc
hcat2 Int
headerHeight
            [ Maybe Style -> Doc -> Doc
themed Maybe Style
themeTableHeader (Int -> Alignment -> Doc -> Doc
PP.align Int
w Alignment
a (Int -> Doc -> Doc
vpad Int
headerHeight Doc
header))
            | (Int
w, Alignment
a, Doc
header) <- forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
columnWidths [Alignment]
tAligns [Doc]
tHeaders
            ]) forall a. Semigroup a => a -> a -> a
<>
        Theme -> [Int] -> Doc
dashedHeaderSeparator Theme
theme [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) <- forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
columnWidths [Alignment]
tAligns [Doc]
row
                ]
            | (Int
rowHeight, [Doc]
row) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
rowHeights [[Doc]]
tRows
            ] Doc -> Doc -> Doc
<$$>
        Bool -> Doc -> Doc
lineIf Bool
isHeaderLess (Theme -> [Int] -> Doc
dashedHeaderSeparator Theme
theme [Int]
columnWidths) forall a. Semigroup a => a -> a -> a
<>
        Bool -> Doc -> Doc
lineIf
            (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Doc -> Bool
PP.null Doc
tCaption) (Doc
PP.hardline forall a. Semigroup a => a -> a -> a
<> Doc
"Table: " forall a. Semigroup a => a -> a -> a
<> Doc
tCaption)
  where
    lineIf :: Bool -> Doc -> Doc
lineIf Bool
cond Doc
line = if Bool
cond then Doc
line forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline else forall a. Monoid a => a
mempty

    joinRows :: [Doc] -> Doc
joinRows
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Doc
""

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

    headerDimensions :: [(Int, Int)]
headerDimensions = forall a b. (a -> b) -> [a] -> [b]
map Doc -> (Int, Int)
PP.dimensions [Doc]
tHeaders :: [(Int, Int)]
    rowDimensions :: [[(Int, Int)]]
rowDimensions    = forall a b. (a -> b) -> [a] -> [b]
map (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 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Int)]
col)
        | [(Int, Int)]
col <- forall a. [[a]] -> [[a]]
transpose ([(Int, Int)]
headerDimensions forall a. a -> [a] -> [a]
: [[(Int, Int)]]
rowDimensions)
        ]

    rowHeights :: [Int]
rowHeights   = forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
safeMax forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) [[(Int, Int)]]
rowDimensions :: [Int]
    headerHeight :: Int
headerHeight = [Int] -> Int
safeMax (forall a b. (a -> b) -> [a] -> [b]
map 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 forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate (Int
height forall a. Num a => a -> a -> a
- Int
actual) Doc
PP.hardline)

    safeMax :: [Int] -> Int
safeMax = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (Int -> Doc
spaces2 Int
rowHeight)

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


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


--------------------------------------------------------------------------------
dashedHeaderSeparator :: Theme -> [Int] -> PP.Doc
dashedHeaderSeparator :: Theme -> [Int] -> Doc
dashedHeaderSeparator Theme {Maybe Text
Maybe SyntaxHighlighting
Maybe Style
themeSyntaxHighlighting :: Maybe SyntaxHighlighting
themeImageTarget :: Maybe Style
themeImageText :: Maybe Style
themeMath :: Maybe Style
themeQuoted :: Maybe Style
themeStrikeout :: Maybe Style
themeLinkTarget :: Maybe Style
themeLinkText :: Maybe Style
themeCode :: Maybe Style
themeUnderline :: Maybe Style
themeStrong :: Maybe Style
themeEmph :: Maybe Style
themeLineBlock :: Maybe Style
themeTableSeparator :: Maybe Style
themeTableHeader :: Maybe Style
themeDefinitionList :: Maybe Style
themeDefinitionTerm :: Maybe Style
themeBlockQuote :: Maybe Style
themeOrderedList :: Maybe Style
themeBulletListMarkers :: Maybe Text
themeBulletList :: Maybe Style
themeCodeBlock :: Maybe Style
themeHeader :: Maybe Style
themeBorders :: Maybe Style
themeSyntaxHighlighting :: Theme -> Maybe SyntaxHighlighting
themeImageTarget :: Theme -> Maybe Style
themeImageText :: Theme -> Maybe Style
themeMath :: Theme -> Maybe Style
themeQuoted :: Theme -> Maybe Style
themeStrikeout :: Theme -> Maybe Style
themeLinkTarget :: Theme -> Maybe Style
themeLinkText :: Theme -> Maybe Style
themeCode :: Theme -> Maybe Style
themeUnderline :: Theme -> Maybe Style
themeStrong :: Theme -> Maybe Style
themeEmph :: Theme -> Maybe Style
themeLineBlock :: Theme -> Maybe Style
themeTableSeparator :: Theme -> Maybe Style
themeTableHeader :: Theme -> Maybe Style
themeDefinitionList :: Theme -> Maybe Style
themeDefinitionTerm :: Theme -> Maybe Style
themeBlockQuote :: Theme -> Maybe Style
themeOrderedList :: Theme -> Maybe Style
themeBulletListMarkers :: Theme -> Maybe Text
themeBulletList :: Theme -> Maybe Style
themeCodeBlock :: Theme -> Maybe Style
themeHeader :: Theme -> Maybe Style
themeBorders :: Theme -> Maybe Style
..} [Int]
columnWidths =
    forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (String -> Doc
PP.string String
"  ")
        [ Maybe Style -> Doc -> Doc
themed Maybe Style
themeTableSeparator (String -> Doc
PP.string (forall a. Int -> a -> [a]
replicate Int
w Char
'-'))
        | Int
w <- [Int]
columnWidths
        ]


--------------------------------------------------------------------------------
-- | This does not really belong in the module.
themed :: Maybe Theme.Style -> PP.Doc -> PP.Doc
themed :: Maybe Style -> Doc -> Doc
themed Maybe Style
Nothing                    = forall a. a -> a
id
themed (Just (Theme.Style []))    = forall a. a -> a
id
themed (Just (Theme.Style [SGR]
codes)) = [SGR] -> Doc -> Doc
PP.ansi [SGR]
codes