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"