{-# LANGUAGE OverloadedStrings #-}
module DataFrame.Display.Terminal.PrettyPrint where

import qualified Data.Text as T

import Data.List (transpose)

-- Utility functions to show a DataFrame as a Markdown-ish table.

-- Adapted from: https://stackoverflow.com/questions/5929377/format-list-output-in-haskell
-- a type for fill functions
type Filler = Int -> T.Text -> T.Text

-- a type for describing table columns
data ColDesc t = ColDesc
  { forall t. ColDesc t -> Filler
colTitleFill :: Filler,
    forall t. ColDesc t -> Text
colTitle :: T.Text,
    forall t. ColDesc t -> Filler
colValueFill :: Filler
  }

-- functions that fill a string (s) to a given width (n) by adding pad
-- character (c) to align left, right, or center
fillLeft :: Char -> Int -> T.Text -> T.Text
fillLeft :: Char -> Filler
fillLeft Char
c Int
n Text
s = Text
s Text -> Text -> Text
`T.append` Filler
T.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) (Char -> Text
T.singleton Char
c)

fillRight :: Char -> Int -> T.Text -> T.Text
fillRight :: Char -> Filler
fillRight Char
c Int
n Text
s = Filler
T.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) (Char -> Text
T.singleton Char
c) Text -> Text -> Text
`T.append` Text
s

fillCenter :: Char -> Int -> T.Text -> T.Text
fillCenter :: Char -> Filler
fillCenter Char
c Int
n Text
s = Filler
T.replicate Int
l (Char -> Text
T.singleton Char
c) Text -> Text -> Text
`T.append` Text
s Text -> Text -> Text
`T.append` Filler
T.replicate Int
r (Char -> Text
T.singleton Char
c)
  where
    x :: Int
x = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s
    l :: Int
l = Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    r :: Int
r = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l

-- functions that fill with spaces
left :: Int -> T.Text -> T.Text
left :: Filler
left = Char -> Filler
fillLeft Char
' '

right :: Int -> T.Text -> T.Text
right :: Filler
right = Char -> Filler
fillRight Char
' '

center :: Int -> T.Text -> T.Text
center :: Filler
center = Char -> Filler
fillCenter Char
' '

showTable :: [T.Text] -> [T.Text] -> [[T.Text]] -> T.Text
showTable :: [Text] -> [Text] -> [[Text]] -> Text
showTable [Text]
header [Text]
types [[Text]]
rows =
  let cs :: [ColDesc t]
cs = (Text -> ColDesc t) -> [Text] -> [ColDesc t]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
h -> Filler -> Text -> Filler -> ColDesc t
forall t. Filler -> Text -> Filler -> ColDesc t
ColDesc Filler
center Text
h Filler
left) [Text]
header
      widths :: [Int]
widths = [[Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
col | [Text]
col <- [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ [Text]
header [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: [Text]
types [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: [[Text]]
rows]
      border :: Text
border = Text -> [Text] -> Text
T.intercalate Text
"---" [Filler
T.replicate Int
width (Char -> Text
T.singleton Char
'-') | Int
width <- [Int]
widths]
      separator :: Text
separator = Text -> [Text] -> Text
T.intercalate Text
"-|-" [Filler
T.replicate Int
width (Char -> Text
T.singleton Char
'-') | Int
width <- [Int]
widths]
      fillCols :: (ColDesc t -> Int -> t -> Text) -> [t] -> Text
fillCols ColDesc t -> Int -> t -> Text
fill [t]
cols = Text -> [Text] -> Text
T.intercalate Text
" | " [ColDesc t -> Int -> t -> Text
fill ColDesc t
c Int
width t
col | (ColDesc t
c, Int
width, t
col) <- [ColDesc t] -> [Int] -> [t] -> [(ColDesc t, Int, t)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [ColDesc t]
forall {t}. [ColDesc t]
cs [Int]
widths [t]
cols]
   in [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
border Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (ColDesc Any -> Filler) -> [Text] -> Text
forall {t} {t}. (ColDesc t -> Int -> t -> Text) -> [t] -> Text
fillCols ColDesc Any -> Filler
forall t. ColDesc t -> Filler
colTitleFill [Text]
header Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
separator Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (ColDesc Any -> Filler) -> [Text] -> Text
forall {t} {t}. (ColDesc t -> Int -> t -> Text) -> [t] -> Text
fillCols ColDesc Any -> Filler
forall t. ColDesc t -> Filler
colTitleFill [Text]
types Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
separator Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((ColDesc Any -> Filler) -> [Text] -> Text
forall {t} {t}. (ColDesc t -> Int -> t -> Text) -> [t] -> Text
fillCols ColDesc Any -> Filler
forall t. ColDesc t -> Filler
colValueFill) [[Text]]
rows

showTableProperMarkdown :: [T.Text] -> [T.Text] -> [[T.Text]] -> T.Text
showTableProperMarkdown :: [Text] -> [Text] -> [[Text]] -> Text
showTableProperMarkdown [Text]
header [Text]
types [[Text]]
rows =
  let headerWithTypes :: [Text]
headerWithTypes = (Text -> Text -> Text) -> [Text] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
h Text
t -> Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<br>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) [Text]
header [Text]
types
      cs :: [ColDesc t]
cs = (Text -> ColDesc t) -> [Text] -> [ColDesc t]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
h -> Filler -> Text -> Filler -> ColDesc t
forall t. Filler -> Text -> Filler -> ColDesc t
ColDesc Filler
center Text
h Filler
left) [Text]
headerWithTypes
      widths :: [Int]
widths = [[Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
col | [Text]
col <- [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ [Text]
headerWithTypes [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: [[Text]]
rows]
      border :: Text
border = Text -> [Text] -> Text
T.intercalate Text
"---" [Filler
T.replicate Int
width (Char -> Text
T.singleton Char
'-') | Int
width <- [Int]
widths]
      separator :: Text
separator = Text -> [Text] -> Text
T.intercalate Text
"-|-" [Filler
T.replicate Int
width (Char -> Text
T.singleton Char
'-') | Int
width <- [Int]
widths]
      fillCols :: (ColDesc t -> Int -> t -> Text) -> [t] -> Text
fillCols ColDesc t -> Int -> t -> Text
fill [t]
cols = Text -> [Text] -> Text
T.intercalate Text
" | " [ColDesc t -> Int -> t -> Text
fill ColDesc t
c Int
width t
col | (ColDesc t
c, Int
width, t
col) <- [ColDesc t] -> [Int] -> [t] -> [(ColDesc t, Int, t)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [ColDesc t]
forall {t}. [ColDesc t]
cs [Int]
widths [t]
cols]
   in [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
border Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (ColDesc Any -> Filler) -> [Text] -> Text
forall {t} {t}. (ColDesc t -> Int -> t -> Text) -> [t] -> Text
fillCols ColDesc Any -> Filler
forall t. ColDesc t -> Filler
colTitleFill [Text]
headerWithTypes Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
separator Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((ColDesc Any -> Filler) -> [Text] -> Text
forall {t} {t}. (ColDesc t -> Int -> t -> Text) -> [t] -> Text
fillCols ColDesc Any -> Filler
forall t. ColDesc t -> Filler
colValueFill) [[Text]]
rows