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

import Data.Eq (Eq(..))
import Data.Function (($))
import Data.Functor ((<$>))
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 Language.TCT.Cell
import Language.TCT.Elem

-- * Type 'Row'
-- | A list of 'Key's, maybe ended by 'Value', all read on the same 'Line'.
type Row = [Tree (Cell Key) (Cell Text)]

-- * Type 'Key'
data Key = KeyColon !Name !White     -- ^ @name: @
         | KeyEqual !Name !White     -- ^ @name=@
         | KeyBar   !Name !White     -- ^ @name|@
         | KeyGreat !Name !White     -- ^ @name>@
         | KeyLower !Name !Attrs     -- ^ @<name a=b@
         | KeyDot   !Name            -- ^ @1. @
         | KeyDash                   -- ^ @- @
         | KeyDashDash               -- ^ @-- @
         | KeySection  !LevelSection -- ^ @# @
         | KeyBrackets !Name         -- ^ @[ name ]@
         | KeyDotSlash !PathFile     -- ^ @./file @
         deriving (Eq, Ord, Show)

-- ** Type 'Name'
type Name = Text

-- ** Type 'PathFile'
type PathFile = FP.FilePath

-- ** Type 'LevelSection'
type LevelSection = Int

-- * Type 'Rows'
type Rows = [Tree (Cell Key) (Cell Text)]

-- | @appendRow rows row@ appends @row@ to @rows@.
--
-- [@rows@] parent 'Rows', from closest to farest (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?
		 (Tree0 p, Tree0 r) -> appendTree0 p r
		 _ -> lt
	 EQ ->
		case (dbg "parent" parent,dbg "cell" cell) of
		 (Tree0 p, Tree0 r) -> appendTree0 p r
		 (_, 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
	appendTree0 p r =
		case appendCellText p r of
		 Nothing -> appendRow (Tree0 r : insertChild (Tree0 p) parents) cells
		 Just c  -> appendRow (Tree0 c : 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)
		 _ -> (\(lvl,cs) -> (lvl,insertChild x cs)) <$> collapseSection col xs
	collapseSection _ _ = Nothing

appendCellText :: Cell Text -> Cell Text -> Maybe (Cell Text)
appendCellText (Cell posPar posEndPar p)
               (Cell posRow posEndRow r) =
	trac ("appendCellText: p="<>show p) $
	trac ("appendCellText: r="<>show r) $
	dbg "appendCellText" $
	case linePos posRow - linePos posEndPar of
	 0 -> Just $ Cell posPar posEndRow $ p <> pad <> r
		where pad = padding (columnPos posEndPar) (columnPos posRow)
	 1 -> Just $ Cell posPar posEndRow $ p <> pad <> r
		where pad = "\n" <> padding (columnPos posPar) (columnPos posRow)
	 _ -> Nothing
	where
	padding x y = Text.replicate (y - x) " "

insertChild :: Tree (Cell Key) (Cell Text) -> Rows -> Rows
insertChild child ps@[] =
	trac ("insertChild: child="<>show child) $
	trac ("insertChild: ps="<>show ps) $
	dbg "insertChild" $
	[child]
insertChild _child (Tree0{}:_) = undefined
insertChild child ps@(TreeN parent treesParent:parents) =
	trac ("insertChild: child="<>show child) $
	trac ("insertChild: ps="<>show ps) $
	dbg "insertChild" $
	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 Text)
collapseRows []              = undefined
collapseRows [child]         = dbg "collapseRows" $ child
collapseRows (child:parents) = dbg "collapseRows" $ collapseRows $ insertChild child parents