1 {-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
4 -- Module : Text.ParserCombinators.ReadP
5 -- Copyright : (c) The University of Glasgow 2002
6 -- License : BSD-style (see the file libraries/base/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : provisional
10 -- Portability : non-portable (local universal quantification)
12 -- This is a library of parser combinators, originally written by Koen Claessen.
13 -- It parses all alternatives in parallel, so it never keeps hold of
14 -- the beginning of the input string, a common source of space leaks with
15 -- other parsers. The '(+++)' choice combinator is genuinely commutative;
16 -- it makes no difference which branch is \"shorter\".
18 -----------------------------------------------------------------------------
20 module Text.ParserCombinators.ReadP
23 ReadP, -- :: * -> *; instance Functor, Monad, MonadPlus
25 -- * Primitive operations
27 look, -- :: ReadP String
28 (+++), -- :: ReadP a -> ReadP a -> ReadP a
29 (<++), -- :: ReadP a -> ReadP a -> ReadP a
30 gather, -- :: ReadP a -> ReadP (String, a)
34 satisfy, -- :: (Char -> Bool) -> ReadP Char
35 char, -- :: Char -> ReadP Char
36 string, -- :: String -> ReadP String
37 munch, -- :: (Char -> Bool) -> ReadP String
38 munch1, -- :: (Char -> Bool) -> ReadP String
39 skipSpaces, -- :: ReadP ()
40 choice, -- :: [ReadP a] -> ReadP a
43 ReadS, -- :: *; = String -> [(a,String)]
44 readP_to_S, -- :: ReadP a -> ReadS a
45 readS_to_P, -- :: ReadS a -> ReadP a
52 import Control.Monad( MonadPlus(..) )
53 #ifdef __GLASGOW_HASKELL__
54 import {-# SOURCE #-} GHC.Unicode ( isSpace )
57 import Data.Char( isSpace )
62 #ifdef __GLASGOW_HASKELL__
63 ------------------------------------------------------------------------
66 -- | A parser for a type @a@, represented as a function that takes a
67 -- 'String' and returns a list of possible parses @(a,'String')@ pairs.
68 type ReadS a = String -> [(a,String)]
71 -- ---------------------------------------------------------------------------
73 -- is representation type -- should be kept abstract
77 | Look (String -> P a)
80 | Final [(a,String)] -- invariant: list is non-empty!
84 instance Monad P where
85 return x = Result x Fail
87 (Get f) >>= k = Get (\c -> f c >>= k)
88 (Look f) >>= k = Look (\s -> f s >>= k)
90 (Result x p) >>= k = k x `mplus` (p >>= k)
91 (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
95 instance MonadPlus P where
98 -- most common case: two gets are combined
99 Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c)
101 -- results are delivered as soon as possible
102 Result x p `mplus` q = Result x (p `mplus` q)
103 p `mplus` Result x q = Result x (p `mplus` q)
109 -- two finals are combined
110 -- final + look becomes one look and one final (=optimization)
111 -- final + sthg else becomes one look and one final
112 Final r `mplus` Final t = Final (r ++ t)
113 Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s))
114 Final r `mplus` p = Look (\s -> Final (r ++ run p s))
115 Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r))
116 p `mplus` Final r = Look (\s -> Final (run p s ++ r))
118 -- two looks are combined (=optimization)
119 -- look + sthg else floats upwards
120 Look f `mplus` Look g = Look (\s -> f s `mplus` g s)
121 Look f `mplus` p = Look (\s -> f s `mplus` p)
122 p `mplus` Look f = Look (\s -> p `mplus` f s)
124 -- ---------------------------------------------------------------------------
127 newtype ReadP a = R (forall b . (a -> P b) -> P b)
129 -- Functor, Monad, MonadPlus
131 instance Functor ReadP where
132 fmap h (R f) = R (\k -> f (k . h))
134 instance Monad ReadP where
135 return x = R (\k -> k x)
136 fail _ = R (\_ -> Fail)
137 R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
139 instance MonadPlus ReadP where
143 -- ---------------------------------------------------------------------------
146 final :: [(a,String)] -> P a
147 -- Maintains invariant for Final constructor
151 run :: P a -> ReadS a
152 run (Get f) (c:s) = run (f c) s
153 run (Look f) s = run (f s) s
154 run (Result x p) s = (x,s) : run p s
158 -- ---------------------------------------------------------------------------
159 -- Operations over ReadP
162 -- ^ Consumes and returns the next character.
163 -- Fails if there is no input left.
167 -- ^ Look-ahead: returns the part of the input that is left, without
173 pfail = R (\_ -> Fail)
175 (+++) :: ReadP a -> ReadP a -> ReadP a
176 -- ^ Symmetric choice.
177 R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
179 (<++) :: ReadP a -> ReadP a -> ReadP a
180 -- ^ Local, exclusive, left-biased choice: If left parser
181 -- locally produces any result at all, then right parser is
183 #ifdef __GLASGOW_HASKELL__
186 probe (f return) s 0#
188 probe (Get f) (c:s) n = probe (f c) s (n+#1#)
189 probe (Look f) s n = probe (f s) s n
190 probe p@(Result _ _) _ n = discard n >> R (p >>=)
191 probe (Final r) _ _ = R (Final r >>=)
194 discard 0# = return ()
195 discard n = get >> discard (n-#1#)
201 probe (Get f) (c:s) n = probe (f c) s (n+1)
202 probe (Look f) s n = probe (f s) s n
203 probe p@(Result _ _) _ n = discard n >> R (p >>=)
204 probe (Final r) _ _ = R (Final r >>=)
207 discard 0 = return ()
208 discard n = get >> discard (n-1)
211 gather :: ReadP a -> ReadP (String, a)
212 -- ^ Transforms a parser into one that does the same, but
213 -- in addition returns the exact characters read.
214 -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
215 -- is built using any occurrences of readS_to_P.
217 R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
219 gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
221 gath l (Look f) = Look (\s -> gath l (f s))
222 gath l (Result k p) = k (l []) `mplus` gath l p
223 gath l (Final r) = error "do not use readS_to_P in gather!"
225 -- ---------------------------------------------------------------------------
226 -- Derived operations
228 satisfy :: (Char -> Bool) -> ReadP Char
229 -- ^ Consumes and returns the next character, if it satisfies the
230 -- specified predicate.
231 satisfy p = do c <- get; if p c then return c else pfail
233 char :: Char -> ReadP Char
234 -- ^ Parses and returns the specified character.
235 char c = satisfy (c ==)
237 string :: String -> ReadP String
238 -- ^ Parses and returns the specified string.
239 string this = do s <- look; scan this s
241 scan [] _ = do return this
242 scan (x:xs) (y:ys) | x == y = do get; scan xs ys
245 munch :: (Char -> Bool) -> ReadP String
246 -- ^ Parses the first zero or more characters satisfying the predicate.
251 scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
252 scan _ = do return ""
254 munch1 :: (Char -> Bool) -> ReadP String
255 -- ^ Parses the first one or more characters satisfying the predicate.
258 if p c then do s <- munch p; return (c:s) else pfail
260 choice :: [ReadP a] -> ReadP a
261 -- ^ Combines all parsers in the specified list.
264 choice (p:ps) = p +++ choice ps
266 skipSpaces :: ReadP ()
267 -- ^ Skips all whitespace.
272 skip (c:s) | isSpace c = do get; skip s
273 skip _ = do return ()
275 -- ---------------------------------------------------------------------------
276 -- Converting between ReadP and Read
278 readP_to_S :: ReadP a -> ReadS a
279 -- ^ Converts a parser into a Haskell ReadS-style function.
280 -- This is the main way in which you can \"run\" a 'ReadP' parser:
281 -- the expanded type is
282 -- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
283 readP_to_S (R f) = run (f return)
285 readS_to_P :: ReadS a -> ReadP a
286 -- ^ Converts a Haskell ReadS-style function into a parser.
287 -- Warning: This introduces local backtracking in the resulting
288 -- parser, and therefore a possible inefficiency.
290 R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
292 -- ---------------------------------------------------------------------------
293 -- QuickCheck properties that hold for the combinators
296 The following are QuickCheck specifications of what the combinators do.
297 These can be seen as formal specifications of the behavior of the
300 We use bags to give semantics to the combinators.
304 Equality on bags does not care about the order of elements.
306 > (=~) :: Ord a => Bag a -> Bag a -> Bool
307 > xs =~ ys = sort xs == sort ys
309 A special equality operator to avoid unresolved overloading
310 when testing the properties.
312 > (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool
315 Here follow the properties:
318 > readP_to_S get [] =~ []
320 > prop_Get_Cons c s =
321 > readP_to_S get (c:s) =~ [(c,s)]
324 > readP_to_S look s =~ [(s,s)]
327 > readP_to_S pfail s =~. []
330 > readP_to_S (return x) s =~. [(x,s)]
333 > readP_to_S (p >>= k) s =~.
335 > | (x,s') <- readP_to_S p s
336 > , ys'' <- readP_to_S (k (x::Int)) s'
340 > readP_to_S (p +++ q) s =~.
341 > (readP_to_S p s ++ readP_to_S q s)
343 > prop_LeftPlus p q s =
344 > readP_to_S (p <++ q) s =~.
345 > (readP_to_S p s +<+ readP_to_S q s)
351 > forAll readPWithoutReadS $ \p ->
352 > readP_to_S (gather p) s =~
353 > [ ((pre,x::Int),s')
354 > | (x,s') <- readP_to_S p s
355 > , let pre = take (length s - length s') s
358 > prop_String_Yes this s =
359 > readP_to_S (string this) (this ++ s) =~
362 > prop_String_Maybe this s =
363 > readP_to_S (string this) s =~
364 > [(this, drop (length this) s) | this `isPrefixOf` s]
367 > readP_to_S (munch p) s =~
368 > [(takeWhile p s, dropWhile p s)]
371 > readP_to_S (munch1 p) s =~
372 > [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
375 > readP_to_S (choice ps) s =~.
376 > readP_to_S (foldr (+++) pfail ps) s
379 > readP_to_S (readS_to_P r) s =~. r s