{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
module Hcompta.CLI.Lib.Leijen.Table where

import           Data.Bool
import           Data.Char (Char)
import           Data.Foldable (Foldable(..))
import           Data.Foldable (any)
import qualified Data.List
import           Data.List (map, replicate)
import           Data.Maybe (Maybe(..))
import           Data.Maybe (fromMaybe)
import           Data.Ord (Ord(..))
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import           Prelude (($), (.), Int, Integral(..), Num(..), fromIntegral, id, zipWith)

import qualified Hcompta.Lib.Leijen as W
import           Hcompta.Lib.Leijen ((<>), toDoc, ToDoc(..))

-- * The 'Table' type

type Table = [Column]

-- * The 'Column' type

data Column
 =   Column
 { column_title :: Text
 , column_width :: Int
 , column_align :: Align
 , column_rows  :: [Cell]
 }
instance ToDoc () [Column] where
	toDoc _m cols = do
		let rows = Data.List.transpose $ map column_rows cols
		let has_title = any (not . Text.null . column_title) cols
		let titles =
			W.intercalate (W.bold $ W.dullblack $ W.char '|')
			 (\col@Column{column_title} -> do
				let cell_width = Text.length column_title
				let under = W.bold $ W.dullblack $ W.char '_'
				let cell_content = W.enclose under under $
					W.hcat $ map
					 (\c -> case c of { ' ' -> under; _ -> W.char c })
					 (Text.unpack column_title)
				let pad len = W.bold $ W.dullblack $
					W.text $ TL.pack $ replicate len '_'
				align (Just pad) col
				 Cell{cell_width, cell_content, cell_align=Just Align_Center}
			 ) cols
		W.vsep (
			(if has_title then (:) titles else id) $
			map
			 ( W.intercalate (W.space <> do W.bold $ W.dullblack $ W.char '|') id
			 . map (W.space <>)
			 . zipWith toDoc cols
			 ) rows
		 ) <> do
		(if null cols then W.empty else W.line)
column :: Text -> Align -> [Cell] -> Column
column column_title column_align column_rows =
	Column
	 { column_title
	 , column_width = max (Text.length column_title) $
	                  foldr (max . cell_width) 0 column_rows
	 , column_align
	 , column_rows
	 }

-- ** The 'Align' type

data Align
 = Align_Left
 | Align_Center
 | Align_Right
align :: Maybe (Int -> W.Doc) -> Column -> Cell -> W.Doc
align filling
 Column{column_width, column_align}
 Cell{cell_width, cell_content, cell_align} =
	let pad = column_width - cell_width in
	let fill = fromMaybe (`W.fill` W.empty) filling in
	case fromMaybe column_align cell_align of
	 Align_Left   -> cell_content <> fill pad
	 Align_Center ->
		let half = fromInteger $ quot (toInteger pad) 2 in
		fill half <> cell_content <> fill (pad - half)
	 Align_Right  -> fill pad <> cell_content
align _filling
 Column{column_width}
 (Cell_Line {cell_pad}) =
	W.bold $ W.dullblack $ W.text $
	TL.replicate (fromIntegral column_width) $
	TL.singleton cell_pad

-- * The 'Cell' type

data Cell
 = Cell
	 { cell_align   :: Maybe Align
	 , cell_width   :: Int
	 , cell_content :: W.Doc
	 }
 | Cell_Line
	 { cell_pad     :: Char
	 , cell_width   :: Int
	 }
cell :: Cell
cell =
	Cell
	 { cell_width   = 0
	 , cell_content = W.empty
	 , cell_align   = Nothing
	 }
instance ToDoc Column Cell where
	toDoc = align Nothing