{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ViewPatterns #-}
module Language.TCT.Tree
 ( module Language.TCT.Tree
 , Tree(..)
 , Trees
 ) where

import Control.Monad (Monad(..))
import Data.Eq (Eq(..))
import Data.Function (($))
import Data.Maybe (Maybe(..))
import Data.Ord (Ordering(..), Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.Sequence ((|>))
import Data.Text (Text)
import Data.TreeSeq.Strict (Tree(..), Trees)
import Prelude (undefined, Int, Num(..))
import Text.Show (Show(..))
import qualified Data.List as List
import qualified Data.Text as Text
import qualified System.FilePath as FP
import qualified Data.Sequence as Seq

import Language.TCT.Cell
import Language.TCT.Elem
import Language.TCT.Read.Token
-- import Language.TCT.Token


-- | @appendRow rows row@ appends @row@ to @rows@.
--
-- [@rows@] parent 'Rows', from closest to farthest (non-strictly descending)
-- [@row@]  next 'Row', from leftest column to rightest (non-stricly ascending)
appendRow :: Rows -> Row -> Rows
appendRow [] row = List.reverse row
appendRow parents [] = parents
appendRow rows@(parent:parents) row@(cell:cells) =
	trac ("appendRow: rows=" <> show rows) $
	trac ("appendRow: row=" <> show row) $
	dbg "appendRow" $
	let colParent = columnPos $ posTree parent in
	let colRow    = columnPos $ posTree cell in
	case dbg "colParent" colParent `compare`
	     dbg "colRow"    colRow of
	 LT ->
		case (dbg "parent" parent,dbg "cell" cell) of
		 (Tree0{}, TreeN{}) -> eq
		 -- (Tree0 p, Tree0{}) | Text.null (unCell p) -> eq -- FIXME: useful?
		 -- (TreeN (unCell -> KeyPara) p, Tree0 r) -> appendTree0 p r
		 -- (Tree0 p, Tree0 r) -> appendTree0 p r
		 _ | Just x <- appendPara -> x
		 _ -> lt
	 EQ ->
		case (dbg "parent" parent,dbg "cell" cell) of
		 _ | Just x <- appendPara -> x
		 (_, TreeN (unCell -> KeySection sectionRow) _)
		  | Just (sectionParent, secPar:secPars) <- collapseSection colRow rows ->
			case dbg "sectionParent" sectionParent `compare`
			     dbg "sectionRow"    sectionRow of
			 LT -> appendRow (cell:secPar:secPars) cells
			 EQ -> appendRow (cell:insertChild secPar secPars) cells
			 GT -> gt
		 (TreeN (unCell -> KeySection{}) _, Tree0{}) -> lt
		 (TreeN (unCell -> KeySection{}) _, TreeN{}) -> lt
		 (Tree0{}, TreeN{}) -> eq
		 (TreeN{}, TreeN{}) -> eq
		 (TreeN{}, Tree0{}) -> eq
	 GT -> gt
	where
	appendPara :: Maybe Rows
	appendPara =
		case (parent, cell) of
		 ( TreeN (Cell posPar posEndPar KeyPara) pars
		  , Tree0 (Cell posRow posEndRow _c) ) ->
			Just $
			if linePos posRow - linePos posEndPar <= 1
			then appendRow (merged : parents) cells
			else appendRow (cell : insertChild parent parents) cells
			where merged = TreeN (Cell posPar posEndRow KeyPara) $ pars |> cell
		 ( Tree0 (Cell posPar posEndPar _p)
		  , Tree0 (Cell posRow posEndRow _c) ) ->
			Just $
			if linePos posRow - linePos posEndPar <= 1
			then appendRow (merged : parents) cells
			else appendRow (cell : insertChild parent parents) cells
			where merged = TreeN (Cell posPar posEndRow KeyPara) [parent, cell]
		 _ -> Nothing
	
	{-
	appendTree0 p r =
		case appendCellValue p r of
		 Nothing -> appendRow (Tree0 r : insertChild (Tree0 p) parents) cells
		 Just t  -> appendRow (t : parents) cells
	-}
	lt = appendRow [] row <> rows
	eq = appendRow (cell : insertChild parent parents) cells
	gt = appendRow (insertChild parent parents) row
	-- | Find the first section (if any), returning its level, and the path collapsed upto it.
	collapseSection :: Column -> Rows -> Maybe (Int,Rows)
	collapseSection col xxs@(x:xs) | columnPos (posTree x) == col =
		case x of
		 TreeN (unCell -> KeySection lvl) _ -> Just (lvl, xxs)
		 _ -> do
			(lvl, cs) <- collapseSection col xs
			return (lvl, insertChild x cs)
	collapseSection _ _ = Nothing

{-
appendCellValue :: Cell Value -> Cell Value -> Tree (Cell Key) (Cell Value)
appendCellValue par@(Cell posPar posEndPar p) row@(Cell posRow posEndRow r) =
	trac ("appendCellValue: p="<>show p) $
	trac ("appendCellValue: r="<>show r) $
	dbg "appendCellValue" $
	case linePos posRow - linePos posEndPar of
	 0 ->
		TreeN (Cell posPar posEndRow KeyPara)
		 [ Tree0 par
		 , Tree0 row
		 ]
	 1 ->
		TreeN (Cell posPar posEndRow KeyPara)
		 [ Tree0 par
		 , Tree0 row
		 ]
	 _ -> []
	where
	padding x y = Text.replicate (y - x) " "
	{-
	where
	pad =
		-- return $ LexemeWhite $ Cell posEndPar posRow $
		-- padding (columnPos posEndPar) (columnPos posRow)
	-}
	{-
	-- return $ Cell posPar posEndRow $ p <> pad <> r
	-- return $ Cell posPar posEndRow $ p <> pad <> r
	where
	pad =
		-- return $ LexemeWhite $ Cell posEndPar posRow $
		-- "\n" <>
		padding (columnPos posPar) (columnPos posRow)
	-}
-}

insertChild :: Tree (Cell Key) (Cell Value) -> Rows -> Rows
insertChild child ps@[] =
	trac ("insertChild: child="<>show child) $
	trac ("insertChild: ps="<>show ps) $
	dbg "insertChild" $
	[child]
insertChild c@(Tree0 (Cell _bp ep _))
            (p@(Tree0 (Cell bp _ep _)):parents) =
	TreeN (Cell bp ep KeyPara) [p, c] : parents
insertChild (TreeN (Cell _bp ep _) cs)
            (p@(Tree0 (Cell bp _ep _)):parents) =
	TreeN (Cell bp ep KeyPara) (p Seq.<| cs) : parents
	{-
	undefined
	-- FIXME: this case may be removed.
	case dbg "colParent" (columnCell parent)`compare`dbg "colChild" (columnPos $ posTree child) of
	 LT -> TreeN KeyMix (Seq.fromList [Tree0 v, child] treesParent |> child) : parents
	 EQ -> TreeN KeyMix (Seq.fromList [Tree0 v, child] treesParent |> child) : parents
	 GT -> undefined
	-}
insertChild child ps@(TreeN parent treesParent:parents) =
	trac ("insertChild: child="<>show child) $
	trac ("insertChild: ps="<>show ps) $
	dbg "insertChild" $
	-- FIXME: this case may be removed.
	case dbg "colParent" (columnCell parent)`compare`dbg "colChild" (columnPos $ posTree child) of
	 LT -> TreeN parent (treesParent |> child) : parents
	 EQ -> TreeN parent (treesParent |> child) : parents
	 GT -> undefined

collapseRows :: Rows -> Tree (Cell Key) (Cell Value)
collapseRows []              = undefined
collapseRows [child]         = dbg "collapseRows" $ child
collapseRows (child:parents) = dbg "collapseRows" $ collapseRows $ insertChild child parents