module Text.Parsec.Indent (
IndentParser, runIndent,
withBlock, withBlock', block,
indented, same, sameOrIndented, checkIndent, withPos,
indentBrackets, indentAngles, indentBraces, indentParens,
(<+/>), (<-/>), (<*/>), (<?/>), Optional(..)
) where
import Text.Parsec hiding (State)
import Text.Parsec.Pos
import Text.Parsec.Token
import Control.Monad.State
import Control.Concatenative
type IndentParser s u a = ParsecT s u (State SourcePos) a
withBlock :: (Stream s (State SourcePos) Char) => (a -> [b] -> c) ->
IndentParser s u a -> IndentParser s u b -> IndentParser s u c
withBlock f a p = withPos $ do
r1 <- a
r2 <- option [] (indented >> block p)
return (f r1 r2)
withBlock' :: (Stream s (State SourcePos) Char) =>
IndentParser s u a -> IndentParser s u b -> IndentParser s u [b]
withBlock' = withBlock (flip const)
indented :: (Stream s (State SourcePos) Char) => IndentParser s u ()
indented = do
pos <- getPosition
s <- get
if biAp sourceColumn (<=) pos s then parserFail "not indented" else do
put $ setSourceLine s (sourceLine pos)
return ()
sameOrIndented :: Stream s (State SourcePos) Char => IndentParser s u ()
sameOrIndented = same <|> indented
same :: (Stream s (State SourcePos) Char) => IndentParser s u ()
same = do
pos <- getPosition
s <- get
if biAp sourceLine (==) pos s then return () else parserFail "over one line"
block :: (Stream s (State SourcePos) Char) => IndentParser s u a -> IndentParser s u [a]
block p = withPos $ do
r <- many1 (checkIndent >> p)
return r
withPos :: (Stream s (State SourcePos) Char) => IndentParser s u a -> IndentParser s u a
withPos x = do
a <- get
p <- getPosition
r <- put p >> x
put a >> return r
checkIndent :: (Stream s (State SourcePos) Char) => IndentParser s u ()
checkIndent = do
s <- get
p <- getPosition
if biAp sourceColumn (==) p s then return () else parserFail "indentation doesn't match"
runIndent :: SourceName -> State SourcePos a -> a
runIndent s = flip evalState (initialPos s)
(<+/>) :: (Stream s (State SourcePos) Char) =>
IndentParser s u (a -> b) -> IndentParser s u a -> IndentParser s u b
a <+/> b = ap a (sameOrIndented >> b)
(<-/>) :: (Stream s (State SourcePos) Char) =>
IndentParser s u a -> IndentParser s u b -> IndentParser s u a
a <-/> b = liftM2 const a (sameOrIndented >> b)
(<*/>) :: (Stream s (State SourcePos) Char) =>
IndentParser s u ([a] -> b) -> IndentParser s u a -> IndentParser s u b
a <*/> b = ap a (many (sameOrIndented >> b))
data Optional s u a = Opt a (IndentParser s u a)
(<?/>) :: (Stream s (State SourcePos) Char) =>
IndentParser s u (a -> b) -> (Optional s u a) -> IndentParser s u b
(<?/>) a (Opt b c) = ap a (option b (sameOrIndented >> c))
indentBrackets :: (Stream s (State SourcePos) Char) => GenTokenParser s u (State SourcePos) -> IndentParser s u a -> IndentParser s u a
indentBrackets lexer p = withPos $ return id <-/> symbol lexer "[" <+/> p <-/> symbol lexer "]"
indentAngles :: (Stream s (State SourcePos) Char) => GenTokenParser s u (State SourcePos) -> IndentParser s u a -> IndentParser s u a
indentAngles lexer p = withPos $ return id <-/> symbol lexer "<" <+/> p <-/> symbol lexer ">"
indentBraces :: (Stream s (State SourcePos) Char) => GenTokenParser s u (State SourcePos) -> IndentParser s u a -> IndentParser s u a
indentBraces lexer p = withPos $ return id <-/> symbol lexer "{" <+/> p <-/> symbol lexer "}"
indentParens :: (Stream s (State SourcePos) Char) => GenTokenParser s u (State SourcePos) -> IndentParser s u a -> IndentParser s u a
indentParens lexer p = withPos $ return id <-/> symbol lexer "(" <+/> p <-/> symbol lexer ")"