1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
module Minilang.Lambda.Parser where
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
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 =
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
|
