base: Remove `Monad(fail)` method and reexport `MonadFail(fail)` instead
[ghc.git] / libraries / base / Text / ParserCombinators / ReadP.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE NoImplicitPrelude #-}
3 {-# LANGUAGE RankNTypes #-}
4 {-# LANGUAGE MagicHash #-}
5 {-# LANGUAGE DeriveFunctor #-}
6
7 -----------------------------------------------------------------------------
8 -- |
9 -- Module : Text.ParserCombinators.ReadP
10 -- Copyright : (c) The University of Glasgow 2002
11 -- License : BSD-style (see the file libraries/base/LICENSE)
12 --
13 -- Maintainer : libraries@haskell.org
14 -- Stability : provisional
15 -- Portability : non-portable (local universal quantification)
16 --
17 -- This is a library of parser combinators, originally written by Koen Claessen.
18 -- It parses all alternatives in parallel, so it never keeps hold of
19 -- the beginning of the input string, a common source of space leaks with
20 -- other parsers. The @('+++')@ choice combinator is genuinely commutative;
21 -- it makes no difference which branch is \"shorter\".
22
23 -----------------------------------------------------------------------------
24
25 module Text.ParserCombinators.ReadP
26 (
27 -- * The 'ReadP' type
28 ReadP,
29
30 -- * Primitive operations
31 get,
32 look,
33 (+++),
34 (<++),
35 gather,
36
37 -- * Other operations
38 pfail,
39 eof,
40 satisfy,
41 char,
42 string,
43 munch,
44 munch1,
45 skipSpaces,
46 choice,
47 count,
48 between,
49 option,
50 optional,
51 many,
52 many1,
53 skipMany,
54 skipMany1,
55 sepBy,
56 sepBy1,
57 endBy,
58 endBy1,
59 chainr,
60 chainl,
61 chainl1,
62 chainr1,
63 manyTill,
64
65 -- * Running a parser
66 ReadS,
67 readP_to_S,
68 readS_to_P,
69
70 -- * Properties
71 -- $properties
72 )
73 where
74
75 import GHC.Unicode ( isSpace )
76 import GHC.List ( replicate, null )
77 import GHC.Base hiding ( many )
78
79 import Control.Monad.Fail
80
81 infixr 5 +++, <++
82
83 ------------------------------------------------------------------------
84 -- ReadS
85
86 -- | A parser for a type @a@, represented as a function that takes a
87 -- 'String' and returns a list of possible parses as @(a,'String')@ pairs.
88 --
89 -- Note that this kind of backtracking parser is very inefficient;
90 -- reading a large structure may be quite slow (cf 'ReadP').
91 type ReadS a = String -> [(a,String)]
92
93 -- ---------------------------------------------------------------------------
94 -- The P type
95 -- is representation type -- should be kept abstract
96
97 data P a
98 = Get (Char -> P a)
99 | Look (String -> P a)
100 | Fail
101 | Result a (P a)
102 | Final [(a,String)] -- invariant: list is non-empty!
103 deriving Functor -- ^ @since 4.8.0.0
104
105 -- Monad, MonadPlus
106
107 -- | @since 4.5.0.0
108 instance Applicative P where
109 pure x = Result x Fail
110 (<*>) = ap
111
112 -- | @since 2.01
113 instance MonadPlus P
114
115 -- | @since 2.01
116 instance Monad P where
117 (Get f) >>= k = Get (\c -> f c >>= k)
118 (Look f) >>= k = Look (\s -> f s >>= k)
119 Fail >>= _ = Fail
120 (Result x p) >>= k = k x <|> (p >>= k)
121 (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
122
123 -- | @since 4.9.0.0
124 instance MonadFail P where
125 fail _ = Fail
126
127 -- | @since 4.5.0.0
128 instance Alternative P where
129 empty = Fail
130
131 -- most common case: two gets are combined
132 Get f1 <|> Get f2 = Get (\c -> f1 c <|> f2 c)
133
134 -- results are delivered as soon as possible
135 Result x p <|> q = Result x (p <|> q)
136 p <|> Result x q = Result x (p <|> q)
137
138 -- fail disappears
139 Fail <|> p = p
140 p <|> Fail = p
141
142 -- two finals are combined
143 -- final + look becomes one look and one final (=optimization)
144 -- final + sthg else becomes one look and one final
145 Final r <|> Final t = Final (r ++ t)
146 Final r <|> Look f = Look (\s -> Final (r ++ run (f s) s))
147 Final r <|> p = Look (\s -> Final (r ++ run p s))
148 Look f <|> Final r = Look (\s -> Final (run (f s) s ++ r))
149 p <|> Final r = Look (\s -> Final (run p s ++ r))
150
151 -- two looks are combined (=optimization)
152 -- look + sthg else floats upwards
153 Look f <|> Look g = Look (\s -> f s <|> g s)
154 Look f <|> p = Look (\s -> f s <|> p)
155 p <|> Look f = Look (\s -> p <|> f s)
156
157 -- ---------------------------------------------------------------------------
158 -- The ReadP type
159
160 newtype ReadP a = R (forall b . (a -> P b) -> P b)
161
162 -- | @since 2.01
163 instance Functor ReadP where
164 fmap h (R f) = R (\k -> f (k . h))
165
166 -- | @since 4.6.0.0
167 instance Applicative ReadP where
168 pure x = R (\k -> k x)
169 (<*>) = ap
170 -- liftA2 = liftM2
171
172 -- | @since 2.01
173 instance Monad ReadP where
174 R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
175
176 -- | @since 4.9.0.0
177 instance MonadFail ReadP where
178 fail _ = R (\_ -> Fail)
179
180 -- | @since 4.6.0.0
181 instance Alternative ReadP where
182 empty = pfail
183 (<|>) = (+++)
184
185 -- | @since 2.01
186 instance MonadPlus ReadP
187
188 -- ---------------------------------------------------------------------------
189 -- Operations over P
190
191 final :: [(a,String)] -> P a
192 -- Maintains invariant for Final constructor
193 final [] = Fail
194 final r = Final r
195
196 run :: P a -> ReadS a
197 run (Get f) (c:s) = run (f c) s
198 run (Look f) s = run (f s) s
199 run (Result x p) s = (x,s) : run p s
200 run (Final r) _ = r
201 run _ _ = []
202
203 -- ---------------------------------------------------------------------------
204 -- Operations over ReadP
205
206 get :: ReadP Char
207 -- ^ Consumes and returns the next character.
208 -- Fails if there is no input left.
209 get = R Get
210
211 look :: ReadP String
212 -- ^ Look-ahead: returns the part of the input that is left, without
213 -- consuming it.
214 look = R Look
215
216 pfail :: ReadP a
217 -- ^ Always fails.
218 pfail = R (\_ -> Fail)
219
220 (+++) :: ReadP a -> ReadP a -> ReadP a
221 -- ^ Symmetric choice.
222 R f1 +++ R f2 = R (\k -> f1 k <|> f2 k)
223
224 (<++) :: ReadP a -> ReadP a -> ReadP a
225 -- ^ Local, exclusive, left-biased choice: If left parser
226 -- locally produces any result at all, then right parser is
227 -- not used.
228 R f0 <++ q =
229 do s <- look
230 probe (f0 return) s 0#
231 where
232 probe (Get f) (c:s) n = probe (f c) s (n+#1#)
233 probe (Look f) s n = probe (f s) s n
234 probe p@(Result _ _) _ n = discard n >> R (p >>=)
235 probe (Final r) _ _ = R (Final r >>=)
236 probe _ _ _ = q
237
238 discard 0# = return ()
239 discard n = get >> discard (n-#1#)
240
241 gather :: ReadP a -> ReadP (String, a)
242 -- ^ Transforms a parser into one that does the same, but
243 -- in addition returns the exact characters read.
244 -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
245 -- is built using any occurrences of readS_to_P.
246 gather (R m)
247 = R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
248 where
249 gath :: (String -> String) -> P (String -> P b) -> P b
250 gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
251 gath _ Fail = Fail
252 gath l (Look f) = Look (\s -> gath l (f s))
253 gath l (Result k p) = k (l []) <|> gath l p
254 gath _ (Final _) = errorWithoutStackTrace "do not use readS_to_P in gather!"
255
256 -- ---------------------------------------------------------------------------
257 -- Derived operations
258
259 satisfy :: (Char -> Bool) -> ReadP Char
260 -- ^ Consumes and returns the next character, if it satisfies the
261 -- specified predicate.
262 satisfy p = do c <- get; if p c then return c else pfail
263
264 char :: Char -> ReadP Char
265 -- ^ Parses and returns the specified character.
266 char c = satisfy (c ==)
267
268 eof :: ReadP ()
269 -- ^ Succeeds iff we are at the end of input
270 eof = do { s <- look
271 ; if null s then return ()
272 else pfail }
273
274 string :: String -> ReadP String
275 -- ^ Parses and returns the specified string.
276 string this = do s <- look; scan this s
277 where
278 scan [] _ = do return this
279 scan (x:xs) (y:ys) | x == y = do _ <- get; scan xs ys
280 scan _ _ = do pfail
281
282 munch :: (Char -> Bool) -> ReadP String
283 -- ^ Parses the first zero or more characters satisfying the predicate.
284 -- Always succeeds, exactly once having consumed all the characters
285 -- Hence NOT the same as (many (satisfy p))
286 munch p =
287 do s <- look
288 scan s
289 where
290 scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s)
291 scan _ = do return ""
292
293 munch1 :: (Char -> Bool) -> ReadP String
294 -- ^ Parses the first one or more characters satisfying the predicate.
295 -- Fails if none, else succeeds exactly once having consumed all the characters
296 -- Hence NOT the same as (many1 (satisfy p))
297 munch1 p =
298 do c <- get
299 if p c then do s <- munch p; return (c:s)
300 else pfail
301
302 choice :: [ReadP a] -> ReadP a
303 -- ^ Combines all parsers in the specified list.
304 choice [] = pfail
305 choice [p] = p
306 choice (p:ps) = p +++ choice ps
307
308 skipSpaces :: ReadP ()
309 -- ^ Skips all whitespace.
310 skipSpaces =
311 do s <- look
312 skip s
313 where
314 skip (c:s) | isSpace c = do _ <- get; skip s
315 skip _ = do return ()
316
317 count :: Int -> ReadP a -> ReadP [a]
318 -- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of
319 -- results is returned.
320 count n p = sequence (replicate n p)
321
322 between :: ReadP open -> ReadP close -> ReadP a -> ReadP a
323 -- ^ @between open close p@ parses @open@, followed by @p@ and finally
324 -- @close@. Only the value of @p@ is returned.
325 between open close p = do _ <- open
326 x <- p
327 _ <- close
328 return x
329
330 option :: a -> ReadP a -> ReadP a
331 -- ^ @option x p@ will either parse @p@ or return @x@ without consuming
332 -- any input.
333 option x p = p +++ return x
334
335 optional :: ReadP a -> ReadP ()
336 -- ^ @optional p@ optionally parses @p@ and always returns @()@.
337 optional p = (p >> return ()) +++ return ()
338
339 many :: ReadP a -> ReadP [a]
340 -- ^ Parses zero or more occurrences of the given parser.
341 many p = return [] +++ many1 p
342
343 many1 :: ReadP a -> ReadP [a]
344 -- ^ Parses one or more occurrences of the given parser.
345 many1 p = liftM2 (:) p (many p)
346
347 skipMany :: ReadP a -> ReadP ()
348 -- ^ Like 'many', but discards the result.
349 skipMany p = many p >> return ()
350
351 skipMany1 :: ReadP a -> ReadP ()
352 -- ^ Like 'many1', but discards the result.
353 skipMany1 p = p >> skipMany p
354
355 sepBy :: ReadP a -> ReadP sep -> ReadP [a]
356 -- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.
357 -- Returns a list of values returned by @p@.
358 sepBy p sep = sepBy1 p sep +++ return []
359
360 sepBy1 :: ReadP a -> ReadP sep -> ReadP [a]
361 -- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.
362 -- Returns a list of values returned by @p@.
363 sepBy1 p sep = liftM2 (:) p (many (sep >> p))
364
365 endBy :: ReadP a -> ReadP sep -> ReadP [a]
366 -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
367 -- by @sep@.
368 endBy p sep = many (do x <- p ; _ <- sep ; return x)
369
370 endBy1 :: ReadP a -> ReadP sep -> ReadP [a]
371 -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
372 -- by @sep@.
373 endBy1 p sep = many1 (do x <- p ; _ <- sep ; return x)
374
375 chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
376 -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
377 -- Returns a value produced by a /right/ associative application of all
378 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
379 -- returned.
380 chainr p op x = chainr1 p op +++ return x
381
382 chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
383 -- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.
384 -- Returns a value produced by a /left/ associative application of all
385 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
386 -- returned.
387 chainl p op x = chainl1 p op +++ return x
388
389 chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
390 -- ^ Like 'chainr', but parses one or more occurrences of @p@.
391 chainr1 p op = scan
392 where scan = p >>= rest
393 rest x = do f <- op
394 y <- scan
395 return (f x y)
396 +++ return x
397
398 chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
399 -- ^ Like 'chainl', but parses one or more occurrences of @p@.
400 chainl1 p op = p >>= rest
401 where rest x = do f <- op
402 y <- p
403 rest (f x y)
404 +++ return x
405
406 manyTill :: ReadP a -> ReadP end -> ReadP [a]
407 -- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@
408 -- succeeds. Returns a list of values returned by @p@.
409 manyTill p end = scan
410 where scan = (end >> return []) <++ (liftM2 (:) p scan)
411
412 -- ---------------------------------------------------------------------------
413 -- Converting between ReadP and Read
414
415 readP_to_S :: ReadP a -> ReadS a
416 -- ^ Converts a parser into a Haskell ReadS-style function.
417 -- This is the main way in which you can \"run\" a 'ReadP' parser:
418 -- the expanded type is
419 -- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
420 readP_to_S (R f) = run (f return)
421
422 readS_to_P :: ReadS a -> ReadP a
423 -- ^ Converts a Haskell ReadS-style function into a parser.
424 -- Warning: This introduces local backtracking in the resulting
425 -- parser, and therefore a possible inefficiency.
426 readS_to_P r =
427 R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
428
429 -- ---------------------------------------------------------------------------
430 -- QuickCheck properties that hold for the combinators
431
432 {- $properties
433 The following are QuickCheck specifications of what the combinators do.
434 These can be seen as formal specifications of the behavior of the
435 combinators.
436
437 For some values, we only care about the lists contents, not their order,
438
439 > (=~) :: Ord a => [a] -> [a] -> Bool
440 > xs =~ ys = sort xs == sort ys
441
442 Here follow the properties:
443
444 >>> readP_to_S get []
445 []
446
447 prop> \c str -> readP_to_S get (c:str) == [(c, str)]
448
449 prop> \str -> readP_to_S look str == [(str, str)]
450
451 prop> \str -> readP_to_S pfail str == []
452
453 prop> \x str -> readP_to_S (return x) s == [(x,s)]
454
455 > prop_Bind p k s =
456 > readP_to_S (p >>= k) s =~
457 > [ ys''
458 > | (x,s') <- readP_to_S p s
459 > , ys'' <- readP_to_S (k (x::Int)) s'
460 > ]
461
462 > prop_Plus p q s =
463 > readP_to_S (p +++ q) s =~
464 > (readP_to_S p s ++ readP_to_S q s)
465
466 > prop_LeftPlus p q s =
467 > readP_to_S (p <++ q) s =~
468 > (readP_to_S p s +<+ readP_to_S q s)
469 > where
470 > [] +<+ ys = ys
471 > xs +<+ _ = xs
472
473 > prop_Gather s =
474 > forAll readPWithoutReadS $ \p ->
475 > readP_to_S (gather p) s =~
476 > [ ((pre,x::Int),s')
477 > | (x,s') <- readP_to_S p s
478 > , let pre = take (length s - length s') s
479 > ]
480
481 prop> \this str -> readP_to_S (string this) (this ++ str) == [(this,str)]
482
483 > prop_String_Maybe this s =
484 > readP_to_S (string this) s =~
485 > [(this, drop (length this) s) | this `isPrefixOf` s]
486
487 > prop_Munch p s =
488 > readP_to_S (munch p) s =~
489 > [(takeWhile p s, dropWhile p s)]
490
491 > prop_Munch1 p s =
492 > readP_to_S (munch1 p) s =~
493 > [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
494
495 > prop_Choice ps s =
496 > readP_to_S (choice ps) s =~
497 > readP_to_S (foldr (+++) pfail ps) s
498
499 > prop_ReadS r s =
500 > readP_to_S (readS_to_P r) s =~ r s
501 -}