module Text.Parsec.IndentParsec.Prim
( Indentation(..)
, GenIndentParsecT
, tokeniser
, nest
, neglectIndent
, HaskellLike(..)
, runGIPT', runGIPT
, IndentT
, GenIndentParsec
, IndentParsecT
, IndentParsec
) where
import Control.Monad.State
import Control.Monad.Identity
import Text.Parsec.Prim
import Text.Parsec.Error
import Text.Parsec.Pos
import Text.Parsec.Combinator
class Indentation i where
never :: i
always :: i
acceptable :: i -> SourcePos -> Bool
nestableIn :: i
-> i
-> Bool
type IndentT i m = StateT i m
type GenIndentParsecT i s u m a = ParsecT s u (IndentT i m) a
tokeniser :: (Indentation i, Monad m)
=> GenIndentParsecT i s u m a
-> GenIndentParsecT i s u m a
tokeniser p = do pos <- getPosition
i <- lift get
if acceptable i pos then p
else fail $ "unexpected token at " ++ show pos
nest :: (Indentation i, Show i, Monad m, Stream s (IndentT i m) t, Show t)
=> (SourcePos -> i)
-> GenIndentParsecT i s u m body
-> GenIndentParsecT i s u m body
nest indentor p = do outerI <- lift get
curPos <- getPosition
let innerI = indentor curPos
in if innerI `nestableIn` outerI
then nestP innerI outerI p
else nestP never outerI p
nestP :: (Indentation i, Show i, Monad m, Stream s (IndentT i m) t, Show t)
=> i
-> i
-> GenIndentParsecT i s u m body
-> GenIndentParsecT i s u m body
nestP i o p = do lift $ put i
x <- p
notFollowedBy (tokeniser anyToken)
<?> "unterminated " ++ show i
lift $ put o
return x
neglectIndent :: (Monad m, Show t, Show i, Indentation i,
Stream s (IndentT i m) t)
=> GenIndentParsecT i s u m a
-> GenIndentParsecT i s u m a
neglectIndent p = do o <- get
lift $ put always
x <- p
lift $ put o
return x
runGIPT' :: (Monad m, Stream s (IndentT i m) t)
=> i
-> GenIndentParsecT i s u m a
-> u
-> SourceName
-> s
-> m (Either ParseError a)
runGIPT' i p u sname s = evalStateT (runPT p u sname s) i
runGIPT :: (Monad m, Indentation i, Stream s (IndentT i m) t)
=> GenIndentParsecT i s u m a
-> u
-> SourceName
-> s
-> m (Either ParseError a)
runGIPT = runGIPT' always
data HaskellLike = Never
| Neglect
| Block SourcePos
| LineFold SourcePos
instance Indentation HaskellLike where
never = Never
always = Neglect
acceptable Never _ = False
acceptable Neglect _ = True
acceptable (Block bp) p = sourceColumn bp <= sourceColumn p
acceptable (LineFold lp) p = sourceColumn lp < sourceColumn p ||
lp == p
nestableIn (Block i) (Block o) = sourceColumn o < sourceColumn i
nestableIn (Block i) (LineFold o) = sourceColumn o < sourceColumn i
nestableIn (LineFold i) (LineFold o) = sourceColumn o < sourceColumn i
nestableIn (LineFold i) (Block o) = sourceColumn o <= sourceColumn i
nestableIn _ _ = True
instance Show HaskellLike where
show Never = "empty block"
show Neglect = "unindented chunk"
show (Block pos) = "block started at " ++ show pos
show (LineFold pos) = "line fold started at " ++ show pos
type GenIndentParsec i s u a = GenIndentParsecT i s u Identity a
type IndentParsecT s u m a = GenIndentParsecT HaskellLike s u m a
type IndentParsec s u a = IndentParsecT s u Identity a