status: working, IO not yet implemented

lib/CombParse.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE LambdaCase #-}
+
+module CombParse (runParser, parseExpr, parseAtom, parseVal, Value (..), Expr (..), toComblang) where
+
+import Text.ParserCombinators.ReadP (ReadP, between, char, choice, eof, many1, munch, munch1, optional, readP_to_S, satisfy, skipSpaces, (+++), (<++))
+import Unicode.Char (isDigit)
+import Unicode.Char.Identifiers (isXIDContinue, isXIDStart)
+
+data Value = Str String | Id String | Numb Int deriving (Show, Eq)
+
+data Expr = Var Value | Comb Expr Expr | Param Int | Op String Expr deriving (Show, Eq)
+
+toComblang :: Expr -> String
+toComblang (Comb e1 e2) = "(" ++ toComblang e1 ++ " " ++ toComblang e2 ++ ")"
+toComblang (Var (Id str)) = str
+toComblang (Var (Str str)) = '"' : str ++ "\""
+toComblang (Var (Numb n)) = show n
+toComblang _ = error "passed a compile time parameter to a parse time function"
+
+token :: ReadP a -> ReadP a
+token = (skipSpaces +++ (optional (char '\r') <* char '\n') *>)
+
+parseVal :: ReadP Value
+parseVal =
+  choice
+    [ Str <$> between (char '"') (char '"') (munch (/= '"')),
+      Numb . read <$> munch1 isDigit,
+      Id <$> ((:) <$> satisfy isXIDStart <*> munch isXIDContinue)
+    ]
+
+parseAtom :: ReadP Expr
+parseAtom = token $ (Var <$> parseVal) <++ between (token $ char '(') (char ')') parseExpr
+
+parseExpr :: ReadP Expr
+parseExpr = foldl1 Comb <$> many1 parseAtom
+
+runParser :: ReadP a -> String -> Maybe a
+runParser =
+  ( \case
+      [] -> Nothing
+      x -> Just $ fst $ last x
+  )
+    .: readP_to_S
+    . (<* token eof)
+    . token
+
+infixr 9 .:
+
+(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
+(.:) = (.) . (.)