b501a8e7f3e815989446105e122bc3f8b7f3be5e
[ghc.git] / libraries / base / Text / ParserCombinators / ReadPrec.hs
1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Text.ParserCombinators.ReadPrec
5 -- Copyright : (c) The University of Glasgow 2002
6 -- License : BSD-style (see the file libraries/base/LICENSE)
7 --
8 -- Maintainer : libraries@haskell.org
9 -- Stability : provisional
10 -- Portability : portable
11 --
12 -----------------------------------------------------------------------------
13
14 module Text.ParserCombinators.ReadPrec
15 (
16 ReadPrec, -- :: * -> *; instance Functor, Monad, MonadPlus
17
18 -- * Precedences
19 Prec, -- :: *; = Int
20 minPrec, -- :: Prec; = 0
21
22 -- * Primitive operations
23 lift, -- :: ReadP a -> ReadPrec a
24 prec, -- :: Prec -> ReadPrec a -> ReadPrec a
25 step, -- :: ReadPrec a -> ReadPrec a
26 reset, -- :: ReadPrec a -> ReadPrec a
27
28 -- * Other operations
29 get, -- :: ReadPrec Char
30 look, -- :: ReadPrec String
31 (+++), -- :: ReadPrec a -> ReadPrec a -> ReadPrec a
32 pfail, -- :: ReadPrec a
33 choice, -- :: [ReadPrec a] -> ReadPrec a
34
35 -- converters
36 readPrec_to_P, -- :: ReadPrec a -> (Int -> ReadP a)
37 readP_to_Prec, -- :: (Int -> ReadP a) -> ReadPrec a
38 readPrec_to_S, -- :: ReadPrec a -> (Int -> ReadS a)
39 readS_to_Prec, -- :: (Int -> ReadS a) -> ReadPrec a
40 )
41 where
42
43
44 import Text.ParserCombinators.ReadP
45 ( ReadP
46 , readP_to_S
47 , readS_to_P
48 )
49
50 import qualified Text.ParserCombinators.ReadP as ReadP
51 ( get
52 , look
53 , (+++)
54 , pfail
55 , choice
56 )
57
58 import Control.Monad( MonadPlus(..) )
59 import GHC.Num( Num(..) )
60 import GHC.Base
61
62 -- ---------------------------------------------------------------------------
63 -- The readPrec type
64
65 newtype ReadPrec a = P { unP :: Prec -> ReadP a }
66
67 -- Functor, Monad, MonadPlus
68
69 instance Functor ReadPrec where
70 fmap h (P f) = P (\n -> fmap h (f n))
71
72 instance Monad ReadPrec where
73 return x = P (\_ -> return x)
74 fail s = P (\_ -> fail s)
75 P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n)
76
77 instance MonadPlus ReadPrec where
78 mzero = pfail
79 mplus = (+++)
80
81 -- precedences
82
83 type Prec = Int
84
85 minPrec :: Prec
86 minPrec = 0
87
88 -- ---------------------------------------------------------------------------
89 -- Operations over ReadPrec
90
91 lift :: ReadP a -> ReadPrec a
92 lift m = P (\_ -> m)
93
94 step :: ReadPrec a -> ReadPrec a
95 -- Increases the precedence context by one
96 step (P f) = P (\n -> f (n+1))
97
98 reset :: ReadPrec a -> ReadPrec a
99 -- Resets the precedence context to zero
100 reset (P f) = P (\n -> f minPrec)
101
102 prec :: Prec -> ReadPrec a -> ReadPrec a
103 -- (prec n p) checks that the precedence context is
104 -- less than or equal to n,
105 -- if not, fails
106 -- if so, parses p in context n
107 prec n (P f) = P (\c -> if c <= n then f n else ReadP.pfail)
108
109 -- ---------------------------------------------------------------------------
110 -- Derived operations
111
112 get :: ReadPrec Char
113 get = lift ReadP.get
114
115 look :: ReadPrec String
116 look = lift ReadP.look
117
118 (+++) :: ReadPrec a -> ReadPrec a -> ReadPrec a
119 P f1 +++ P f2 = P (\n -> f1 n ReadP.+++ f2 n)
120
121 pfail :: ReadPrec a
122 pfail = lift ReadP.pfail
123
124 choice :: [ReadPrec a] -> ReadPrec a
125 choice ps = foldr (+++) pfail ps
126
127 -- ---------------------------------------------------------------------------
128 -- Converting between ReadPrec and Read
129
130 -- We define a local version of ReadS here,
131 -- because its "real" definition site is in GHC.Read
132 type ReadS a = String -> [(a,String)]
133
134 readPrec_to_P :: ReadPrec a -> (Int -> ReadP a)
135 readPrec_to_P (P f) = f
136
137 readP_to_Prec :: (Int -> ReadP a) -> ReadPrec a
138 readP_to_Prec f = P f
139
140 readPrec_to_S :: ReadPrec a -> (Int -> ReadS a)
141 readPrec_to_S (P f) n = readP_to_S (f n)
142
143 readS_to_Prec :: (Int -> ReadS a) -> ReadPrec a
144 readS_to_Prec f = P (\n -> readS_to_P (f n))