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.Either (Either(..))
import Data.Foldable (Foldable(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Traversable (Traversable(..))
import Data.TreeSeq.Strict (Tree(..), Trees)
import Data.Void (Void)
import System.IO (FilePath)
import qualified Data.Text.Lazy as TL
import qualified Text.Megaparsec as P

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

-- | Parsing is done in two phases:
--
-- 1. indentation-sensitive parsing on 'TL.Text'
-- 2. Pair-sensitive parsing on some 'NodeText's resulting of 1.
readTCT ::
 FilePath -> TL.Text ->
 Either ErrorRead (Trees (Cell Node))
readTCT inp txt = do
	trs <- P.runParser (p_Trees <* P.eof) inp txt
	join <$> traverse (go $ NodeHeader HeaderDash)
	 (debug0 "readTCT" trs)
	where
	go :: Node -> Tree (Cell Node) -> Either ErrorRead (Trees (Cell Node))
	go parent t@(Tree c@(Cell bn en nod) ts) =
		case nod of
		 NodeLower{} -> Right $ pure t
		 -- NOTE: preserve NodeText ""
		 NodeText n | TL.null n -> Right $ pure t
		 NodeText n ->
			case parent of
			 NodeHeader HeaderBar{}      -> Right $ pure t
			 NodeHeader HeaderEqual{}    -> Right $ pure t
			 NodeHeader HeaderDashDash{} -> Right $ pure t
			 _ -> do
				toks <- parseTokens <$> parseLexemes inp (Cell bn en n)
				Right $ toks
		 _ -> pure . Tree c . join <$> traverse (go nod') ts
			where
			-- NOTE: skip parent 'Node's whose semantic does not change 'NodeText'
			nod' = case nod of
			 NodePara -> parent
			 _ -> nod

-- * Type 'ErrorRead'
type ErrorRead = P.ParseError (P.Token TL.Text) (P.ErrorFancy Void)