1 {-# OPTIONS -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 : portable
12 -----------------------------------------------------------------------------
14 module Text.ParserCombinators.ReadP
17 ReadP -- :: * -> *; instance Functor, Monad, MonadPlus
19 -- * Primitive operations
20 , get -- :: ReadP Char
21 , look -- :: ReadP String
22 , (+++) -- :: ReadP a -> ReadP a -> ReadP a
26 , satisfy -- :: (Char -> Bool) -> ReadP Char
27 , char -- :: Char -> ReadP Char
28 , string -- :: String -> ReadP String
29 , munch -- :: (Char -> Bool) -> ReadP String
30 , munch1 -- :: (Char -> Bool) -> ReadP String
31 , skipSpaces -- :: ReadP ()
32 , choice -- :: [ReadP a] -> ReadP a
35 , readP_to_S -- :: ReadP a -> ReadS a
36 , readS_to_P -- :: ReadS a -> ReadP a
40 import Control.Monad( MonadPlus(..) )
41 import GHC.Show( isSpace )
44 -- ---------------------------------------------------------------------------
47 newtype ReadP a = R (forall b . (a -> P b) -> P b)
51 | Look (String -> P a)
56 -- We define a local version of ReadS here,
57 -- because its "real" definition site is in GHC.Read
58 type ReadS a = String -> [(a,String)]
60 -- Functor, Monad, MonadPlus
62 instance Functor ReadP where
63 fmap h (R f) = R (\k -> f (k . h))
65 instance Monad ReadP where
66 return x = R (\k -> k x)
67 fail _ = R (\_ -> Fail)
68 R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
70 instance MonadPlus ReadP where
74 -- ---------------------------------------------------------------------------
75 -- Operations over ReadP
81 look = R (\k -> Look k)
83 (+++) :: ReadP a -> ReadP a -> ReadP a
84 R f1 +++ R f2 = R (\k -> f1 k >|< f2 k)
86 Get f1 >|< Get f2 = Get (\c -> f1 c >|< f2 c)
89 Look f >|< Look g = Look (\s -> f s >|< g s)
90 Result x p >|< q = Result x (p >|< q)
91 p >|< Result x q = Result x (p >|< q)
92 Look f >|< p = Look (\s -> f s >|< p)
93 p >|< Look f = Look (\s -> p >|< f s)
94 p >|< q = ReadS (\s -> run p s ++ run q s)
98 run (Get f) (c:s) = run (f c) s
99 run (Look f) s = run (f s) s
100 run (Result x p) s = (x,s) : run p s
101 run (ReadS r) s = r s
104 -- ---------------------------------------------------------------------------
105 -- Derived operations
110 satisfy :: (Char -> Bool) -> ReadP Char
111 satisfy p = do c <- get; if p c then return c else pfail
113 char :: Char -> ReadP Char
114 char c = satisfy (c ==)
116 string :: String -> ReadP String
119 scan [] = do return s
120 scan (c:cs) = do char c; scan cs
122 munch :: (Char -> Bool) -> ReadP String
123 -- (munch p) parses the first zero or more characters satisfying p
128 scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
129 scan _ = do return ""
131 munch1 :: (Char -> Bool) -> ReadP String
132 -- (munch p) parses the first one or more characters satisfying p
135 if p c then do s <- munch p; return (c:s) else pfail
137 choice :: [ReadP a] -> ReadP a
138 choice ps = foldr (+++) pfail ps
140 skipSpaces :: ReadP ()
145 skip (c:s) | isSpace c = do get; skip s
146 skip _ = do return ()
148 -- ---------------------------------------------------------------------------
149 -- Converting between ReadP and Read
151 readP_to_S :: ReadP a -> ReadS a
152 readP_to_S (R f) = run (f (\x -> Result x Fail))
154 readS_to_P :: ReadS a -> ReadP a
155 readS_to_P r = R (\k -> ReadS (\s -> [ bs''
157 , bs'' <- run (k a) s'