module Text.Parsec.Indent (
IndentT, IndentParserT, IndentParser, runIndent,
runIndentParserT, runIndentParser,
withBlock, withBlock', block,
indented, same, sameOrIndented, checkIndent,
topLevel, notTopLevel,
withPos,
indentBrackets, indentAngles, indentBraces, indentParens,
(<+/>), (<-/>), (<*/>), (<?/>), Optional(..)
) where
import Control.Monad (ap, liftM2, unless, when)
import Control.Monad.Identity (Identity, runIdentity)
import Control.Monad.Reader (ReaderT, ask, local, runReaderT)
import Text.Parsec
import Text.Parsec.Token
data Pos = Pos
{ pLine :: !Int
, pColumn :: !Int
} deriving (Show)
showIndent :: Pos -> String
showIndent pos = case pColumn pos of
1 -> "top-level indentation"
c -> show (c 1) ++ "-column indentation"
showLine :: Pos -> String
showLine = show . pLine
getCurrentPos :: Monad m => IndentParserT s u m Pos
getCurrentPos = do
pos <- getPosition
return $! Pos {pLine = sourceLine pos, pColumn = sourceColumn pos}
getReferencePos :: Monad m => IndentParserT s u m Pos
getReferencePos = ask
type IndentT m = ReaderT Pos m
type IndentParserT s u m a = ParsecT s u (IndentT m) a
type IndentParser s u a = IndentParserT s u Identity a
withBlock
:: (Monad m, Stream s (IndentT m) z)
=> (a -> [b] -> c)
-> IndentParserT s u m a
-> IndentParserT s u m b
-> IndentParserT s u m c
withBlock f a p = withPos $ do
r1 <- a
r2 <- option [] (indented >> block p)
return (f r1 r2)
withBlock'
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m a
-> IndentParserT s u m b
-> IndentParserT s u m [b]
withBlock' = withBlock (flip const)
indented
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m ()
indented = do
pos <- getCurrentPos
ref <- getReferencePos
when (pColumn pos <= pColumn ref) $ unexpected (showIndent pos)
sameOrIndented
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m ()
sameOrIndented = do
pos <- getCurrentPos
ref <- getReferencePos
when (pColumn pos <= pColumn ref && pLine pos /= pLine ref) $
unexpected (showIndent pos)
same
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m ()
same = do
pos <- getCurrentPos
ref <- getReferencePos
when (pLine pos /= pLine ref) $ unexpected "line break"
block
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m a
-> IndentParserT s u m [a]
block p = withPos $ do
r <- many1 (checkIndent >> p)
return r
withPos
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m a
-> IndentParserT s u m a
withPos x = do
p <- getCurrentPos
local (const p) x
checkIndent
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m ()
checkIndent = do
ref <- getReferencePos
pos <- getCurrentPos
when (pColumn pos /= pColumn ref) $
(<?> showIndent ref ++ " (started at line " ++ showLine ref ++ ")")
(unexpected $ showIndent pos)
topLevel
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m ()
topLevel = do
pos <- getCurrentPos
unless (pColumn pos == 1) $ unexpected "indentation"
notTopLevel
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m ()
notTopLevel = do
pos <- getCurrentPos
when (pColumn pos == 1) $ unexpected "top-level"
runIndentT :: Monad m => IndentT m a -> m a
runIndentT i = runReaderT i (Pos 1 1)
runIndent :: IndentT Identity a -> a
runIndent = runIdentity . runIndentT
runIndentParserT
:: (Monad m, Stream s (IndentT m) t)
=> IndentParserT s u m a
-> u
-> SourceName
-> s
-> m (Either ParseError a)
runIndentParserT parser u source txt =
runIndentT (runParserT parser u source txt)
runIndentParser
:: Stream s (IndentT Identity) t
=> IndentParser s u a
-> u
-> SourceName
-> s
-> Either ParseError a
runIndentParser parser u source txt =
runIdentity (runIndentParserT parser u source txt)
(<+/>)
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m (a -> b)
-> IndentParserT s u m a
-> IndentParserT s u m b
a <+/> b = ap a (sameOrIndented >> b)
(<-/>)
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m a
-> IndentParserT s u m b
-> IndentParserT s u m a
a <-/> b = liftM2 const a (sameOrIndented >> b)
(<*/>)
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m ([a] -> b)
-> IndentParserT s u m a
-> IndentParserT s u m b
a <*/> b = ap a (many (sameOrIndented >> b))
data Optional s u m a = Opt a (IndentParserT s u m a)
(<?/>)
:: (Monad m, Stream s (IndentT m) z)
=> IndentParserT s u m (a -> b)
-> (Optional s u m a)
-> IndentParserT s u m b
(<?/>) a (Opt b c) = ap a (option b (sameOrIndented >> c))
indentBrackets
:: (Monad m, Stream s (IndentT m) z)
=> GenTokenParser s u (IndentT m)
-> IndentParserT s u m a
-> IndentParserT s u m a
indentBrackets lexer p = withPos $ return id <-/> symbol lexer "[" <+/> p <-/> symbol lexer "]"
indentAngles
:: (Monad m, Stream s (IndentT m) z)
=> GenTokenParser s u (IndentT m)
-> IndentParserT s u m a
-> IndentParserT s u m a
indentAngles lexer p = withPos $ return id <-/> symbol lexer "<" <+/> p <-/> symbol lexer ">"
indentBraces
:: (Monad m, Stream s (IndentT m) z)
=> GenTokenParser s u (IndentT m)
-> IndentParserT s u m a
-> IndentParserT s u m a
indentBraces lexer p = withPos $ return id <-/> symbol lexer "{" <+/> p <-/> symbol lexer "}"
indentParens
:: (Monad m, Stream s (IndentT m) z)
=> GenTokenParser s u (IndentT m)
-> IndentParserT s u m a
-> IndentParserT s u m a
indentParens lexer p = withPos $ return id <-/> symbol lexer "(" <+/> p <-/> symbol lexer ")"