1 % -------------------------------------------------------------
4 % (c) The University of Glasgow, 1994-2000
8 {-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
9 module Text.ParserCombinators.ReadP
10 ( ReadP -- :: * -> *; instance Functor, Monad, MonadPlus
12 -- primitive operations
13 , get -- :: ReadP Char
14 , look -- :: ReadP String
15 , (+++) -- :: ReadP a -> ReadP a -> ReadP a
19 , satisfy -- :: (Char -> Bool) -> ReadP Char
20 , char -- :: Char -> ReadP Char
21 , string -- :: String -> ReadP String
22 , munch -- :: (Char -> Bool) -> ReadP String
23 , munch1 -- :: (Char -> Bool) -> ReadP String
24 , skipSpaces -- :: ReadP ()
25 , choice -- :: [ReadP a] -> ReadP a
28 , readP_to_S -- :: ReadP a -> ReadS a
29 , readS_to_P -- :: ReadS a -> ReadP a
33 import Control.Monad( MonadPlus(..) )
34 import GHC.Show( isSpace )
39 %*********************************************************
41 \subsection{The @ReadP@ type}
43 %*********************************************************
46 newtype ReadP a = R (forall b . (a -> P b) -> P b)
50 | Look (String -> P a)
55 -- We define a local version of ReadS here,
56 -- because its "real" definition site is in GHC.Read
57 type ReadS a = String -> [(a,String)]
59 -- Functor, Monad, MonadPlus
61 instance Functor ReadP where
62 fmap h (R f) = R (\k -> f (k . h))
64 instance Monad ReadP where
65 return x = R (\k -> k x)
66 fail _ = R (\_ -> Fail)
67 R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
69 instance MonadPlus ReadP where
75 %*********************************************************
77 \subsection{Operations over ReadP}
79 %*********************************************************
86 look = R (\k -> Look k)
88 (+++) :: ReadP a -> ReadP a -> ReadP a
89 R f1 +++ R f2 = R (\k -> f1 k >|< f2 k)
91 Get f1 >|< Get f2 = Get (\c -> f1 c >|< f2 c)
94 Look f >|< Look g = Look (\s -> f s >|< g s)
95 Result x p >|< q = Result x (p >|< q)
96 p >|< Result x q = Result x (p >|< q)
97 Look f >|< p = Look (\s -> f s >|< p)
98 p >|< Look f = Look (\s -> p >|< f s)
99 p >|< q = ReadS (\s -> run p s ++ run q s)
101 run :: P a -> ReadS a
103 run (Get f) (c:s) = run (f c) s
104 run (Look f) s = run (f s) s
105 run (Result x p) s = (x,s) : run p s
106 run (ReadS r) s = r s
111 %*********************************************************
113 \subsection{Derived operations}
115 %*********************************************************
121 satisfy :: (Char -> Bool) -> ReadP Char
122 satisfy p = do c <- get; if p c then return c else pfail
124 char :: Char -> ReadP Char
125 char c = satisfy (c ==)
127 string :: String -> ReadP String
130 scan [] = do return s
131 scan (c:cs) = do char c; scan cs
133 munch :: (Char -> Bool) -> ReadP String
134 -- (munch p) parses the first zero or more characters satisfying p
139 scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
140 scan _ = do return ""
142 munch1 :: (Char -> Bool) -> ReadP String
143 -- (munch p) parses the first one or more characters satisfying p
146 if p c then do s <- munch p; return (c:s) else pfail
148 choice :: [ReadP a] -> ReadP a
149 choice ps = foldr (+++) pfail ps
151 skipSpaces :: ReadP ()
156 skip (c:s) | isSpace c = do get; skip s
157 skip _ = do return ()
161 %*********************************************************
163 \subsection{Converting between ReadP and ReadS
165 %*********************************************************
168 readP_to_S :: ReadP a -> ReadS a
169 readP_to_S (R f) = run (f (\x -> Result x Fail))
171 readS_to_P :: ReadS a -> ReadP a
172 readS_to_P r = R (\k -> ReadS (\s -> [ bs''
174 , bs'' <- run (k a) s'