Parser for functions, lambdas, conditions and symbols

LobsterLang/src/Parse.hs

@@ -27,16 +27,19 @@
     parseValue,
     parseLobster,
     parseAnyString,
+    parseCmpString,
     parseDefineValue,
-    parseUnaryOperation,
     parseProduct,
     parseSum,
     parseExpr,
     parseTrue,
     parseFalse,
     parseAstString,
     parseWhiteSpace,
-    errorParsing
+    errorParsing,
+    parseDefineFn,
+    parseLambda,
+    parseCond
 ) where
 
 import qualified AST
@@ -45,7 +48,7 @@
 
 type Position = (Int, Int)
 
 data Parser a = Parser {
     runParser :: Position -> String -> Either String (a, String, Position)
 }
 
@@ -206,7 +209,7 @@
 -- | Parse with a parser and, if possible with a space
 -- Return a Parser that parse element with the given parser and, if possible with multiple space
 parseElem :: Parser a -> Parser a
 parseElem parser = parseAndWith (\x _ -> x) parser parseWhiteSpace <|> parser
 
 -- | Return a data Parser that parse a String
 parseString :: Parser String
@@ -286,16 +289,43 @@
                                  parseWhiteSpace *> parseAnyString "(|" *> parseExpr <* parseAnyString "|)" <* parseWhiteSpace
                                  <|> AST.Value <$> parseElem parseInt
                                  <|> parseBool
+                                 <|> parseSymbol
+                                 <|> parseUnaryOperator
                                 )
 
