Extract common parsing code

code/cs325-langs/src/LanguageTwo.hs

@@ -1,5 +1,6 @@
 module LanguageTwo where
 import qualified PythonAst as Py
+import qualified CommonParsing as P
 import Data.Char
 import Data.Functor
 import Text.Parsec
@@ -33,95 +34,50 @@ data Prog = Prog Expr [Stmt] [Stmt]
 {- Parser -}
 type Parser = Parsec String ()
 
-parseKw :: String -> Parser ()
-parseKw s = string s $> ()
-
-parseKwIf :: Parser ()
-parseKwIf = parseKw "if"
-
-parseKwElse :: Parser ()
-parseKwElse = parseKw "else"
-
-parseKwState :: Parser ()
-parseKwState = parseKw "state"
-
-parseKwEffect :: Parser ()
-parseKwEffect = parseKw "effect"
-
-parseKwCombine :: Parser ()
-parseKwCombine = parseKw "combine"
-
-parseOp :: String -> Op -> Parser Op
-parseOp s o = string s $> o
-
-parseInt :: Parser Int
-parseInt = read <$> (many1 digit <* spaces)
-
 parseVar :: Parser String
-parseVar =
-    do
-        c <- satisfy $ \c -> isLetter c || c == '_'
-        cs <- many (satisfy isLetter <|> digit) <* spaces
-        let name = c:cs
-        if name `elem` ["if", "else", "state", "effect", "combine"]
-        then fail "Can't use reserved keyword as identifier"
-        else return name
-
-parseSurrounded :: Char -> Char -> Parser a -> Parser a
-parseSurrounded c1 c2 pe =
-    do
-        char c1 >> spaces
-        e <- pe
-        spaces >> char c2 >> spaces
-        return e
+parseVar = P.var [ "if", "else", "state", "effect", "combine" ]
 
 parseLength :: Parser Expr
-parseLength = Length <$> parseSurrounded '|' '|' parseExpr
+parseLength = Length <$> P.surround '|' '|' parseExpr
 
 parseParenthesized :: Parser Expr
-parseParenthesized = parseSurrounded '(' ')' parseExpr
+parseParenthesized = P.surround '(' ')' parseExpr
 
 parseBasic :: Parser Expr
 parseBasic = choice
-    [ IntLiteral <$> parseInt
+    [ IntLiteral <$> P.int
     , Var <$> parseVar
     , parseLength
     , parseParenthesized
     ]
 
-parseLevel :: Parser Op -> Parser Expr -> Parser Expr
-parseLevel po pe =
-    do
-        e <- pe <* spaces
-        ops <- many ((flip . BinOp <$> (po <* spaces) <*> pe) <* spaces)
-        return $ foldl (flip ($)) e ops
 
 parseExpr :: Parser Expr
-parseExpr = foldl (flip parseLevel) parseBasic
-    [ parseOp "*" Multiply <|> parseOp "/" Divide
-    , parseOp "+" Add <|> parseOp "-" Subtract
-    , parseOp "==" Equal <|> parseOp "!=" NotEqual
-    , parseOp "&&" And
-    , try $ parseOp "||" Or
+parseExpr = P.precedence BinOp parseBasic
+    [ P.op "*" Multiply <|> P.op "/" Divide
+    , P.op "+" Add <|> P.op "-" Subtract
+    , P.op "==" Equal <|> P.op "!=" NotEqual
+    , P.op "&&" And
+    , try $ P.op "||" Or
     ]
 
 parseIf :: Parser Stmt
 parseIf = do
-    parseKwIf >> spaces
+    P.kwIf >> spaces
     c <- parseParenthesized
     t <- parseStmt <* spaces
-    e <- (Just <$> (parseKwElse >> spaces *> parseStmt)) <|> return Nothing
+    e <- (Just <$> (P.kwElse >> spaces *> parseStmt)) <|> return Nothing
     return $ IfElse c t e
 
 parseBlockStmts :: Parser [Stmt]
-parseBlockStmts = parseSurrounded '{' '}' (many parseStmt)
+parseBlockStmts = P.surround '{' '}' (many parseStmt)
 
 parseBlock :: Parser Stmt
 parseBlock = Block <$> parseBlockStmts
 
 parseAssign :: Parser Stmt
 parseAssign = Assign <$>
-    (parseVar <* spaces <* char '=' <* spaces) <*>
+    (parseVar <* char '=' <* spaces) <*>
     parseExpr <* (char ';' >> spaces)
 
 parseStmt :: Parser Stmt
@@ -133,9 +89,9 @@ parseStmt = choice
 
 parseProgram :: Parser Prog
 parseProgram = do
-    state <- parseKwState >> spaces *> parseExpr <* char ';' <* spaces
-    effect <- parseKwEffect >> spaces *> parseBlockStmts <* spaces
-    combined <- parseKwCombine >> spaces *> parseBlockStmts <* spaces
+    state <- P.kwState >> spaces *> parseExpr <* char ';' <* spaces
+    effect <- P.kwEffect >> spaces *> parseBlockStmts <* spaces
+    combined <- P.kwCombine >> spaces *> parseBlockStmts <* spaces
     return $ Prog state effect combined
 
 parse :: String -> String -> Either ParseError Prog