It’s basically a reprint of https://remusao.github.io/whats-in-a-parser-combinator.html. However, I am still not 100% clear on this concept, and I can’t say anything smart now, so this is a draft to be extended/improved.

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
data Parser a = Parser {
run_parser :: String -> Maybe (a, String)
}

failure :: Parser a
failure = Parser $ \_ -> Nothing

return :: a -> Parser a
return a = Parser $ \s -> Just (a, s)

one_char :: Parser Char
one_char = Parser $ \s ->
case s of
(x:xs) -> Just (x, xs)
_ -> Nothing

char :: Char -> Parser Char
char a = do
x <- one_char
if x == a then
Prelude.return x
else
failure

string :: String -> Parser String
string [] = Main.return []
string (x:xs) = (:) <$> char x <*> string xs
-- string (x:xs) = do
-- _ <- char x
-- r <- string xs
-- Prelude.return $ x:r

instance Functor Parser where
fmap f p = Parser $ \s ->
fmap (\(x, y) -> (f x, y)) $ run_parser p s

parse_3 :: Parser Int
parse_3 = fmap read $ string "3"

instance Applicative Parser where
pure = Main.return
p1 <*> p2 = Parser $ \s -> do
(f, r1) <- run_parser p1 s
(x, r2) <- run_parser p2 r1
Just (f x, r2)

parse_tuple :: Parser (Char, Char)
parse_tuple = (,) <$> one_char <*> one_char

data AST =
Foo String
| Bar String
| Pair Char Char
deriving (Show)

parse_foo :: Parser AST
parse_foo = Foo <$> string "foo"
parse_bar :: Parser AST
parse_bar = Bar <$> string "bar"
parse_pair :: Parser AST
parse_pair = Pair <$> one_char <*> one_char

instance Monad Parser where
p >>= f = Parser $ \s ->
case run_parser p s of
Nothing -> Nothing
Just (x, r) -> run_parser (f x) r

main = do
print $ run_parser one_char "hello world"
print $ run_parser (string "hello") "hello world"
print $ run_parser (string "hello") "foo world"
print $ run_parser (string "") "foo world"
print $ run_parser parse_tuple "hello"
print $ run_parser parse_foo "foo hello"
print $ run_parser parse_bar "barfoo hello"
print $ run_parser parse_pair "barfoo hello"
print $ run_parser (char 'b') "barfoo hello"