{-# LANGUAGE TypeFamilies #-}
module Language.TCT.Read
 ( module Language.TCT.Read.Tree
 , module Language.TCT.Read.Markup
 , 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.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 Language.TCT.Tree
import Language.TCT.Markup
import Language.TCT.Read.Tree
import Language.TCT.Read.Markup

readTCT :: FilePath -> Text -> Either (P.ParseError (P.Token Text) P.Dec) (TCT (Cell Markup))
readTCT inp txt = do
	tct <- P.runParser (p_Trees <* P.eof) inp txt
	sequence $ (<$> tct) $ \tr ->
		sequence $ (<$> tr) $ \(Cell pos posEnd t) ->
			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_Markup <* 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)