Add parse of one expression

lvtc/app/Main.hs

@@ -8,6 +8,10 @@
 module Main (main) where
 
 import Lib
+import Expression
+import Parser
 
 main :: IO ()
-main = someFunc
+-- main = print $ runParser (parseExpresion) "fn main () -> Int \n{\n    <- 0;\n};\n"
+-- main = print $ runParser (parseExpresion) "alias abc def;\n"
+main = print $ runParser (parseExpresion) "// this is a comment\n"

lvtc/lvtc.cabal

@@ -1,6 +1,6 @@
 cabal-version: 2.2
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -25,7 +25,10 @@ source-repository head
 
 library
   exposed-modules:
+      Expression
       Lib
+      Parser
+      ParseUtil
   other-modules:
       Paths_lvtc
   autogen-modules:
@@ -64,4 +67,6 @@ test-suite lvtc-test
   build-depends:
       base >=4.7 && <5
     , lvtc
+    , tasty
+    , tasty-hunit
   default-language: Haskell2010

lvtc/package.yaml

@@ -57,3 +57,5 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - lvtc
+    - tasty
+    - tasty-hunit

lvtc/src/Expression.hs

@@ -0,0 +1,40 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator compiler
+-- File description:
+-- Expression
+-}
+
+module Expression (
+        Expression (..),
+        parseExpresion,
+    ) where
+
+import Parser
+import Control.Applicative
+import ParseUtil
+
+data Expression = Function String | Alias String | Comment String
+
+instance Show Expression where
+    show (Function str) = "F:`" ++ str ++ "`"
+    show (Alias str) = "A:`" ++ str ++ "`"
+    show (Comment str) = "C:`" ++ str ++ "`"
+
+instance Eq Expression where
+    (==) (Function str1) (Function str2) = str1 == str2
+    (==) (Alias str1) (Alias str2) = str1 == str2
+    (==) (Comment str1) (Comment str2) = str1 == str2
+    (==) _ _ = False
+
+parseFunction :: Parser Expression
+parseFunction = Function <$> ((++) <$> (parseString "fn " <|> parseString "export fn") <*> parseAllCharUntil "\n};\n")
+
+parseAlias :: Parser Expression
+parseAlias = Alias <$> ((++) <$> parseString "alias " <*> parseAllCharUntil ";\n")
+
+parseComment :: Parser Expression
+parseComment = Comment <$> ((++) <$> parseString "//" <*> parseAllCharUntil "\n")
+
+parseExpresion :: Parser Expression
+parseExpresion = parseAlias <|> parseFunction <|> parseComment

lvtc/src/ParseUtil.hs

@@ -0,0 +1,72 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator compiler
+-- File description:
+-- ParseUtil
+-}
+
+module ParseUtil (
+        parseChar,
+        parseAnyChar,
+        parseUInt,
+        parseSign,
+        parseInt,
+        parseString,
+        parseBetween,
+        parseAfter,
+        parseBefore,
+        parseAllCharUntil,
+    ) where
+
+import Parser
+import Data.Int (Int32)
+import Control.Applicative
+
+parseChar :: Char -> Parser Char
+parseChar c = Parser f
+    where
+        f [] = Nothing
+        f (x:xs) | x == c = Just (x, xs)
+                 | otherwise = Nothing
+
+parseAnyChar :: String -> Parser Char
+parseAnyChar str = Parser f
+    where
+        f [] = Nothing
+        f (x:xs) | x `elem` str = Just (x, xs)
+                 | otherwise = Nothing
+
+parseString :: String -> Parser String
+parseString value = Parser f
+    where
+        f s | take (length value) s == value = Just (value, drop (length value) s)
+                 | otherwise = Nothing
+
+parseUInt :: Parser Int32
+parseUInt = read <$> some (parseAnyChar "0123456789")
+
+parseSign :: Parser Int32
+parseSign = f <$> many (parseAnyChar "-+")
+    where
+        f s | even (length (filter (== '-') s)) = 1
+            | otherwise = -1
+
+parseInt :: Parser Int32
+parseInt = (*) <$> parseSign <*> parseUInt
+
+parseBetween :: Parser a -> Parser b -> Parser c -> Parser c
+parseBetween open close parser = open *> parser <* close
+
+parseAfter :: Parser a -> Parser b -> Parser b
+parseAfter open parser = open *> parser
+
+parseBefore :: Parser a -> Parser b -> Parser a
+parseBefore parser close = parser <* close
+
+parseAllCharUntil :: String -> Parser String
+parseAllCharUntil str = Parser f
+    where
+        f [] = empty
+        f (x:xs) = case runParser (parseString str) (x:xs) of
+                Nothing -> runParser ((x :) <$> parseAllCharUntil str) xs
+                Just (y, ys) -> Just (y, ys)

lvtc/src/Parser.hs

