c12e8c90b8f1665a8354e6ab9b7b9754c405075a
[packages/random.git] / Data / Generics / Twins.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Data.Generics.Twins
4 -- Copyright : (c) The University of Glasgow, CWI 2001--2003
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
10 --
11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell
12 -- See <http://www.cs.vu.nl/boilerplate/>. The present module
13 -- provides support for multi-parameter traversal, which is also
14 -- demonstrated with generic operations like equality.
15 --
16 -----------------------------------------------------------------------------
17
18 module Data.Generics.Twins (
19
20 -- * The idiom for multi-parameter traversal
21 gzipWith,
22
23 -- * Mapping combinators with an additional list
24 gzipWithT,
25 gzipWithM,
26 gzipWithQ,
27 gzipWithQl,
28 gzipWithQr,
29
30 -- * Mapping combinators for twin traversal
31 tmapT,
32 tmapM,
33 tmapQ,
34
35
36 -- * Typical twin traversals
37 geq,
38 gzip
39
40 ) where
41
42
43 ------------------------------------------------------------------------------
44
45 #ifdef __HADDOCK__
46 import Prelude
47 #endif
48 import Data.Generics.Basics
49 import Data.Generics.Aliases
50
51 ------------------------------------------------------------------------------
52
53
54 ------------------------------------------------------------------------------
55 --
56 -- The idiom for multi-parameter traversal
57 --
58 ------------------------------------------------------------------------------
59
60 {-
61
62 gfoldl and friends so far facilitated traversal of a single term. We
63 will now consider an idiom gfoldlWith to traverse two terms
64 semi-simultaneously. By cascasding this idiom, we can also traverse
65 more than two terms. The gfoldlWith primitive completes gfoldl in a
66 way that is similar to the well-known couple map and
67 zipWith. Basically, gfoldlWith takes an additional argument, namely a
68 list, and this list is traversed simultaneously with the immediate
69 subterms of a given term.
70
71 -}
72
73
74 -- | gfoldl with an additional list
75 gzipWith :: Data a
76 => (forall a b. Data a => d -> c (a -> b) -> a -> c b)
77 -> (forall g. g -> c g)
78 -> [d]
79 -> a
80 -> c a
81
82 gzipWith k z l x = case gfoldl k' z' x of { WITH _ c -> c }
83 where
84 k' (WITH (h:t) c) y = WITH t (k h c y)
85 k' (WITH [] _) _ = error "gzipWith"
86 z' f = WITH l (z f)
87
88
89 -- | A type constructor for folding over the extra list
90 data WITH q c a = WITH [q] (c a)
91
92
93
94 ------------------------------------------------------------------------------
95 --
96 -- Mapping combinators with an additional list
97 --
98 ------------------------------------------------------------------------------
99
100
101 -- | gmapT with an additional list
102 gzipWithT :: Data a
103 => (forall a. Data a => b -> a -> a)
104 -> [b]
105 -> a
106 -> a
107
108 gzipWithT f l = unID . gzipWith k ID l
109 where
110 k b (ID c) x = ID $ c $ f b x
111
112
113 -- | gmapM with an additional list
114 gzipWithM :: (Data a, Monad m)
115 => (forall a. Data a => b -> a -> m a)
116 -> [b]
117 -> a
118 -> m a
119
120 gzipWithM f = gzipWith k return
121 where
122 k b c x = do c' <- c
123 x' <- f b x
124 return (c' x')
125
126
127 -- | gmapQl with an additional list
128 gzipWithQl :: Data a
129 => (r -> r -> r)
130 -> r
131 -> (forall a. Data a => b -> a -> r)
132 -> [b]
133 -> a
134 -> r
135
136 gzipWithQl o r f l = unCONST . gzipWith k z l
137 where
138 k b (CONST c) x = CONST (c `o` f b x)
139 z _ = CONST r
140
141
142 -- | gmapQr with an additional list
143 gzipWithQr :: Data a
144 => (r' -> r -> r)
145 -> r
146 -> (forall a. Data a => b -> a -> r')
147 -> [b]
148 -> a
149 -> r
150
151 gzipWithQr o r f l x = unQr (gzipWith k z l x) r
152 where
153 k b (Qr c) x = Qr (\r -> c (f b x `o` r))
154 z _ = Qr id
155
156
157 -- | gmapQ with an additional list
158 gzipWithQ :: Data a
159 => (forall a. Data a => b -> a -> u)
160 -> [b]
161 -> a
162 -> [u]
163
164 gzipWithQ f = gzipWithQr (:) [] f
165
166
167
168 ------------------------------------------------------------------------------
169 --
170 -- Helper type constructors
171 --
172 ------------------------------------------------------------------------------
173
174
175
176 -- | The identity type constructor needed for the definition of gzipWithT
177 newtype ID x = ID { unID :: x }
178
179
180 -- | The constant type constructor needed for the definition of gzipWithQl
181 newtype CONST c a = CONST { unCONST :: c }
182
183
184 -- | The type constructor needed for the definition of gzipWithQr
185 newtype Qr r a = Qr { unQr :: r -> r }
186
187
188
189 ------------------------------------------------------------------------------
190 --
191 -- Mapping combinators for twin traversal
192 --
193 ------------------------------------------------------------------------------
194
195
196 -- | Twin map for transformation
197 tmapT :: GenericQ (GenericT) -> GenericQ (GenericT)
198 tmapT f x y =
199 gzipWithT unGenericT'
200 (gmapQ (\x -> GenericT' (f x)) x)
201 y
202
203
204 -- | Twin map for monadic transformation
205 tmapM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
206 tmapM f x y =
207 gzipWithM unGenericM'
208 (gmapQ (\x -> GenericM' (f x)) x)
209 y
210
211
212 -- | Twin map for monadic transformation
213 tmapQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
214 tmapQ f x y =
215 gzipWithQ unGenericQ'
216 (gmapQ (\x -> GenericQ' (f x)) x)
217 y
218
219
220
221 ------------------------------------------------------------------------------
222 --
223 -- Typical twin traversals
224 --
225 ------------------------------------------------------------------------------
226
227 -- | Generic equality: an alternative to \"deriving Eq\"
228 geq :: Data a => a -> a -> Bool
229
230 {-
231
232 Testing for equality of two terms goes like this. Firstly, we
233 establish the equality of the two top-level datatype
234 constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,
235 to compare the two lists of immediate subterms.
236
237 (Note for the experts: the type of the worker geq' is rather general
238 but precision is recovered via the restrictive type of the top-level
239 operation geq. The imprecision of geq' is caused by the type system's
240 unability to express the type equivalence for the corresponding
241 couples of immediate subterms from the two given input terms.)
242
243 -}
244
245 geq x y = geq' x y
246 where
247 geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
248 geq' x y = (toConstr x == toConstr y)
249 && and (tmapQ geq' x y)
250
251
252 -- | Generic zip controlled by a function with type-specific branches
253 gzip :: (forall a b. (Data a, Data b) => a -> b -> Maybe b)
254 -> (forall a b. (Data a, Data b) => a -> b -> Maybe b)
255
256
257 -- See testsuite/.../Generics/gzip.hs for an illustration
258 gzip f x y =
259 f x y
260 `orElse`
261 if toConstr x == toConstr y
262 then tmapM (gzip f) x y
263 else Nothing