module Cloudy.Table where

import Control.Monad (when)
import Data.List.NonEmpty (NonEmpty ((:|)), cons, transpose)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Control.Exception (assert)

data Align = LeftJustified | Centered | RightJustified

data Table = Table
  { Table -> NonEmpty (Align, Text)
tableHeaders :: NonEmpty (Align, Text)
  , Table -> NonEmpty (NonEmpty Text)
tableBodyRows :: NonEmpty (NonEmpty Text)
  }

printTable :: Table -> IO ()
printTable :: Table -> IO ()
printTable Table{NonEmpty (Align, Text)
$sel:tableHeaders:Table :: Table -> NonEmpty (Align, Text)
tableHeaders :: NonEmpty (Align, Text)
tableHeaders, NonEmpty (NonEmpty Text)
$sel:tableBodyRows:Table :: Table -> NonEmpty (NonEmpty Text)
tableBodyRows :: NonEmpty (NonEmpty Text)
tableBodyRows} = do
  NonEmpty (Align, Text) -> NonEmpty (NonEmpty Text) -> IO ()
forall a b. NonEmpty a -> NonEmpty (NonEmpty b) -> IO ()
assertRowsSameLengths NonEmpty (Align, Text)
tableHeaders NonEmpty (NonEmpty Text)
tableBodyRows
  let rawTable :: Text
rawTable = NonEmpty (Align, Text) -> NonEmpty (NonEmpty Text) -> Text
renderTable NonEmpty (Align, Text)
tableHeaders NonEmpty (NonEmpty Text)
tableBodyRows
  Text -> IO ()
Text.putStrLn Text
rawTable

assertRowsSameLengths :: NonEmpty a -> NonEmpty (NonEmpty b) -> IO ()
assertRowsSameLengths :: forall a b. NonEmpty a -> NonEmpty (NonEmpty b) -> IO ()
assertRowsSameLengths NonEmpty a
headers NonEmpty (NonEmpty b)
bodyRows =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((NonEmpty b -> Bool) -> NonEmpty (NonEmpty b) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\NonEmpty b
row -> NonEmpty a -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty a
headers Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= NonEmpty b -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty b
row) NonEmpty (NonEmpty b)
bodyRows) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"Body row does not contain same number of elements as header row"

renderTable :: NonEmpty (Align, Text) -> NonEmpty (NonEmpty Text) -> Text
renderTable :: NonEmpty (Align, Text) -> NonEmpty (NonEmpty Text) -> Text
renderTable NonEmpty (Align, Text)
headers NonEmpty (NonEmpty Text)
body =
  let headerTexts :: NonEmpty Text
headerTexts = ((Align, Text) -> Text) -> NonEmpty (Align, Text) -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Align, Text) -> Text
forall a b. (a, b) -> b
snd NonEmpty (Align, Text)
headers
      maxWidths :: NonEmpty Int
maxWidths = NonEmpty (NonEmpty Text) -> NonEmpty Int
getMaxWidths (NonEmpty (NonEmpty Text) -> NonEmpty Int)
-> NonEmpty (NonEmpty Text) -> NonEmpty Int
forall a b. (a -> b) -> a -> b
$ NonEmpty Text
-> NonEmpty (NonEmpty Text) -> NonEmpty (NonEmpty Text)
forall a. a -> NonEmpty a -> NonEmpty a
cons NonEmpty Text
headerTexts NonEmpty (NonEmpty Text)
body
      maxAlignWidths :: NonEmpty (Align, Int)
maxAlignWidths = NonEmpty Align -> NonEmpty Int -> NonEmpty (Align, Int)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NonEmpty.zip (((Align, Text) -> Align)
-> NonEmpty (Align, Text) -> NonEmpty Align
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Align, Text) -> Align
forall a b. (a, b) -> a
fst NonEmpty (Align, Text)
headers) NonEmpty Int
maxWidths
      rawHeaders :: Text
rawHeaders = NonEmpty Int -> NonEmpty Text -> Text
renderHeaders NonEmpty Int
maxWidths NonEmpty Text
headerTexts
      rawBody :: Text
rawBody = NonEmpty (Align, Int) -> NonEmpty (NonEmpty Text) -> Text
renderBody NonEmpty (Align, Int)
maxAlignWidths NonEmpty (NonEmpty Text)
body
      fatDiv :: Text
fatDiv = Bool -> NonEmpty Int -> Text -> Text
renderDiv Bool
True NonEmpty Int
maxWidths Text
"="
      skinnyDiv :: Text
skinnyDiv = Bool -> NonEmpty Int -> Text -> Text
renderDiv Bool
False NonEmpty Int
maxWidths Text
"-"
  in
  Text -> [Text] -> Text
Text.intercalate
    Text
"\n"
    [ Text
skinnyDiv
    , Text
rawHeaders
    , Text
fatDiv
    , Text
rawBody
    , Text
skinnyDiv
    ]

renderDiv :: Bool -> NonEmpty Int -> Text -> Text
renderDiv :: Bool -> NonEmpty Int -> Text -> Text
renderDiv Bool
shouldUseHorizontalDivs NonEmpty Int
maxWidths Text
c =
  let divider :: Text
divider = if Bool
shouldUseHorizontalDivs then Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c else Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c
      rowMiddle :: Text
rowMiddle = Text -> [Text] -> Text
Text.intercalate Text
divider ([Text] -> Text)
-> (NonEmpty Text -> [Text]) -> NonEmpty Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty Text -> Text) -> NonEmpty Text -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> NonEmpty Int -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
width -> Int -> Text -> Text
Text.replicate Int
width Text
c) NonEmpty Int
maxWidths
  in Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rowMiddle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"

