3 The Parser monad in "Comprehending Monads"
9 > type P t a = [t] -> [(a,[t])]
12 > unitP a = \i -> [(a,i)]
14 > thenP :: P t a -> (a -> P t b) -> P t b
15 > m `thenP` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k a i1]
17 > thenP_ :: P t a -> P t b -> P t b
18 > m `thenP_` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k i1]
20 zeroP is the parser that always fails to parse its input
25 plusP combines two parsers in parallel
26 (called "alt" in "Comprehending Monads")
28 > plusP :: P t a -> P t a -> P t a
29 > a1 `plusP` a2 = \i -> (a1 i) ++ (a2 i)
31 itemP is the parser that parses a single token
32 (called "next" in "Comprehending Monads")
35 > itemP = \i -> [(head i, tail i) | not (null i)]
37 force successful parse
39 > cutP :: P t a -> P t a
40 > cutP p = \u -> let l = p u in if null l then [] else [head l]
42 find all complete parses of a given string
44 > useP :: P t a -> [t] -> [a]
45 > useP m = \x -> [ a | (a,[]) <- m x ]
47 find first complete parse
49 > theP :: P t a -> [t] -> a
50 > theP m = head . (useP m)
53 Some standard parser definitions
55 mapP applies f to all current parse trees
57 > mapP :: (a -> b) -> P t a -> P t b
58 > f `mapP` m = m `thenP` (\a -> unitP (f a))
60 filter is the parser that parses a single token if it satisfies a
61 predicate and fails otherwise.
63 > filterP :: (a -> Bool) -> P t a -> P t a
64 > p `filterP` m = m `thenP` (\a -> (if p a then unitP a else zeroP))
66 lit recognises literals
68 > litP :: Eq t => t -> P t ()
69 > litP t = ((==t) `filterP` itemP) `thenP` (\c -> unitP () )
71 > showP :: (Text a) => P t a -> [t] -> String
72 > showP m xs = show (theP m xs)
75 Simon Peyton Jones adds some useful operations:
77 > zeroOrMoreP :: P t a -> P t [a]
78 > zeroOrMoreP p = oneOrMoreP p `plusP` unitP []
80 > oneOrMoreP :: P t a -> P t [a]
81 > oneOrMoreP p = seq p
82 > where seq p = p `thenP` (\a ->
83 > (seq p `thenP` (\as -> unitP (a:as)))
87 > oneOrMoreWithSepP :: P t a -> P t b -> P t [a]
88 > oneOrMoreWithSepP p1 p2 = seq1 p1 p2
89 > where seq1 p1 p2 = p1 `thenP` (\a -> seq2 p1 p2 a `plusP` unitP [a])
90 > seq2 p1 p2 a = p2 `thenP` (\_ ->
91 > seq1 p1 p2 `thenP` (\as -> unitP (a:as) ))