1+ module Ch13 where
2+ 3+ import Control.Applicative
4+ import Data.Char
5+ 6+ -- 1. Define a parser comment :: Parser () for ordinary Haskell comments that begin with
7+ -- the symbol -- and extend to the end of the line with '\n'
8+ 9+ newtype Parser a =
10+ P (String -> [(a , String
11+ 12+ parse :: Parser a -> String -> [(a , String
13+ parse (P p) = p
14+ 15+ item :: Parser Char
16+ item =
17+ P (\ inp ->
18+ case inp of
19+ [] -> []
20+ (x: xs) -> [(x, xs)])
21+ 22+ instance Functor Parser where
23+ fmap g p =
24+ P
25+ (\ inp ->
26+ case parse p inp of
27+ [] -> []
28+ [(v, out)] -> [(g v, out)])
29+ 30+ instance Applicative Parser where
31+ pure v = P (\ inp -> [(v, inp)])
32+ pg <*> px =
33+ P
34+ (\ inp ->
35+ case parse pg inp of
36+ [] -> []
37+ [(g, out)] -> parse (fmap g px) out)
38+ 39+ instance Monad Parser where
40+ p >>= f =
41+ P
42+ (\ inp ->
43+ case parse p inp of
44+ [] -> []
45+ [(v, out)] -> parse (f v) out)
46+ 47+ instance Alternative Parser where
48+ empty = P (const [] )
49+ p <|> q =
50+ P
51+ (\ inp ->
52+ case parse p inp of
53+ [] -> parse q inp
54+ [(v, out)] -> [(v, out)])
55+ 56+ sat :: (Char -> Bool -> Parser Char
57+ sat p = do
58+ x <- item
59+ if p x
60+ then return x
61+ else empty
62+ 63+ char :: Char -> Parser Char
64+ char x = sat (== x)
65+ 66+ string :: String -> Parser String
67+ string [] = return []
68+ string (x: xs) = do
69+ char x
70+ string xs
71+ return (x : xs)
72+ 73+ space :: Parser ()
74+ space = do
75+ many (sat isSpace)
76+ return ()
77+ 78+ token :: Parser a -> Parser a
79+ token p = do
80+ space
81+ v <- p
82+ space
83+ return v
84+ 85+ symbol :: String -> Parser String
86+ symbol xs = token (string xs)
87+ 88+ eol :: Char
89+ eol = ' \n '
90+ 91+ comment :: Parser ()
92+ comment = do
93+ string " --"
94+ many (sat (/= eol))
95+ return ()
0 commit comments