@@ -0,0 +1,54 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator compiler
+-- File description:
+-- Parser
+-}
+
+module Parser (
+        Parser (..),
+    ) where
+
+import Control.Applicative
+
+data Parser a = Parser {
+    runParser :: String -> Maybe (a, String)
+}
+
+instance Functor Parser where
+    fmap fct parser = Parser f
+        where
+            f str = case runParser parser str of
+                        Just (x, xs) -> Just (fct x, xs)
+                        Nothing -> Nothing
+
+instance Applicative Parser where
+    pure x = Parser f
+        where
+            f str = Just (x, str)
+    p1 <*> p2 = Parser f
+        where
+            f str = case runParser p1 str of
+                        Just (x, xs) ->
+                            case runParser p2 xs of
+                                Just (y, ys) -> Just (x y, ys)
+                                Nothing -> Nothing
+                        Nothing -> Nothing
+
+instance Alternative Parser where
+    empty = Parser f
+        where
+            f _ = Nothing
+    p1 <|> p2 = Parser f
+        where
+            f str = case runParser p1 str of
+                        Just (x, xs) -> Just (x, xs)
+                        Nothing -> runParser p2 str
+
+instance Monad Parser where
+    parser >>= fct = Parser f
+        where
+            f str = case runParser parser str of
+                        Just (x, xs) -> runParser (fct x) xs
+                        Nothing -> Nothing
+    return = pure

lvtc/stack.yaml

@@ -40,7 +40,9 @@ packages:
 # - git: https://github.com/commercialhaskell/stack.git
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
 #
-# extra-deps: []
+extra-deps:
+- tasty-1.4.2.2
+- tasty-hunit-0.10.1
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

lvtc/stack.yaml.lock

@@ -3,7 +3,21 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files
 
-packages: []
+packages:
+- completed:
+    hackage: tasty-1.4.2.2@sha256:b987609178d70c0042b950302161a049be8a878aa8cee4a9c7ba81d22d29a3f5,2719
+    pantry-tree:
+      sha256: a93f5e31aac66a82a885cb2ddc8eada9a8adefe8587da1c4085fae58b6bc4683
+      size: 1944
+  original:
+    hackage: tasty-1.4.2.2
+- completed:
+    hackage: tasty-hunit-0.10.1@sha256:ebc17b490750d4796b21d44001b852688cc39f9c34e387d5e7958e09b9b3f3b9,1602
+    pantry-tree:
+      sha256: c00ed23d8281b6c6f4ec33dd1e9e3a7971b0a769b6140978cfaf2a6eff025c78
+      size: 399
+  original:
+    hackage: tasty-hunit-0.10.1
 snapshots:
 - completed:
     sha256: e176944bc843f740e05242fa7a66ca1f440c127e425254f7f1257f9b19add23f

lvtc/test/Spec.hs

@@ -5,5 +5,85 @@
 -- Tests
 -}
 
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import Expression
+import Parser
+
 main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Leviator Tests - Compiler" [ utParserExpression ]
+
+testParserHelper :: String -> String -> Expression -> IO ()
+testParserHelper str restExpected expressionExpected =
+    case runParser (parseExpresion) str of
+        Just (parsed, rest) -> assertEqual str restExpected rest >>=
+            (\_ -> assertEqual str expressionExpected parsed)
+        Nothing -> assertFailure ("Parsing failed: " ++ str)
+
+testParserHelperFail :: String -> IO ()
+testParserHelperFail str = case runParser (parseExpresion) str of
+    Just _ -> assertFailure ("Parsing should have failed: " ++ str)
+    Nothing -> assertEqual str "" ""
+
+utParserExpression :: TestTree
+utParserExpression = testGroup "Parse Expression"
+  [
+-- function
+    testCase "function main" $
+      testParserHelper
+        "fn main() -> Int \n{\n    <- 0;\n};\n"
+        ""
+        (Function "fn main() -> Int \n{\n    <- 0;\n};\n")
+  , testCase "function bad formated (no end `}`)" $
+      testParserHelperFail
+        "fn main() -> Int \n{\n    <- 0;\n"
+  , testCase "function bad formated (no end `;`)" $
+      testParserHelperFail
+        "fn main() -> Int \n{\n    <- 0;\n}\n"
+  , testCase "function bad formated (no end `\\n`)" $
+      testParserHelperFail
+        "fn main() -> Int \n{\n    <- 0;\n};"
+  , testCase "function export" $
+      testParserHelper
+        "export fn main() -> Int \n{\n    <- 0;\n};\n"
+        ""
+        (Function "export fn main() -> Int \n{\n    <- 0;\n};\n")
+-- alias
+  , testCase "alias" $
+      testParserHelper
+        "alias abc def;\n"
+        ""
+        (Alias "alias abc def;\n")
+  , testCase "alias bad formated (no end `\\n`)" $
+      testParserHelperFail
+        "alias abc def;"
+  , testCase "alias bad formated (no end `;`)" $
+      testParserHelperFail
+        "alias abc def\n"
+-- comment
+  , testCase "comment" $
+      testParserHelper
+        "// this is a comment\n"
+        ""
+        (Comment "// this is a comment\n")
+  , testCase "comment bad formated (no end `\\n`)" $
+      testParserHelperFail
+        "// this is a comment"
+-- bad formated
+  , testCase "bad formated" $
+      testParserHelperFail
+        "abc"
+  , testCase "bad formated 2" $
+      testParserHelperFail
+        "/ def;\n"
+  , testCase "bad formated 3" $
+      testParserHelperFail
+        "def;\n"
+  , testCase "bad formated 4" $
+      testParserHelperFail
+        "export abc()"
+  ]