59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly{- |

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'ReillyModule : $Header$

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'ReillyDescription : Parsec extensions

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'ReillyCopyright : (c) Christian Maeder, DFKI GmbH 2010

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'ReillyLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'ReillyMaintainer : Christian.Maeder@dfki.de

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'ReillyStability : provisional

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'ReillyPortability : portable

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reillyfrequently useful shortcuts mainly for character parsers

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly-}

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reillymodule Common.Parsec where

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reillyimport Text.ParserCombinators.Parsec

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reillyimport Control.Monad

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly-- * monad shortcuts

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reillyinfixl 1 <<

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly(<<) :: Monad m => m a -> m b -> m a

59fa1834b615fd0299a5607e425ed9db0f8376e4Liam O'Reilly(<<) = liftM2 const

forget :: Monad m => m a -> m ()

forget = (>> return ())

pair :: Monad m => m a -> m b -> m (a, b)

pair = liftM2 (,)

infixr 5 <:>

(<:>) :: Monad m => m a -> m [a] -> m [a]

(<:>) = liftM2 (:)

infixr 5 <++>

(<++>) :: Monad m => m [a] -> m [a] -> m [a]

(<++>) = liftM2 (++)

single :: Monad m => m a -> m [a]

single = liftM return

flat :: Monad m => m [[a]] -> m [a]

flat = liftM concat

begDoEnd :: Monad m => m a -> m [a] -> m a -> m [a]

begDoEnd open p close = open <:> p <++> single close

enclosedBy :: Monad m => m [a] -> m a -> m [a]

enclosedBy p q = begDoEnd q p q

-- * parsec shortcuts

-- | parse an optional list

optionL :: GenParser tok st [a] -> GenParser tok st [a]

optionL = option []

-- | shortcut for @try . string@

tryString :: String -> CharParser st String

tryString = try . string

-- | nested comments, open and closing strings must have at least two chars

nestedComment :: String -> String -> CharParser st String

nestedComment op cl = case (op, cl) of

(oh : ot : _, ch : ct : _) ->

tryString op <++>

flat (many $ single

(noneOf [oh, ch]

<|> try (char ch << notFollowedBy (char ct))

<|> try (char oh << notFollowedBy (char ot)))

<|> nestedComment op cl)

<++> string cl

_ -> error "nestedComment"

-- | non-nested block

plainBlock :: String -> String -> CharParser st String

plainBlock op cl = tryString op >> manyTill anyChar (tryString cl)

reserved :: [String] -> CharParser st String -> CharParser st String

-- | reject keywords

reserved l p = try $ do

s <- p

if elem s l then unexpected $ show s else return s