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

import qualified Data.List
import           Data.Maybe (fromMaybe)
import qualified Data.Text.Lazy as TL
import           Data.Text (Text)
import qualified Data.Text as Text

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 m [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 =
		case filling of
		 Nothing -> \l -> W.fill l W.empty
		 Just f -> f 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

-- * The 'Cell' type

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