module CommonParsing where import Data.Char import Data.Functor import Text.Parsec import Text.Parsec.Char import Text.Parsec.Combinator type Parser a b = Parsec String a b kw :: String -> Parser a () kw s = try $ string s <* spaces $> () kwIf :: Parser a () kwIf = kw "if" kwThen :: Parser a () kwThen = kw "then" kwElse :: Parser a () kwElse = kw "else" kwElsif :: Parser a () kwElsif = kw "elsif" kwWhile :: Parser a () kwWhile = kw "while" kwState :: Parser a () kwState = kw "state" kwEffect :: Parser a () kwEffect = kw "effect" kwCombine :: Parser a () kwCombine = kw "combine" kwRand :: Parser a () kwRand = kw "rand" kwFunction :: Parser a () kwFunction = kw "function" kwSorted :: Parser a () kwSorted = kw "sorted" kwLet :: Parser a () kwLet = kw "let" kwTraverser :: Parser a () kwTraverser = kw "traverser" kwReturn :: Parser a () kwReturn = kw "return" op :: String -> op -> Parser a op op s o = string s $> o int :: Parser a Int int = read <$> (many1 digit <* spaces) var :: [String] -> Parser a String var reserved = do c <- satisfy $ \c -> isLetter c || c == '_' cs <- many (satisfy isLetter <|> digit) <* spaces let name = c:cs if name `elem` reserved then fail "Can't use reserved keyword as identifier" else return name list :: Char -> Char -> Char -> Parser a b -> Parser a [b] list co cc cd pe = surround co cc $ sepBy pe (char cd >> spaces) surround :: Char -> Char -> Parser a b -> Parser a b surround c1 c2 pe = do char c1 >> spaces e <- pe spaces >> char c2 >> spaces return e level :: (o -> e -> e -> e) -> Parser a o -> Parser a e -> Parser a e level c po pe = do e <- pe <* spaces ops <- many $ try $ (flip . c <$> (po <* spaces) <*> pe) <* spaces return $ foldl (flip ($)) e ops precedence :: (o -> e -> e -> e) -> Parser a e -> [ Parser a o ] -> Parser a e precedence = foldl . flip . level