1 {-# OPTIONS_GHC -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
24 ReadP, -- :: * -> *; instance Functor, Monad, MonadPlus
26 ReadPN, -- :: * -> * -> *; instance Functor, Monad, MonadPlus
29 -- * Primitive operations
31 look, -- :: ReadP String
32 (+++), -- :: ReadP a -> ReadP a -> ReadP a
33 (<++), -- :: ReadP a -> ReadP a -> ReadP a
34 gather, -- :: ReadP a -> ReadP (String, a)
38 satisfy, -- :: (Char -> Bool) -> ReadP Char
39 char, -- :: Char -> ReadP Char
40 string, -- :: String -> ReadP String
41 munch, -- :: (Char -> Bool) -> ReadP String
42 munch1, -- :: (Char -> Bool) -> ReadP String
43 skipSpaces, -- :: ReadP ()
44 choice, -- :: [ReadP a] -> ReadP a
45 count, -- :: Int -> ReadP a -> ReadP [a]
46 between, -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a
47 option, -- :: a -> ReadP a -> ReadP a
48 optional, -- :: ReadP a -> ReadP ()
49 many, -- :: ReadP a -> ReadP [a]
50 many1, -- :: ReadP a -> ReadP [a]
51 skipMany, -- :: ReadP a -> ReadP ()
52 skipMany1, -- :: ReadP a -> ReadP ()
53 sepBy, -- :: ReadP a -> ReadP sep -> ReadP [a]
54 sepBy1, -- :: ReadP a -> ReadP sep -> ReadP [a]
55 endBy, -- :: ReadP a -> ReadP sep -> ReadP [a]
56 endBy1, -- :: ReadP a -> ReadP sep -> ReadP [a]
57 chainr, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
58 chainl, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
59 chainl1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
60 chainr1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
61 manyTill, -- :: ReadP a -> ReadP end -> ReadP [a]
64 ReadS, -- :: *; = String -> [(a,String)]
65 readP_to_S, -- :: ReadP a -> ReadS a
66 readS_to_P, -- :: ReadS a -> ReadP a
73 import Control.Monad( MonadPlus(..), sequence, liftM2 )
75 #ifdef __GLASGOW_HASKELL__
77 import {-# SOURCE #-} GHC.Unicode ( isSpace )
79 import GHC.List ( replicate )
82 import Data.Char( isSpace )
87 #ifdef __GLASGOW_HASKELL__
88 ------------------------------------------------------------------------
91 -- | A parser for a type @a@, represented as a function that takes a
92 -- 'String' and returns a list of possible parses as @(a,'String')@ pairs.
94 -- Note that this kind of backtracking parser is very inefficient;
95 -- reading a large structure may be quite slow (cf 'ReadP').
96 type ReadS a = String -> [(a,String)]
99 -- ---------------------------------------------------------------------------
101 -- is representation type -- should be kept abstract
105 | Look (String -> P a)
108 | Final [(a,String)] -- invariant: list is non-empty!
112 instance Monad P where
113 return x = Result x Fail
115 (Get f) >>= k = Get (\c -> f c >>= k)
116 (Look f) >>= k = Look (\s -> f s >>= k)
118 (Result x p) >>= k = k x `mplus` (p >>= k)
119 (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
123 instance MonadPlus P where
126 -- most common case: two gets are combined
127 Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c)
129 -- results are delivered as soon as possible
130 Result x p `mplus` q = Result x (p `mplus` q)
131 p `mplus` Result x q = Result x (p `mplus` q)
137 -- two finals are combined
138 -- final + look becomes one look and one final (=optimization)
139 -- final + sthg else becomes one look and one final
140 Final r `mplus` Final t = Final (r ++ t)
141 Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s))
142 Final r `mplus` p = Look (\s -> Final (r ++ run p s))
143 Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r))
144 p `mplus` Final r = Look (\s -> Final (run p s ++ r))
146 -- two looks are combined (=optimization)
147 -- look + sthg else floats upwards
148 Look f `mplus` Look g = Look (\s -> f s `mplus` g s)
149 Look f `mplus` p = Look (\s -> f s `mplus` p)
150 p `mplus` Look f = Look (\s -> p `mplus` f s)
152 -- ---------------------------------------------------------------------------
156 newtype ReadP a = R (forall b . (a -> P b) -> P b)
158 #define ReadP (ReadPN b)
159 newtype ReadPN b a = R ((a -> P b) -> P b)
162 -- Functor, Monad, MonadPlus
164 instance Functor ReadP where
165 fmap h (R f) = R (\k -> f (k . h))
167 instance Monad ReadP where
168 return x = R (\k -> k x)
169 fail _ = R (\_ -> Fail)
170 R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
172 instance MonadPlus ReadP where
176 -- ---------------------------------------------------------------------------
179 final :: [(a,String)] -> P a
180 -- Maintains invariant for Final constructor
184 run :: P a -> ReadS a
185 run (Get f) (c:s) = run (f c) s
186 run (Look f) s = run (f s) s
187 run (Result x p) s = (x,s) : run p s
191 -- ---------------------------------------------------------------------------
192 -- Operations over ReadP
195 -- ^ Consumes and returns the next character.
196 -- Fails if there is no input left.
200 -- ^ Look-ahead: returns the part of the input that is left, without
206 pfail = R (\_ -> Fail)
208 (+++) :: ReadP a -> ReadP a -> ReadP a
209 -- ^ Symmetric choice.
210 R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
213 (<++) :: ReadP a -> ReadP a -> ReadP a
215 (<++) :: ReadPN a a -> ReadPN a a -> ReadPN a a
217 -- ^ Local, exclusive, left-biased choice: If left parser
218 -- locally produces any result at all, then right parser is
220 #ifdef __GLASGOW_HASKELL__
223 probe (f return) s 0#
225 probe (Get f) (c:s) n = probe (f c) s (n+#1#)
226 probe (Look f) s n = probe (f s) s n
227 probe p@(Result _ _) _ n = discard n >> R (p >>=)
228 probe (Final r) _ _ = R (Final r >>=)
231 discard 0# = return ()
232 discard n = get >> discard (n-#1#)
238 probe (Get f) (c:s) n = probe (f c) s (n+1)
239 probe (Look f) s n = probe (f s) s n
240 probe p@(Result _ _) _ n = discard n >> R (p >>=)
241 probe (Final r) _ _ = R (Final r >>=)
244 discard 0 = return ()
245 discard n = get >> discard (n-1)
249 gather :: ReadP a -> ReadP (String, a)
251 -- gather :: ReadPN (String->P b) a -> ReadPN (String->P b) (String, a)
253 -- ^ Transforms a parser into one that does the same, but
254 -- in addition returns the exact characters read.
255 -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
256 -- is built using any occurrences of readS_to_P.
258 R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
260 gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
262 gath l (Look f) = Look (\s -> gath l (f s))
263 gath l (Result k p) = k (l []) `mplus` gath l p
264 gath l (Final r) = error "do not use readS_to_P in gather!"
266 -- ---------------------------------------------------------------------------
267 -- Derived operations
269 satisfy :: (Char -> Bool) -> ReadP Char
270 -- ^ Consumes and returns the next character, if it satisfies the
271 -- specified predicate.
272 satisfy p = do c <- get; if p c then return c else pfail
274 char :: Char -> ReadP Char
275 -- ^ Parses and returns the specified character.
276 char c = satisfy (c ==)
278 string :: String -> ReadP String
279 -- ^ Parses and returns the specified string.
280 string this = do s <- look; scan this s
282 scan [] _ = do return this
283 scan (x:xs) (y:ys) | x == y = do get; scan xs ys
286 munch :: (Char -> Bool) -> ReadP String
287 -- ^ Parses the first zero or more characters satisfying the predicate.
292 scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
293 scan _ = do return ""
295 munch1 :: (Char -> Bool) -> ReadP String
296 -- ^ Parses the first one or more characters satisfying the predicate.
299 if p c then do s <- munch p; return (c:s) else pfail
301 choice :: [ReadP a] -> ReadP a
302 -- ^ Combines all parsers in the specified list.
305 choice (p:ps) = p +++ choice ps
307 skipSpaces :: ReadP ()
308 -- ^ Skips all whitespace.
313 skip (c:s) | isSpace c = do get; skip s
314 skip _ = do return ()
316 count :: Int -> ReadP a -> ReadP [a]
317 -- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of
318 -- results is returned.
319 count n p = sequence (replicate n p)
321 between :: ReadP open -> ReadP close -> ReadP a -> ReadP a
322 -- ^ @between open close p@ parses @open@, followed by @p@ and finally
323 -- @close@. Only the value of @p@ is returned.
324 between open close p = do open
329 option :: a -> ReadP a -> ReadP a
330 -- ^ @option x p@ will either parse @p@ or return @x@ without consuming
332 option x p = p +++ return x
334 optional :: ReadP a -> ReadP ()
335 -- ^ @optional p@ optionally parses @p@ and always returns @()@.
336 optional p = (p >> return ()) +++ return ()
338 many :: ReadP a -> ReadP [a]
339 -- ^ Parses zero or more occurrences of the given parser.
340 many p = return [] +++ many1 p
342 many1 :: ReadP a -> ReadP [a]
343 -- ^ Parses one or more occurrences of the given parser.
344 many1 p = liftM2 (:) p (many p)
346 skipMany :: ReadP a -> ReadP ()
347 -- ^ Like 'many', but discards the result.
348 skipMany p = many p >> return ()
350 skipMany1 :: ReadP a -> ReadP ()
351 -- ^ Like 'many1', but discards the result.
352 skipMany1 p = p >> skipMany p
354 sepBy :: ReadP a -> ReadP sep -> ReadP [a]
355 -- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.
356 -- Returns a list of values returned by @p@.
357 sepBy p sep = sepBy1 p sep +++ return []
359 sepBy1 :: ReadP a -> ReadP sep -> ReadP [a]
360 -- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.
361 -- Returns a list of values returned by @p@.
362 sepBy1 p sep = liftM2 (:) p (many (sep >> p))
364 endBy :: ReadP a -> ReadP sep -> ReadP [a]
365 -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
367 endBy p sep = many (do x <- p ; sep ; return x)
369 endBy1 :: ReadP a -> ReadP sep -> ReadP [a]
370 -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
372 endBy1 p sep = many1 (do x <- p ; sep ; return x)
374 chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
375 -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
376 -- Returns a value produced by a /right/ associative application of all
377 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
379 chainr p op x = chainr1 p op +++ return x
381 chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
382 -- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.
383 -- Returns a value produced by a /left/ associative application of all
384 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
386 chainl p op x = chainl1 p op +++ return x
388 chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
389 -- ^ Like 'chainr', but parses one or more occurrences of @p@.
391 where scan = p >>= rest
397 chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
398 -- ^ Like 'chainl', but parses one or more occurrences of @p@.
399 chainl1 p op = p >>= rest
400 where rest x = do f <- op
406 manyTill :: ReadP a -> ReadP end -> ReadP [a]
408 manyTill :: ReadPN [a] a -> ReadPN [a] end -> ReadPN [a] [a]
410 -- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@
411 -- succeeds. Returns a list of values returned by @p@.
412 manyTill p end = scan
413 where scan = (end >> return []) <++ (liftM2 (:) p scan)
415 -- ---------------------------------------------------------------------------
416 -- Converting between ReadP and Read
419 readP_to_S :: ReadP a -> ReadS a
421 readP_to_S :: ReadPN a a -> ReadS a
423 -- ^ Converts a parser into a Haskell ReadS-style function.
424 -- This is the main way in which you can \"run\" a 'ReadP' parser:
425 -- the expanded type is
426 -- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
427 readP_to_S (R f) = run (f return)
429 readS_to_P :: ReadS a -> ReadP a
430 -- ^ Converts a Haskell ReadS-style function into a parser.
431 -- Warning: This introduces local backtracking in the resulting
432 -- parser, and therefore a possible inefficiency.
434 R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
436 -- ---------------------------------------------------------------------------
437 -- QuickCheck properties that hold for the combinators
440 The following are QuickCheck specifications of what the combinators do.
441 These can be seen as formal specifications of the behavior of the
444 We use bags to give semantics to the combinators.
448 Equality on bags does not care about the order of elements.
450 > (=~) :: Ord a => Bag a -> Bag a -> Bool
451 > xs =~ ys = sort xs == sort ys
453 A special equality operator to avoid unresolved overloading
454 when testing the properties.
456 > (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool
459 Here follow the properties:
462 > readP_to_S get [] =~ []
464 > prop_Get_Cons c s =
465 > readP_to_S get (c:s) =~ [(c,s)]
468 > readP_to_S look s =~ [(s,s)]
471 > readP_to_S pfail s =~. []
474 > readP_to_S (return x) s =~. [(x,s)]
477 > readP_to_S (p >>= k) s =~.
479 > | (x,s') <- readP_to_S p s
480 > , ys'' <- readP_to_S (k (x::Int)) s'
484 > readP_to_S (p +++ q) s =~.
485 > (readP_to_S p s ++ readP_to_S q s)
487 > prop_LeftPlus p q s =
488 > readP_to_S (p <++ q) s =~.
489 > (readP_to_S p s +<+ readP_to_S q s)
495 > forAll readPWithoutReadS $ \p ->
496 > readP_to_S (gather p) s =~
497 > [ ((pre,x::Int),s')
498 > | (x,s') <- readP_to_S p s
499 > , let pre = take (length s - length s') s
502 > prop_String_Yes this s =
503 > readP_to_S (string this) (this ++ s) =~
506 > prop_String_Maybe this s =
507 > readP_to_S (string this) s =~
508 > [(this, drop (length this) s) | this `isPrefixOf` s]
511 > readP_to_S (munch p) s =~
512 > [(takeWhile p s, dropWhile p s)]
515 > readP_to_S (munch1 p) s =~
516 > [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
519 > readP_to_S (choice ps) s =~.
520 > readP_to_S (foldr (+++) pfail ps) s
523 > readP_to_S (readS_to_P r) s =~. r s