+parseUnaryOperator :: Parser AST.Ast
+parseUnaryOperator = parseWhiteSpace *> parseAnyString "!"<|>
+                     parseWhiteSpace *> parseAnyString "@" <|>
+                     parseWhiteSpace *> parseAnyString "~   "
+                        >>= \op -> parseValue
+                                        >>= \value -> return $ AST.Call op [value]
+
+parseListElem :: Parser a -> Parser [a]
+parseListElem parserA = Parser (parseFirst parserA)
+    where
+        parseFirst :: Parser a -> Position -> String -> Either String ([a], String, Position)
+        parseFirst parser pos s = case runParser parser pos s of
+            Left _ -> Right ([], s, pos)
+            Right (res, s', pos') -> case (parseOthers parser pos' s') of
+                Left err -> Left err
+                Right (res', s'', pos'') -> Right(res : res', s'', pos'')
+        parseOthers :: Parser a -> Position -> String -> Either String ([a], String, Position)
+        parseOthers parser pos s = case runParser (parseChar ',') pos s of
+            Left _ -> Right ([], s, pos)
+            Right (_, s', pos') -> case runParser parser pos' s' of
+                Left err -> Left err
+                Right (res, s'', pos'') -> case (parseOthers parser pos'' s'') of
+                    Left err -> Left err
+                    Right (res', s''', pos''') -> Right (res : res', s''', pos''')
+
 -- | Parse a list of element
 -- Return a Parser of list `element` that start with a '(' and end with a ')'
 parseList :: Parser a -> Parser [a]
 parseList parser = parseStart *> parseListValue <* parseEnd
     where
-        parseEnd = parseChar ')' <* parseWhiteSpace
-        parseListValue = parseWhiteSpace *> parseMany (parseElem parser) <* parseWhiteSpace
-        parseStart = parseWhiteSpace *> parseChar '('
+        parseEnd = parseAnyString "|)" <* parseWhiteSpace
+        parseListValue = parseWhiteSpace *> parseListElem parser <* parseWhiteSpace
+        parseStart = parseWhiteSpace *> parseAnyString "(|"
 
 -- | Parse any character from a String
 -- Return a Parser that parse every character from a String
@@ -323,6 +353,14 @@
             Right (_, s'', pos') -> f xs str pos' s''
         f [] str pos s' = Right (str, s', pos)
 
+parseCmpString :: String -> Parser String
+parseCmpString s = Parser (f s)
+    where
+        f :: String -> Position -> String -> Either String (String, String, Position)
+        f str pos s' = case runParser parseString pos s' of
+            Left err -> Left err
+            Right (res, s'', pos') -> if str == res then Right (res, s'', pos') else Left (errorParsing pos')
+
 -- | Return a Parser that parse a Bool (#f or #t)
 parseBool :: Parser AST.Ast
 parseBool = AST.Boolean <$> (parseTrue <|> parseFalse) <* parseWhiteSpace
@@ -357,34 +395,79 @@
                     Left err'' -> Left err''
                     Right (res'', s''', pos''') -> Right (AST.Define res res'', s''', pos''')
 
-parseUnaryOperator :: Parser String
-parseUnaryOperator = parseWhiteSpace *> parseAnyString "!"<|>
-                     parseWhiteSpace *> parseAnyString "@" <|>
-                     parseWhiteSpace *> parseAnyString "~"
-
-parseUnaryOperation :: Parser AST.Ast
-parseUnaryOperation = Parser f
-    where
-        f :: Position -> String -> Either String (AST.Ast, String, Position)
-        f pos s = case runParser parseUnaryOperator pos s of
-            Left err -> Left err
-            Right (res, s', pos') -> case runParser parseAst pos' s' of
-                Left err' -> Left err'
-                Right (res', s'', pos'') -> Right (AST.Call res [res'], s'', pos'')
+parseSymbol :: Parser AST.Ast
+parseSymbol = do
+                name <- parseString
+                args <- optional (parseWhiteSpace *> parseList parseAst
+                            >>= \res -> return $ AST.Symbol name (Just res))
+                return $ fromMaybe (AST.Symbol name Nothing) args
 
 -- | Return a Parser that parse a SExpr
 parseAst :: Parser AST.Ast
 parseAst = parseWhiteSpace *>
         (
-            parseDefineValue
-        <|> parseExpr
+        parseDefineFn
+        <|> parseCond
+        <|> parseDefineValue
+        <|> parseLambda
         <|> parseBool
-        <|> parseUnaryOperation
+        <|> parseExpr
         <|> parseAstString
         <|> parseValue
-        <|> parseAstString
+        <|> parseSymbol
         )
 
+parseDefineFn :: Parser AST.Ast
+parseDefineFn = parseCmpString "fn" *> (Parser defineFn)
+    where
+        defineFn :: Position -> String -> Either String (AST.Ast, String, Position)
+        defineFn s pos = case runParser parseString s pos of
+            Left err -> Left err
+            Right (res, s', pos') -> case runParser parseFunctionValue pos' s' of
+                Left err -> Left err
+                Right (res', s'', pos'') -> Right (AST.Define res res', s'', pos'')
+
+parseLambda :: Parser AST.Ast
+parseLambda = lambda *> parseFunctionValue
+    where
+        lambda = parseCmpString "lambda" <|> parseAnyString "λ"
+
+parseFunctionValue :: Parser AST.Ast
+parseFunctionValue = Parser parseParams
+    where
+        parseParams :: Position -> String -> Either String (AST.Ast, String, Position)
+        parseParams s pos = case runParser (parseList parseString) s pos of
+            Left err -> Left err
+            Right (res, s', pos') -> case runParser parseBracket pos' s' of
+                Left err -> Left err
+                Right (res', s'', pos'') -> Right (AST.FunctionValue res res' Nothing, s'', pos'')
+
+parseBracket :: Parser AST.Ast
+parseBracket = parseStart *> parseAst <* parseEnd
+    where
+        parseEnd = parseWhiteSpace *> parseChar '}' <* parseWhiteSpace
+        parseStart = parseWhiteSpace *> parseChar '{' <* parseWhiteSpace
+
+parseCond :: Parser AST.Ast
+parseCond = parseCmpString "if" *> Parser parseIf
+    where
+        parseIf :: Position -> String -> Either String (AST.Ast, String, Position)
+        parseIf pos s = case runParser parseExpr pos s of
+            Left err -> Left err
+            Right (res, s', pos') -> case runParser parseBracket pos' s' of
+                Left err -> Left err
+                Right (res', s'', pos'') -> case runParser parseElse pos'' s'' of
+                    Left _ -> Right ((AST.Cond res res' Nothing), s'', pos'')
+                    Right (res'', s''', pos''') -> Right ((AST.Cond res res' (Just res'')), s''', pos''')
+        parseElse :: Parser AST.Ast
+        parseElse = parseCmpString "else" *> Parser p
+            where
+                p :: Position -> String -> Either String (AST.Ast, String, Position)
+                p pos s = case runParser parseCond pos s of
+                    Left _ -> case runParser parseBracket pos s of
+                        Left err -> Left err
+                        Right (res, s', pos') -> Right (res, s', pos')
+                    Right (res, s', pos') -> Right (res, s', pos')
 
 parseLobster :: Parser [AST.Ast]
 parseLobster = parseSome (parseWhiteSpace *> parseAst)

LobsterLang/test/ParserSpec.hs

@@ -1,4 +1,4 @@
 {-
 -- EPITECH PROJECT, 2023
 -- ParserSpec.hs
 -- File description:
@@ -9,7 +9,7 @@
 
 import Test.Hspec
 import Parse
 import Parse (parseExpr, parseDefineValue, errorParsing, parseBool, parseLobster, parseString, parseMany)
 import qualified AST
 import AST (Ast(Value))
 
@@ -80,18 +80,20 @@
             runParser (parseElem parseString) (0,0) "hello la " `shouldBe` Right ("hello", "la ", (0,6))
         it "Check parseValue Success" $ do
             runParser parseValue (0,0) "432           la " `shouldBe` Right (AST.Value 432, "la ", (0,14))
-        it "Check parseList with parseInt Success" $ do
-            runParser (parseList parseInt) (0,0) "(1 2 3   4 5)" `shouldBe` Right ([1, 2 ,3 , 4, 5], "", (0, 13))
-        it "Check parseList with parseInt Failure (without a number inside)" $ do
-            runParser (parseList parseInt) (0,0) "(1 2 3  d 4 5) (0,0) " `shouldBe` Left (errorParsing (0,8))
-        it "Check parseList with parseInt Failure (without a ending ')')" $ do
-            runParser (parseList parseInt) (0,0) "(1 2 3  4 5 " `shouldBe` Left (errorParsing (0,12))
-        it "Check parseList with parseInt Failure (without a starting '(')" $ do
-            runParser (parseList parseInt) (0,0) "1 2 3  4 5)" `shouldBe` Left (errorParsing (0,0))
-        it "Check parseList with parseString Success" $ do
-            runParser (parseList parseString) (0,0) "(buenos owow k ye    )1 2 3  4 5)" `shouldBe` Right (["buenos", "owow", "k", "ye"], "1 2 3  4 5)", (0, 22))
+        it "Check parseList String Success" $ do
+            runParser (parseList parseString) (0,0) "(| a,  b ,c, d   |)" `shouldBe` Right(["a", "b", "c", "d"], "", (0,19))
+        it "Check parseList Error missing comma" $ do
+            runParser (parseList parseString) (0,0) "(| a b |)" `shouldBe` Left "Error on parsing on '0' '5'"
+        it "Check parseList Error end with comma" $ do
+            runParser (parseList parseString) (0,0) "(|a, |)" `shouldBe` Left "Error on parsing on '0' '5'"
+        it "Check parseList Error starting with comma" $ do
+            runParser (parseList parseString) (0,0) "(|,a|)" `shouldBe` Left "Error on parsing on '0' '2'"
+        it "Check parseList Error missing starting bracket" $ do
+            runParser (parseList parseString) (0,0) "a, b|)" `shouldBe` Left "Error on parsing on '0' '0'"
+        it "Check parseList Error missing ending bracket" $ do
+            runParser (parseList parseString) (0,0) "(|a, b" `shouldBe` Left "Error on parsing on '0' '6'"
         it "Check parseList with parseString Failure" $ do
-            runParser (parseList parseString) (0,0) "(buenos 3 owow k ye    )1 2 3  4 5)" `shouldBe` Left (errorParsing (0,8))
+            runParser (parseList parseString) (0,0) "(|buenos, 3, owow, k, ye    |)" `shouldBe` Left (errorParsing (0,10))
         it "Check parseBool true Success" $ do
             runParser parseBool (0,0) "true lp" `shouldBe` Right (AST.Boolean True, "lp", (0,5))
         it "Check parseBool false Success" $ do
@@ -176,9 +178,9 @@
             runParser parseString (0,0) "_Lob3ster*" `shouldBe` Right ("_Lob3ster","*",(0,9))
         it "Check parseMany Success" $ do
             runParser (parseMany (parseChar ' ')) (0,0) " p" `shouldBe` Right (" ","p",(0,1))
-        it "Check parseUnaryOperation Success" $ do
-            runParser parseUnaryOperation (0,0) "! true" `shouldBe` Right (AST.Call "!" [AST.Boolean True],"",(0,6))
-        it "Check parseUnaryOperation Failure (incorrect AST)" $ do
-            runParser parseUnaryOperation (0,0) "! *" `shouldBe` Left (errorParsing (0,2))
-        it "Check parseUnaryOperation Failure (missing operator)" $ do
-            runParser parseUnaryOperation (0,0) "error" `shouldBe` Left (errorParsing (0,0))
+        it "Check parseExpr Unary Operation Success" $ do
+            runParser parseExpr (0,0) "! true" `shouldBe` Right (AST.Call "!" [AST.Boolean True],"",(0,6))
+        it "Check parseExpr Unary Operation Failure (incorrect AST)" $ do
+            runParser parseExpr (0,0) "! *" `shouldBe` Left (errorParsing (0,2))
+        it "Check parseExpr Unary Operation Failure (missing operator)" $ do
+            runParser parseExpr (0,0) "error" `shouldBe` Right (AST.Symbol "error" Nothing, "", (0, 5))