renderHeaders :: NonEmpty Int -> NonEmpty Text -> Text
renderHeaders :: NonEmpty Int -> NonEmpty Text -> Text
renderHeaders NonEmpty Int
maxWidths NonEmpty Text
headers =
  NonEmpty (Align, Int, Text) -> Text
renderRow (NonEmpty Align
-> NonEmpty Int -> NonEmpty Text -> NonEmpty (Align, Int, Text)
forall a b c.
NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
zipThreeNE (Align
Centered Align -> [Align] -> NonEmpty Align
forall a. a -> [a] -> NonEmpty a
:| Align -> [Align]
forall a. a -> [a]
repeat Align
Centered) NonEmpty Int
maxWidths NonEmpty Text
headers)

zipThreeNE :: NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
zipThreeNE :: forall a b c.
NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty (a, b, c)
zipThreeNE (a
a :| [a]
as) (b
b :| [b]
bs) (c
c :| [c]
cs) = (a
a,b
b,c
c) (a, b, c) -> [(a, b, c)] -> NonEmpty (a, b, c)
forall a. a -> [a] -> NonEmpty a
:| [a] -> [b] -> [c] -> [(a, b, c)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zipThree [a]
as [b]
bs [c]
cs

zipThree :: [a] -> [b] -> [c] -> [(a,b,c)]
zipThree :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zipThree = \cases
  [] [b]
_ [c]
_ -> []
  [a]
_ [] [c]
_ -> []
  [a]
_ [b]
_ [] -> []
  (a
a : [a]
as) (b
b : [b]
bs) (c
c : [c]
cs) -> (a
a,b
b,c
c) (a, b, c) -> [(a, b, c)] -> [(a, b, c)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [c] -> [(a, b, c)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zipThree [a]
as [b]
bs [c]
cs

renderBody :: NonEmpty (Align, Int) -> NonEmpty (NonEmpty Text) -> Text
renderBody :: NonEmpty (Align, Int) -> NonEmpty (NonEmpty Text) -> Text
renderBody NonEmpty (Align, Int)
maxAlignWidths NonEmpty (NonEmpty Text)
body =
  Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (NonEmpty Text -> Text)
-> NonEmpty (NonEmpty Text) -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty (Align, Int, Text) -> Text
renderRow (NonEmpty (Align, Int, Text) -> Text)
-> (NonEmpty Text -> NonEmpty (Align, Int, Text))
-> NonEmpty Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Align, Int)
-> NonEmpty Text -> NonEmpty (Align, Int, Text)
forall a b c. NonEmpty (a, b) -> NonEmpty c -> NonEmpty (a, b, c)
zipOneMore NonEmpty (Align, Int)
maxAlignWidths) NonEmpty (NonEmpty Text)
body

zipOneMore :: NonEmpty (a, b) -> NonEmpty c -> NonEmpty (a, b, c)
zipOneMore :: forall a b c. NonEmpty (a, b) -> NonEmpty c -> NonEmpty (a, b, c)
zipOneMore = ((a, b) -> c -> (a, b, c))
-> NonEmpty (a, b) -> NonEmpty c -> NonEmpty (a, b, c)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NonEmpty.zipWith (\(a
a, b
b) c
c -> (a
a, b
b, c
c))

renderRow :: NonEmpty (Align, Int, Text) -> Text
renderRow :: NonEmpty (Align, Int, Text) -> Text
renderRow NonEmpty (Align, Int, Text)
columnInfo =
  let rowMiddle :: Text
rowMiddle = Text -> [Text] -> Text
Text.intercalate Text
" | " ([Text] -> Text)
-> (NonEmpty Text -> [Text]) -> NonEmpty Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty Text -> Text) -> NonEmpty Text -> Text
forall a b. (a -> b) -> a -> b
$ ((Align, Int, Text) -> Text)
-> NonEmpty (Align, Int, Text) -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Align, Int, Text) -> Text
renderColumn NonEmpty (Align, Int, Text)
columnInfo
  in Text
"| " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rowMiddle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"

renderColumn :: (Align, Int, Text) -> Text
renderColumn :: (Align, Int, Text) -> Text
renderColumn (Align
align, Int
maxWidth, Text
t) =
  let textWidth :: Int
textWidth = Text -> Int
Text.length Text
t
      remainingLength :: Int
remainingLength = Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
textWidth
      paddedText :: Text
paddedText =
        case Align
align of
          Align
LeftJustified -> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
remainingLength Text
" "
          Align
Centered ->
            let (Int
surroundingLength, Int
extra) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
remainingLength Int
2
                leftSpace :: Text
leftSpace = Int -> Text -> Text
Text.replicate Int
surroundingLength Text
" "
                rightSpace :: Text
rightSpace = Int -> Text -> Text
Text.replicate (Int
surroundingLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra) Text
" "
            in Text
leftSpace Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rightSpace
          Align
RightJustified -> Int -> Text -> Text
Text.replicate Int
remainingLength Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
  in Bool -> Text -> Text
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
remainingLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Text
paddedText

getMaxWidths :: NonEmpty (NonEmpty Text) -> NonEmpty Int
getMaxWidths :: NonEmpty (NonEmpty Text) -> NonEmpty Int
getMaxWidths = (NonEmpty Text -> Int) -> NonEmpty (NonEmpty Text) -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NonEmpty Int -> Int)
-> (NonEmpty Text -> NonEmpty Int) -> NonEmpty Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> NonEmpty Text -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
Text.length) (NonEmpty (NonEmpty Text) -> NonEmpty Int)
-> (NonEmpty (NonEmpty Text) -> NonEmpty (NonEmpty Text))
-> NonEmpty (NonEmpty Text)
-> NonEmpty Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (NonEmpty Text) -> NonEmpty (NonEmpty Text)
forall a. NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)
transpose