1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
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)
39 satisfy, -- :: (Char -> Bool) -> ReadP Char
40 char, -- :: Char -> ReadP Char
41 string, -- :: String -> ReadP String
42 munch, -- :: (Char -> Bool) -> ReadP String
43 munch1, -- :: (Char -> Bool) -> ReadP String
44 skipSpaces, -- :: ReadP ()
45 choice, -- :: [ReadP a] -> ReadP a
46 count, -- :: Int -> ReadP a -> ReadP [a]
47 between, -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a
48 option, -- :: a -> ReadP a -> ReadP a
49 optional, -- :: ReadP a -> ReadP ()
50 many, -- :: ReadP a -> ReadP [a]
51 many1, -- :: ReadP a -> ReadP [a]
52 skipMany, -- :: ReadP a -> ReadP ()
53 skipMany1, -- :: ReadP a -> ReadP ()
54 sepBy, -- :: ReadP a -> ReadP sep -> ReadP [a]
55 sepBy1, -- :: ReadP a -> ReadP sep -> ReadP [a]
56 endBy, -- :: ReadP a -> ReadP sep -> ReadP [a]
57 endBy1, -- :: ReadP a -> ReadP sep -> ReadP [a]
58 chainr, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
59 chainl, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
60 chainl1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
61 chainr1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
62 manyTill, -- :: ReadP a -> ReadP end -> ReadP [a]
65 ReadS, -- :: *; = String -> [(a,String)]
66 readP_to_S, -- :: ReadP a -> ReadS a
67 readS_to_P, -- :: ReadS a -> ReadP a
74 import Control.Monad( MonadPlus(..), sequence, liftM2 )
76 #ifdef __GLASGOW_HASKELL__
78 import {-# SOURCE #-} GHC.Unicode ( isSpace )
80 import GHC.List ( replicate, null )
83 import Data.Char( isSpace )
88 #ifdef __GLASGOW_HASKELL__
89 ------------------------------------------------------------------------
92 -- | A parser for a type @a@, represented as a function that takes a
93 -- 'String' and returns a list of possible parses as @(a,'String')@ pairs.
95 -- Note that this kind of backtracking parser is very inefficient;
96 -- reading a large structure may be quite slow (cf 'ReadP').
97 type ReadS a = String -> [(a,String)]
100 -- ---------------------------------------------------------------------------
102 -- is representation type -- should be kept abstract
106 | Look (String -> P a)
109 | Final [(a,String)] -- invariant: list is non-empty!
113 instance Monad P where
114 return x = Result x Fail
116 (Get f) >>= k = Get (\c -> f c >>= k)
117 (Look f) >>= k = Look (\s -> f s >>= k)
119 (Result x p) >>= k = k x `mplus` (p >>= k)
120 (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
124 instance MonadPlus P where
127 -- most common case: two gets are combined
128 Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c)
130 -- results are delivered as soon as possible
131 Result x p `mplus` q = Result x (p `mplus` q)
132 p `mplus` Result x q = Result x (p `mplus` q)
138 -- two finals are combined
139 -- final + look becomes one look and one final (=optimization)
140 -- final + sthg else becomes one look and one final
141 Final r `mplus` Final t = Final (r ++ t)
142 Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s))
143 Final r `mplus` p = Look (\s -> Final (r ++ run p s))
144 Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r))
145 p `mplus` Final r = Look (\s -> Final (run p s ++ r))
147 -- two looks are combined (=optimization)
148 -- look + sthg else floats upwards
149 Look f `mplus` Look g = Look (\s -> f s `mplus` g s)
150 Look f `mplus` p = Look (\s -> f s `mplus` p)
151 p `mplus` Look f = Look (\s -> p `mplus` f s)
153 -- ---------------------------------------------------------------------------
157 newtype ReadP a = R (forall b . (a -> P b) -> P b)
159 #define ReadP (ReadPN b)
160 newtype ReadPN b a = R ((a -> P b) -> P b)
163 -- Functor, Monad, MonadPlus
165 instance Functor ReadP where
166 fmap h (R f) = R (\k -> f (k . h))
168 instance Monad ReadP where
169 return x = R (\k -> k x)
170 fail _ = R (\_ -> Fail)
171 R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
173 instance MonadPlus ReadP where
177 -- ---------------------------------------------------------------------------
180 final :: [(a,String)] -> P a
181 -- Maintains invariant for Final constructor
185 run :: P a -> ReadS a
186 run (Get f) (c:s) = run (f c) s
187 run (Look f) s = run (f s) s
188 run (Result x p) s = (x,s) : run p s
192 -- ---------------------------------------------------------------------------
193 -- Operations over ReadP
196 -- ^ Consumes and returns the next character.
197 -- Fails if there is no input left.
201 -- ^ Look-ahead: returns the part of the input that is left, without
207 pfail = R (\_ -> Fail)
209 (+++) :: ReadP a -> ReadP a -> ReadP a
210 -- ^ Symmetric choice.
211 R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
214 (<++) :: ReadP a -> ReadP a -> ReadP a
216 (<++) :: ReadPN a a -> ReadPN a a -> ReadPN a a
218 -- ^ Local, exclusive, left-biased choice: If left parser
219 -- locally produces any result at all, then right parser is
221 #ifdef __GLASGOW_HASKELL__
224 probe (f0 return) s 0#
226 probe (Get f) (c:s) n = probe (f c) s (n+#1#)
227 probe (Look f) s n = probe (f s) s n
228 probe p@(Result _ _) _ n = discard n >> R (p >>=)
229 probe (Final r) _ _ = R (Final r >>=)
232 discard 0# = return ()
233 discard n = get >> discard (n-#1#)
239 probe (Get f) (c:s) n = probe (f c) s (n+1)
240 probe (Look f) s n = probe (f s) s n
241 probe p@(Result _ _) _ n = discard n >> R (p >>=)
242 probe (Final r) _ _ = R (Final r >>=)
245 discard 0 = return ()
246 discard n = get >> discard (n-1)
250 gather :: ReadP a -> ReadP (String, a)
252 -- gather :: ReadPN (String->P b) a -> ReadPN (String->P b) (String, a)
254 -- ^ Transforms a parser into one that does the same, but
255 -- in addition returns the exact characters read.
256 -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
257 -- is built using any occurrences of readS_to_P.
259 R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
261 gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
263 gath l (Look f) = Look (\s -> gath l (f s))
264 gath l (Result k p) = k (l []) `mplus` gath l p
265 gath _ (Final _) = error "do not use readS_to_P in gather!"
267 -- ---------------------------------------------------------------------------
268 -- Derived operations
270 satisfy :: (Char -> Bool) -> ReadP Char
271 -- ^ Consumes and returns the next character, if it satisfies the
272 -- specified predicate.
273 satisfy p = do c <- get; if p c then return c else pfail
275 char :: Char -> ReadP Char
276 -- ^ Parses and returns the specified character.
277 char c = satisfy (c ==)
280 -- ^ Succeeds iff we are at the end of input
282 ; if null s then return ()
285 string :: String -> ReadP String
286 -- ^ Parses and returns the specified string.
287 string this = do s <- look; scan this s
289 scan [] _ = do return this
290 scan (x:xs) (y:ys) | x == y = do _ <- get; scan xs ys
293 munch :: (Char -> Bool) -> ReadP String
294 -- ^ Parses the first zero or more characters satisfying the predicate.
295 -- Always succeds, exactly once having consumed all the characters
296 -- Hence NOT the same as (many (satisfy p))
301 scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s)
302 scan _ = do return ""
304 munch1 :: (Char -> Bool) -> ReadP String
305 -- ^ Parses the first one or more characters satisfying the predicate.
306 -- Fails if none, else succeeds exactly once having consumed all the characters
307 -- Hence NOT the same as (many1 (satisfy p))
310 if p c then do s <- munch p; return (c:s) else pfail
312 choice :: [ReadP a] -> ReadP a
313 -- ^ Combines all parsers in the specified list.
316 choice (p:ps) = p +++ choice ps
318 skipSpaces :: ReadP ()
319 -- ^ Skips all whitespace.
324 skip (c:s) | isSpace c = do _ <- get; skip s
325 skip _ = do return ()
327 count :: Int -> ReadP a -> ReadP [a]
328 -- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of
329 -- results is returned.
330 count n p = sequence (replicate n p)
332 between :: ReadP open -> ReadP close -> ReadP a -> ReadP a
333 -- ^ @between open close p@ parses @open@, followed by @p@ and finally
334 -- @close@. Only the value of @p@ is returned.
335 between open close p = do _ <- open
340 option :: a -> ReadP a -> ReadP a
341 -- ^ @option x p@ will either parse @p@ or return @x@ without consuming
343 option x p = p +++ return x
345 optional :: ReadP a -> ReadP ()
346 -- ^ @optional p@ optionally parses @p@ and always returns @()@.
347 optional p = (p >> return ()) +++ return ()
349 many :: ReadP a -> ReadP [a]
350 -- ^ Parses zero or more occurrences of the given parser.
351 many p = return [] +++ many1 p
353 many1 :: ReadP a -> ReadP [a]
354 -- ^ Parses one or more occurrences of the given parser.
355 many1 p = liftM2 (:) p (many p)
357 skipMany :: ReadP a -> ReadP ()
358 -- ^ Like 'many', but discards the result.
359 skipMany p = many p >> return ()
361 skipMany1 :: ReadP a -> ReadP ()
362 -- ^ Like 'many1', but discards the result.
363 skipMany1 p = p >> skipMany p
365 sepBy :: ReadP a -> ReadP sep -> ReadP [a]
366 -- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.
367 -- Returns a list of values returned by @p@.
368 sepBy p sep = sepBy1 p sep +++ return []
370 sepBy1 :: ReadP a -> ReadP sep -> ReadP [a]
371 -- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.
372 -- Returns a list of values returned by @p@.
373 sepBy1 p sep = liftM2 (:) p (many (sep >> p))
375 endBy :: ReadP a -> ReadP sep -> ReadP [a]
376 -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
378 endBy p sep = many (do x <- p ; _ <- sep ; return x)
380 endBy1 :: ReadP a -> ReadP sep -> ReadP [a]
381 -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
383 endBy1 p sep = many1 (do x <- p ; _ <- sep ; return x)
385 chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
386 -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
387 -- Returns a value produced by a /right/ associative application of all
388 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
390 chainr p op x = chainr1 p op +++ return x
392 chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
393 -- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.
394 -- Returns a value produced by a /left/ associative application of all
395 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
397 chainl p op x = chainl1 p op +++ return x
399 chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
400 -- ^ Like 'chainr', but parses one or more occurrences of @p@.
402 where scan = p >>= rest
408 chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
409 -- ^ Like 'chainl', but parses one or more occurrences of @p@.
410 chainl1 p op = p >>= rest
411 where rest x = do f <- op
417 manyTill :: ReadP a -> ReadP end -> ReadP [a]
419 manyTill :: ReadPN [a] a -> ReadPN [a] end -> ReadPN [a] [a]
421 -- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@
422 -- succeeds. Returns a list of values returned by @p@.
423 manyTill p end = scan
424 where scan = (end >> return []) <++ (liftM2 (:) p scan)
426 -- ---------------------------------------------------------------------------
427 -- Converting between ReadP and Read
430 readP_to_S :: ReadP a -> ReadS a
432 readP_to_S :: ReadPN a a -> ReadS a
434 -- ^ Converts a parser into a Haskell ReadS-style function.
435 -- This is the main way in which you can \"run\" a 'ReadP' parser:
436 -- the expanded type is
437 -- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
438 readP_to_S (R f) = run (f return)
440 readS_to_P :: ReadS a -> ReadP a
441 -- ^ Converts a Haskell ReadS-style function into a parser.
442 -- Warning: This introduces local backtracking in the resulting
443 -- parser, and therefore a possible inefficiency.
445 R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
447 -- ---------------------------------------------------------------------------
448 -- QuickCheck properties that hold for the combinators
451 The following are QuickCheck specifications of what the combinators do.
452 These can be seen as formal specifications of the behavior of the
455 We use bags to give semantics to the combinators.
459 Equality on bags does not care about the order of elements.
461 > (=~) :: Ord a => Bag a -> Bag a -> Bool
462 > xs =~ ys = sort xs == sort ys
464 A special equality operator to avoid unresolved overloading
465 when testing the properties.
467 > (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool
470 Here follow the properties:
473 > readP_to_S get [] =~ []
475 > prop_Get_Cons c s =
476 > readP_to_S get (c:s) =~ [(c,s)]
479 > readP_to_S look s =~ [(s,s)]
482 > readP_to_S pfail s =~. []
485 > readP_to_S (return x) s =~. [(x,s)]
488 > readP_to_S (p >>= k) s =~.
490 > | (x,s') <- readP_to_S p s
491 > , ys'' <- readP_to_S (k (x::Int)) s'
495 > readP_to_S (p +++ q) s =~.
496 > (readP_to_S p s ++ readP_to_S q s)
498 > prop_LeftPlus p q s =
499 > readP_to_S (p <++ q) s =~.
500 > (readP_to_S p s +<+ readP_to_S q s)
506 > forAll readPWithoutReadS $ \p ->
507 > readP_to_S (gather p) s =~
508 > [ ((pre,x::Int),s')
509 > | (x,s') <- readP_to_S p s
510 > , let pre = take (length s - length s') s
513 > prop_String_Yes this s =
514 > readP_to_S (string this) (this ++ s) =~
517 > prop_String_Maybe this s =
518 > readP_to_S (string this) s =~
519 > [(this, drop (length this) s) | this `isPrefixOf` s]
522 > readP_to_S (munch p) s =~
523 > [(takeWhile p s, dropWhile p s)]
526 > readP_to_S (munch1 p) s =~
527 > [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
530 > readP_to_S (choice ps) s =~.
531 > readP_to_S (foldr (+++) pfail ps) s
534 > readP_to_S (readS_to_P r) s =~. r s