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 readP_to_S, -- :: ReadP a -> ReadS a
44 readS_to_P, -- :: ReadS a -> ReadP a
51 import Control.Monad( MonadPlus(..) )
52 #ifdef __GLASGOW_HASKELL__
53 import GHC.Show( isSpace )
56 import Data.Char( isSpace )
61 #ifdef __GLASGOW_HASKELL__
62 -- We define a local version of ReadS here,
63 -- because its "real" definition site is in GHC.Read
64 type ReadS a = String -> [(a,String)]
67 -- ---------------------------------------------------------------------------
69 -- is representation type -- should be kept abstract
73 | Look (String -> P a)
76 | Final [(a,String)] -- invariant: list is non-empty!
80 instance Monad P where
81 return x = Result x Fail
83 (Get f) >>= k = Get (\c -> f c >>= k)
84 (Look f) >>= k = Look (\s -> f s >>= k)
86 (Result x p) >>= k = k x `mplus` (p >>= k)
87 (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
91 instance MonadPlus P where
94 -- most common case: two gets are combined
95 Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c)
97 -- results are delivered as soon as possible
98 Result x p `mplus` q = Result x (p `mplus` q)
99 p `mplus` Result x q = Result x (p `mplus` q)
105 -- two finals are combined
106 -- final + look becomes one look and one final (=optimization)
107 -- final + sthg else becomes one look and one final
108 Final r `mplus` Final t = Final (r ++ t)
109 Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s))
110 Final r `mplus` p = Look (\s -> Final (r ++ run p s))
111 Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r))
112 p `mplus` Final r = Look (\s -> Final (run p s ++ r))
114 -- two looks are combined (=optimization)
115 -- look + sthg else floats upwards
116 Look f `mplus` Look g = Look (\s -> f s `mplus` g s)
117 Look f `mplus` p = Look (\s -> f s `mplus` p)
118 p `mplus` Look f = Look (\s -> p `mplus` f s)
120 -- ---------------------------------------------------------------------------
123 newtype ReadP a = R (forall b . (a -> P b) -> P b)
125 -- Functor, Monad, MonadPlus
127 instance Functor ReadP where
128 fmap h (R f) = R (\k -> f (k . h))
130 instance Monad ReadP where
131 return x = R (\k -> k x)
132 fail _ = R (\_ -> Fail)
133 R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
135 instance MonadPlus ReadP where
139 -- ---------------------------------------------------------------------------
142 final :: [(a,String)] -> P a
143 -- Maintains invariant for Final constructor
147 run :: P a -> ReadS a
148 run (Get f) (c:s) = run (f c) s
149 run (Look f) s = run (f s) s
150 run (Result x p) s = (x,s) : run p s
154 -- ---------------------------------------------------------------------------
155 -- Operations over ReadP
158 -- ^ Consumes and returns the next character.
159 -- Fails if there is no input left.
163 -- ^ Look-ahead: returns the part of the input that is left, without
169 pfail = R (\_ -> Fail)
171 (+++) :: ReadP a -> ReadP a -> ReadP a
172 -- ^ Symmetric choice.
173 R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
175 (<++) :: ReadP a -> ReadP a -> ReadP a
176 -- ^ Local, exclusive, left-biased choice: If left parser
177 -- locally produces any result at all, then right parser is
179 #ifdef __GLASGOW_HASKELL__
182 probe (f return) s 0#
184 probe (Get f) (c:s) n = probe (f c) s (n+#1#)
185 probe (Look f) s n = probe (f s) s n
186 probe p@(Result _ _) _ n = discard n >> R (p >>=)
187 probe (Final r) _ _ = R (Final r >>=)
190 discard 0# = return ()
191 discard n = get >> discard (n-#1#)
197 probe (Get f) (c:s) n = probe (f c) s (n+1)
198 probe (Look f) s n = probe (f s) s n
199 probe p@(Result _ _) _ n = discard n >> R (p >>=)
200 probe (Final r) _ _ = R (Final r >>=)
203 discard 0 = return ()
204 discard n = get >> discard (n-1)
207 gather :: ReadP a -> ReadP (String, a)
208 -- ^ Transforms a parser into one that does the same, but
209 -- in addition returns the exact characters read.
210 -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
211 -- is built using any occurrences of readS_to_P.
213 R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
215 gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
217 gath l (Look f) = Look (\s -> gath l (f s))
218 gath l (Result k p) = k (l []) `mplus` gath l p
219 gath l (Final r) = error "do not use readS_to_P in gather!"
221 -- ---------------------------------------------------------------------------
222 -- Derived operations
224 satisfy :: (Char -> Bool) -> ReadP Char
225 -- ^ Consumes and returns the next character, if it satisfies the
226 -- specified predicate.
227 satisfy p = do c <- get; if p c then return c else pfail
229 char :: Char -> ReadP Char
230 -- ^ Parses and returns the specified character.
231 char c = satisfy (c ==)
233 string :: String -> ReadP String
234 -- ^ Parses and returns the specified string.
235 string this = do s <- look; scan this s
237 scan [] _ = do return this
238 scan (x:xs) (y:ys) | x == y = do get; scan xs ys
241 munch :: (Char -> Bool) -> ReadP String
242 -- ^ Parses the first zero or more characters satisfying the predicate.
247 scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
248 scan _ = do return ""
250 munch1 :: (Char -> Bool) -> ReadP String
251 -- ^ Parses the first one or more characters satisfying the predicate.
254 if p c then do s <- munch p; return (c:s) else pfail
256 choice :: [ReadP a] -> ReadP a
257 -- ^ Combines all parsers in the specified list.
260 choice (p:ps) = p +++ choice ps
262 skipSpaces :: ReadP ()
263 -- ^ Skips all whitespace.
268 skip (c:s) | isSpace c = do get; skip s
269 skip _ = do return ()
271 -- ---------------------------------------------------------------------------
272 -- Converting between ReadP and Read
274 readP_to_S :: ReadP a -> ReadS a
275 -- ^ Converts a parser into a Haskell ReadS-style function.
276 -- This is the main way in which you can \"run\" a 'ReadP' parser:
277 -- the expanded type is
278 -- @ readP_to_S :: ReadP a -> String -> [(String,String)] @
279 readP_to_S (R f) = run (f return)
281 readS_to_P :: ReadS a -> ReadP a
282 -- ^ Converts a Haskell ReadS-style function into a parser.
283 -- Warning: This introduces local backtracking in the resulting
284 -- parser, and therefore a possible inefficiency.
286 R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
288 -- ---------------------------------------------------------------------------
289 -- QuickCheck properties that hold for the combinators
292 The following are QuickCheck specifications of what the combinators do.
293 These can be seen as formal specifications of the behavior of the
296 We use bags to give semantics to the combinators.
300 Equality on bags does not care about the order of elements.
302 > (=~) :: Ord a => Bag a -> Bag a -> Bool
303 > xs =~ ys = sort xs == sort ys
305 A special equality operator to avoid unresolved overloading
306 when testing the properties.
308 > (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool
311 Here follow the properties:
314 > readP_to_S get [] =~ []
316 > prop_Get_Cons c s =
317 > readP_to_S get (c:s) =~ [(c,s)]
320 > readP_to_S look s =~ [(s,s)]
323 > readP_to_S pfail s =~. []
326 > readP_to_S (return x) s =~. [(x,s)]
329 > readP_to_S (p >>= k) s =~.
331 > | (x,s') <- readP_to_S p s
332 > , ys'' <- readP_to_S (k (x::Int)) s'
336 > readP_to_S (p +++ q) s =~.
337 > (readP_to_S p s ++ readP_to_S q s)
339 > prop_LeftPlus p q s =
340 > readP_to_S (p <++ q) s =~.
341 > (readP_to_S p s +<+ readP_to_S q s)
347 > forAll readPWithoutReadS $ \p ->
348 > readP_to_S (gather p) s =~
349 > [ ((pre,x::Int),s')
350 > | (x,s') <- readP_to_S p s
351 > , let pre = take (length s - length s') s
354 > prop_String_Yes this s =
355 > readP_to_S (string this) (this ++ s) =~
358 > prop_String_Maybe this s =
359 > readP_to_S (string this) s =~
360 > [(this, drop (length this) s) | this `isPrefixOf` s]
363 > readP_to_S (munch p) s =~
364 > [(takeWhile p s, dropWhile p s)]
367 > readP_to_S (munch1 p) s =~
368 > [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
371 > readP_to_S (choice ps) s =~.
372 > readP_to_S (foldr (+++) pfail ps) s
375 > readP_to_S (readS_to_P r) s =~. r s