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)
313 choice :: [ReadP a] -> ReadP a
314 -- ^ Combines all parsers in the specified list.
317 choice (p:ps) = p +++ choice ps
319 skipSpaces :: ReadP ()
320 -- ^ Skips all whitespace.
325 skip (c:s) | isSpace c = do _ <- get; skip s
326 skip _ = do return ()
328 count :: Int -> ReadP a -> ReadP [a]
329 -- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of
330 -- results is returned.
331 count n p = sequence (replicate n p)
333 between :: ReadP open -> ReadP close -> ReadP a -> ReadP a
334 -- ^ @between open close p@ parses @open@, followed by @p@ and finally
335 -- @close@. Only the value of @p@ is returned.
336 between open close p = do _ <- open
341 option :: a -> ReadP a -> ReadP a
342 -- ^ @option x p@ will either parse @p@ or return @x@ without consuming
344 option x p = p +++ return x
346 optional :: ReadP a -> ReadP ()
347 -- ^ @optional p@ optionally parses @p@ and always returns @()@.
348 optional p = (p >> return ()) +++ return ()
350 many :: ReadP a -> ReadP [a]
351 -- ^ Parses zero or more occurrences of the given parser.
352 many p = return [] +++ many1 p
354 many1 :: ReadP a -> ReadP [a]
355 -- ^ Parses one or more occurrences of the given parser.
356 many1 p = liftM2 (:) p (many p)
358 skipMany :: ReadP a -> ReadP ()
359 -- ^ Like 'many', but discards the result.
360 skipMany p = many p >> return ()
362 skipMany1 :: ReadP a -> ReadP ()
363 -- ^ Like 'many1', but discards the result.
364 skipMany1 p = p >> skipMany p
366 sepBy :: ReadP a -> ReadP sep -> ReadP [a]
367 -- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.
368 -- Returns a list of values returned by @p@.
369 sepBy p sep = sepBy1 p sep +++ return []
371 sepBy1 :: ReadP a -> ReadP sep -> ReadP [a]
372 -- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.
373 -- Returns a list of values returned by @p@.
374 sepBy1 p sep = liftM2 (:) p (many (sep >> p))
376 endBy :: ReadP a -> ReadP sep -> ReadP [a]
377 -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
379 endBy p sep = many (do x <- p ; _ <- sep ; return x)
381 endBy1 :: ReadP a -> ReadP sep -> ReadP [a]
382 -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
384 endBy1 p sep = many1 (do x <- p ; _ <- sep ; return x)
386 chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
387 -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
388 -- Returns a value produced by a /right/ associative application of all
389 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
391 chainr p op x = chainr1 p op +++ return x
393 chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
394 -- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.
395 -- Returns a value produced by a /left/ associative application of all
396 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
398 chainl p op x = chainl1 p op +++ return x
400 chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
401 -- ^ Like 'chainr', but parses one or more occurrences of @p@.
403 where scan = p >>= rest
409 chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
410 -- ^ Like 'chainl', but parses one or more occurrences of @p@.
411 chainl1 p op = p >>= rest
412 where rest x = do f <- op
418 manyTill :: ReadP a -> ReadP end -> ReadP [a]
420 manyTill :: ReadPN [a] a -> ReadPN [a] end -> ReadPN [a] [a]
422 -- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@
423 -- succeeds. Returns a list of values returned by @p@.
424 manyTill p end = scan
425 where scan = (end >> return []) <++ (liftM2 (:) p scan)
427 -- ---------------------------------------------------------------------------
428 -- Converting between ReadP and Read
431 readP_to_S :: ReadP a -> ReadS a
433 readP_to_S :: ReadPN a a -> ReadS a
435 -- ^ Converts a parser into a Haskell ReadS-style function.
436 -- This is the main way in which you can \"run\" a 'ReadP' parser:
437 -- the expanded type is
438 -- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
439 readP_to_S (R f) = run (f return)
441 readS_to_P :: ReadS a -> ReadP a
442 -- ^ Converts a Haskell ReadS-style function into a parser.
443 -- Warning: This introduces local backtracking in the resulting
444 -- parser, and therefore a possible inefficiency.
446 R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
448 -- ---------------------------------------------------------------------------
449 -- QuickCheck properties that hold for the combinators
452 The following are QuickCheck specifications of what the combinators do.
453 These can be seen as formal specifications of the behavior of the
456 We use bags to give semantics to the combinators.
460 Equality on bags does not care about the order of elements.
462 > (=~) :: Ord a => Bag a -> Bag a -> Bool
463 > xs =~ ys = sort xs == sort ys
465 A special equality operator to avoid unresolved overloading
466 when testing the properties.
468 > (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool
471 Here follow the properties:
474 > readP_to_S get [] =~ []
476 > prop_Get_Cons c s =
477 > readP_to_S get (c:s) =~ [(c,s)]
480 > readP_to_S look s =~ [(s,s)]
483 > readP_to_S pfail s =~. []
486 > readP_to_S (return x) s =~. [(x,s)]
489 > readP_to_S (p >>= k) s =~.
491 > | (x,s') <- readP_to_S p s
492 > , ys'' <- readP_to_S (k (x::Int)) s'
496 > readP_to_S (p +++ q) s =~.
497 > (readP_to_S p s ++ readP_to_S q s)
499 > prop_LeftPlus p q s =
500 > readP_to_S (p <++ q) s =~.
501 > (readP_to_S p s +<+ readP_to_S q s)
507 > forAll readPWithoutReadS $ \p ->
508 > readP_to_S (gather p) s =~
509 > [ ((pre,x::Int),s')
510 > | (x,s') <- readP_to_S p s
511 > , let pre = take (length s - length s') s
514 > prop_String_Yes this s =
515 > readP_to_S (string this) (this ++ s) =~
518 > prop_String_Maybe this s =
519 > readP_to_S (string this) s =~
520 > [(this, drop (length this) s) | this `isPrefixOf` s]
523 > readP_to_S (munch p) s =~
524 > [(takeWhile p s, dropWhile p s)]
527 > readP_to_S (munch1 p) s =~
528 > [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
531 > readP_to_S (choice ps) s =~.
532 > readP_to_S (foldr (+++) pfail ps) s
535 > readP_to_S (readS_to_P r) s =~. r s