Extract common parsing code

code/cs325-langs/src/CommonParsing.hs

@@ -0,0 +1,66 @@
+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 = string s $> ()
+
+kwIf :: Parser a ()
+kwIf = kw "if"
+
+kwThen :: Parser a ()
+kwThen = kw "then"
+
+kwElse :: Parser a ()
+kwElse = kw "else"
+
+kwState :: Parser a ()
+kwState = kw "state"
+
+kwEffect :: Parser a ()
+kwEffect = kw "effect"
+
+kwCombine :: Parser a ()
+kwCombine = kw "combine"
+
+kwRand :: Parser a ()
+kwRand = kw "rand"
+
+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
+
+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