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

import Control.Applicative (Applicative(..))
import Data.Char (Char)
import Data.Either (Either(..))
import Data.Function (($))
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Traversable (sequence)
import Data.Tuple (fst, snd)
import Prelude (fromIntegral)
import System.IO (FilePath)
import qualified Text.Megaparsec as P
import Text.Show (Show(..))

import Language.TCT.Elem
import Language.TCT.Tree
import Language.TCT.Token
import Language.TCT.Read.Tree
import Language.TCT.Read.Token

readTCT :: FilePath -> Text -> Either (P.ParseError (P.Token Text) P.Dec) (TCT (Cell Token))
readTCT inp txt = do
	tct <- P.runParser (p_Trees <* P.eof) inp txt
	sequence $ (<$> trac (show $ PrettyTree tct) tct) $ \tr ->
		sequence $ (`mapTreeWithKey`tr) $ \key (Cell pos posEnd t) ->
			case key of
			 -- Verbatim Keys
			 Just (unCell -> KeyBar{}) ->
				Right $ Cell pos posEnd (TokenPlain t)
			 Just (unCell -> KeyLower{}) ->
				Right $ Cell pos posEnd (TokenPlain t)
			 Just (unCell -> KeyEqual{}) ->
				Right $ Cell pos posEnd (TokenPlain t)
			 -- Token Keys
			 _ ->
				Cell pos posEnd <$>
					P.runParser (do
						P.setTabWidth $ P.unsafePos $ fromIntegral $ snd pos
						P.setPosition $ P.SourcePos inp
						 (P.unsafePos $ fromIntegral $ fst pos)
						 (P.unsafePos $ fromIntegral $ snd pos)
						p_Token <* P.eof
					 ) inp (StreamCell t)

-- * Type 'StreamCell'
-- | Wrap 'Text' to have a 'P.Stream' instance
-- whose 'P.updatePos' method abuses the tab width state
-- to instead pass the line indent.
-- This in order to report correct 'P.SourcePos'
-- when parsing a 'Cell' containing newlines.
newtype StreamCell = StreamCell Text
instance P.Stream StreamCell where
	type Token StreamCell = Char
	uncons (StreamCell t) = (StreamCell <$>) <$> P.uncons t
	updatePos _s indent apos@(P.SourcePos n l c) ch = (apos, npos)
		where
		u = P.unsafePos 1
		npos =
			case ch of
			 '\n' -> P.SourcePos n (l <> u) indent
			 _    -> P.SourcePos n l (c <> u)