{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
module Language.TCT.Read.Cell where

import Data.Char (Char)
import Data.Either (Either(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (Maybe(..))
import Data.Ord (Ord)
import Data.String (String, IsString)
import Prelude (Num(..), toInteger)
import Text.Show (Show)
import qualified Data.Set as Set
import qualified Text.Megaparsec as P

import Language.TCT.Cell

-- * Type 'Parser'
-- | Convenient alias.
type Parser e s a =
 ( P.Stream s
 , P.Token s ~ Char
 , Ord e
 , IsString (P.Tokens s)
 , P.ShowErrorComponent e
 ) => P.Parsec e s a

p_satisfyMaybe :: P.MonadParsec e s m => (P.Token s -> Maybe a) -> m a
p_satisfyMaybe f = check `P.token` Nothing
	where
	check c =
		case f c of
		 Just a  -> Right a
		 Nothing -> Left (Just $ P.Tokens $ c:|[], Set.empty)

p_Position :: Parser e s Pos
p_Position = (<$> P.getPosition) $ \p ->
	Pos
	 (intOfPos $ P.sourceLine p)
	 (intOfPos $ P.sourceColumn p)
intOfPos :: P.Pos -> Int
intOfPos = fromInteger . toInteger . P.unPos

p_LineNum :: Parser e s Line
p_LineNum = intOfPos . P.sourceLine <$> P.getPosition

p_ColNum :: Parser e s Column
p_ColNum = intOfPos . P.sourceColumn <$> P.getPosition

-- * Debug
pdbg :: Show a => String -> Parser e s a -> Parser e s a
-- pdbg m p = P.dbg m p
pdbg _m p = p
{-# INLINE pdbg #-}