module Hcompta.LCC.Write.Table where

import Data.Bool
import Data.Char (Char)
import Data.Eq (Eq(..))
import Data.Foldable (any, foldr)
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Tuple (curry)
import Prelude (($), (.), Int, Integral(..), Num(..), fromIntegral, id, zipWith, toInteger)
import Text.Show (Show)
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

import Hcompta.LCC.Write.Compta
import qualified Language.Symantic.Document as D
import qualified Language.Symantic.Document.Term.Dimension as Dim

-- * Type 'Table'
type Table d = [Column d]

instance (D.Textable d, D.Colorable d, D.Indentable d) => Writeable d (Table d) where
	write cols' =
		let cols        = refreshWidthCol <$> cols' in
		let rows        = L.transpose $ column_rows <$> cols in
		let has_title   = any (not . T.null . column_title) cols in
		let titles :: d = D.catH $ L.intersperse (d_sep '|') $ d_title <$> cols in
		D.catV (
			(if has_title then (:) titles else id) $
			(<$> rows) $ \row ->
				D.catH $
				L.intersperse (D.space <> d_sep '|') $
				((D.space <>) <$>) $
				zipWith (curry $ alignCell Nothing) cols row
		 ) <>
		(case cols of { [] -> D.empty; _ -> D.newline })
		where
		refreshWidthCol col@Column{column_width=w} =
			if w == 0
			then col{column_width = widthCol col}
			else col
			where
			widthCol :: Column d -> Int
			widthCol Column
			 { column_title
			 , column_rows } =
				max (T.length column_title) $
				foldr (max . cell_width) 0 column_rows
		d_title :: Column d -> d
		d_title col@Column{column_title} = do
			let pad len = D.blacker $ D.text $ T.pack $ L.replicate len '_'
			alignCell (Just pad) (col, Cell
			 { cell_width   = T.length column_title
			 , cell_content = d_under <> d_underline column_title <> d_under
			 , cell_align   = Just AlignC
			 })
		d_sep = D.blacker . D.charH
		d_under = d_sep '_'
		d_underline t =
			D.catH $ (<$> T.unpack t) $ \case
			 ' ' -> d_under
			 c -> D.charH c
		
		alignCell ::
		 D.Textable d =>
		 D.Colorable d => D.Indentable d =>
		 Maybe (Int -> d) ->
		 (Column d, Cell d) -> d
		alignCell may_padding
		 ( Column{column_align, column_width}
		 , Cell{cell_width, cell_content, cell_align} ) =
			let pad = column_width - cell_width in
			case column_align `fromMaybe` cell_align of
			 AlignL -> cell_content <> padding pad
			 AlignC -> padding half <> cell_content <> padding (pad - half)
				where half = fromInteger $ quot (toInteger pad) 2
			 AlignR -> padding pad <> cell_content
			where padding = (D.spaces . D.Nat . toInteger) `fromMaybe` may_padding
		alignCell _filling
		 ( Column{column_width}
		 , Cell_Line{cell_pad} ) =
			D.blacker $ D.ltextH $
			TL.replicate (fromIntegral column_width) $
			TL.singleton cell_pad

-- ** Class 'TableOf'
class TableOf a d where
	tableOf :: a -> Table d

-- * Type 'Column'
data Column d
 =   Column
 {   column_title :: Text
 ,   column_align :: Align
 ,   column_width :: Int
 ,   column_rows  :: [Cell d]
 } deriving (Eq, Show)

column :: Text -> Align -> [Cell d] -> Column d
column t a r =
	Column
	 { column_title = t
	 , column_align = a
	 , column_width = 0
	 , column_rows  = r
	 }

-- ** Type 'Align'
data Align
 =   AlignL
 |   AlignC
 |   AlignR
 deriving (Eq, Show)

-- ** Class 'columnOf'
class ColumnOf a d where
	columnOf :: a -> Column d

-- * Type 'Cell'
data Cell d
 =   Cell      { cell_align   :: Maybe Align
                    , cell_width   :: Int
                    , cell_content :: d
                    }
 |   Cell_Line { cell_pad     :: Char
                    , cell_width   :: Int
                    }
 deriving (Eq, Show)

-- ** Class 'CellOf'
class CellOf a d where
	cellOf :: a -> Cell d
	default cellOf ::
	 Writeable Dim.Dimension a =>
	 Writeable d a =>
	 a -> Cell d
	cellOf = cell

instance D.Textable d => CellOf () d where
	cellOf () = Cell
	 { cell_width   = 0
	 , cell_align   = Nothing
	 , cell_content = D.empty
	 }

cell ::
 Writeable Dim.Dimension a =>
 Writeable d a =>
 a -> Cell d
cell a =
	Cell
	 { cell_width   = fromIntegral $ D.unNat $ Dim.dim_width $ Dim.dim $ write a
	 , cell_align   = Nothing
	 , cell_content = write a
	 }






{-
instance ToDoc Column Cell where
	toDoc = alignCell Nothing

-- ** Class 'CellOf'
class CellOf context x where
	cellOf :: context -> x -> Cell

instance CellOf context x => CellOf context (Maybe x) where
	cellOf ctx = maybe cell (cellOf ctx)

-- ** Class 'Cell_of_forall_param'

-- | A class useful when using a context of kind '*' is not wanted
--   for example in a class instance constraint
--   to keep the instance decidable (i.e. avoid UndecidableInstances).
class Cell_of_forall_param f x where
	cell_of_forall_param :: forall m. f m -> x -> Cell
-- instance Cell_of_forall_param f x => CellOf (f m) x where
-- 	cellOf = cell_of_forall_param
instance Cell_of_forall_param context x => Cell_of_forall_param context (Maybe x) where
	cell_of_forall_param ctx = maybe cell (cell_of_forall_param ctx)
-}