{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Language.TCT.Read
 ( module Language.TCT.Read.Tree
 , module Language.TCT.Read.Token
 , module Language.TCT.Read.Cell
 , module Language.TCT.Read
 ) where

import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..), join)
import Data.Char (Char)
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor ((<$>), (<$))
import Data.Foldable (Foldable(..))
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
import Data.Proxy (Proxy(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString)
import Data.Traversable (Traversable(..))
import Data.TreeSeq.Strict (Tree(..), Trees)
import Data.Void (Void)
import System.IO (FilePath)
import Text.Show (Show(..))
import qualified Data.Text.Lazy as TL
import qualified Data.TreeSeq.Strict as Tree
import qualified Text.Megaparsec as P
-- import qualified Data.List as List

import Language.TCT.Tree
import Language.TCT.Cell
import Language.TCT.Read.Cell
import Language.TCT.Read.Tree
import Language.TCT.Read.Token

import Debug.Trace (trace)

readTrees ::
 FilePath -> TL.Text ->
 Either (P.ParseError (P.Token TL.Text) (P.ErrorFancy Void)) (Trees (Cell Node))
readTrees inp txt = do
	trs <- P.runParser (p_Trees <* P.eof) inp txt
	{-(join <$>) $ -}
	traverse (go Nothing) $
		trace ("### TRS ###\n"<>show (Tree.Pretty trs)) trs
	where
	go ::
	 Maybe Node ->
	 Tree (Cell Node) ->
	 Either (P.ParseError (P.Token TL.Text) (P.ErrorFancy Void))
	        (Tree (Cell Node))
	go p t@(Tree c@(Cell bn en nod) ts) =
		case nod of
		 NodeGroup{}  -> Tree c <$> traverse (go (Just nod)) ts
		 NodeHeader{} -> Tree c <$> traverse (go (Just nod)) ts
		 NodeToken{}  -> Tree c <$> traverse (go (Just nod)) ts
		 NodePair{}   -> Tree c <$> traverse (go (Just nod)) ts
		 NodePara{}   -> Tree c <$> traverse (go (Just nod)) ts
		 NodeLower{}  -> Right t
		 -- NodeText n | TL.null n -> Right t
		 NodeText n ->
			case p of
			 Just (NodeHeader HeaderBar{})   -> Right t
			 Just (NodeHeader HeaderEqual{}) -> Right t
			 _ -> do
				toks <- parseTokens <$> parseLexemes inp (n <$ c)
				return $
					case toList toks of
					 [tok] -> tok
					 _ -> Tree (Cell bn en NodeGroup) toks
		 {-
		 NodeHeader _n -> pure . Tree c . join <$> traverse (go (Just nod)) ts
		 NodeToken  _n -> pure . Tree c . join <$> traverse (go (Just nod)) ts
		 NodePair   _n -> pure . Tree c . join <$> traverse (go (Just nod)) ts
		 NodeLower{} -> Right $ pure t
		 NodeText n | TL.null n  -> Right $ pure t
		 NodeText n ->
			case p of
			 Just (NodeHeader HeaderBar{})   -> Right $ pure t
			 Just (NodeHeader HeaderEqual{}) -> Right $ pure t
			 _ -> do
				acc <- parseLexemes inp (n <$ c)
				sn <- traverse (go (Just nod)) ts
				return $ parseTokens $
					foldr (\s a -> orientLexemePairAny $ LexemeTree s:a) acc (join sn)
		 -}