feat: can parse an identifier as a variable (symbol)

3 files changed, 60 insertions, 7 deletions

diff --git a/lambda-calcul/haskell/minilang.cabal b/lambda-calcul/haskell/minilang.cabal
index 716951c..a39c466 100644
--- a/lambda-calcul/haskell/minilang.cabal
+++ b/lambda-calcul/haskell/minilang.cabal
@@ -52,6 +52,7 @@ library
     , directory
     , exceptions
     , filepath
+    , megaparsec
     , mtl
     , stm
     , text
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
index 719fac2..da590ad 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
@@ -1,12 +1,53 @@
 module Minilang.Lambda.Parser where
 
-import Data.Text (Text)
+import Control.Applicative (Alternative (many), (<|>))
+import Data.Bifunctor (first)
+import Data.Text (Text, pack)
+import Data.Void (Void)
+import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, manyTill, notFollowedBy, optional, parse, try)
+import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, string, symbolChar)
+import qualified Text.Megaparsec.Char.Lexer as L
 
-data ParseError = ParseError
+type Parser = Parsec Void Text
+
+data ParseError = ParseError Text
   deriving (Eq, Show)
 
 data AST = Sym Text
   deriving (Eq, Show)
 
 parse :: Text -> Either ParseError AST
-parse = undefined
+parse =
+  first (ParseError . pack . errorBundlePretty) . Text.Megaparsec.parse symbol ""
+
+symbol :: Parser AST
+symbol = Sym . pack <$> identifier
+
+identifier :: Parser String
+identifier =
+  lexeme $
+    (:)
+      <$> (letterChar <|> extraChars)
+      <*> many (alphaNumChar <|> extraChars)
+
+lexeme :: Parser a -> Parser a
+lexeme = L.lexeme spaceConsumer
+
+extraChars :: Parser Char
+extraChars =
+  foldl (\b a -> char a <|> b) symbolChar extraIdentifierChars
+
+initialChars :: [Char]
+initialChars =
+  ['a' .. 'z'] <> ['A' .. 'Z'] <> extraIdentifierChars
+
+restChars :: [Char]
+restChars =
+  initialChars <> ['0' .. '9']
+
+extraIdentifierChars :: String
+extraIdentifierChars = ['-', '_', '*', '#', '%', '&', ':', '@', '/']
+
+spaceConsumer :: Parser ()
+spaceConsumer =
+  L.space space1 (L.skipLineComment ";") empty
diff --git a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
index 284c1af..4d6f6e0 100644
--- a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
@@ -1,9 +1,20 @@
 module Minilang.Lambda.ParserSpec where
 
-import Minilang.Lambda.Parser (AST (..), parse)
-import Test.Hspec (Spec, it, parallel, shouldBe)
+import Data.Text (Text, pack)
+import Minilang.Lambda.Parser (AST (..), initialChars, parse, restChars)
+import Test.Hspec (Spec, parallel, shouldBe)
+import Test.Hspec.QuickCheck (prop)
+import Test.QuickCheck (Arbitrary (..), elements, listOf)
 
 spec :: Spec
 spec = parallel $ do
-  it "parses a variable" $ do
-    parse "x" `shouldBe` Right (Sym "x")
+  prop "parses an identifier as a variable" $ \(Identifier ident) ->
+    parse ident `shouldBe` Right (Sym ident)
+
+newtype Identifier = Identifier Text
+  deriving (Eq, Show)
+
+instance Arbitrary Identifier where
+  arbitrary =
+    Identifier . pack
+      <$> ((:) <$> elements initialChars <*> listOf (elements restChars))