1 -----------------------------------------------------------------------------
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)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
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.
16 -----------------------------------------------------------------------------
18 module Data.Generics.Twins (
20 -- * Generic folds and maps that also accumulate
28 -- * Mapping combinators for twin traversal
33 -- * Typical twin traversals
40 ------------------------------------------------------------------------------
45 import Data.Generics.Basics
46 import Data.Generics.Aliases
48 ------------------------------------------------------------------------------
51 ------------------------------------------------------------------------------
53 -- Generic folds and maps that also accumulate
55 ------------------------------------------------------------------------------
57 {--------------------------------------------------------------
59 A list map can be elaborated to perform accumulation.
60 In the same sense, we can elaborate generic maps over terms.
62 We recall the type of map:
63 map :: (a -> b) -> [a] -> [b]
65 We recall the type of an accumulating map (see Data.List):
66 mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
68 Applying the same scheme we obtain an accumulating gfoldl.
70 --------------------------------------------------------------}
72 -- | gfoldl with accumulation
75 => (forall d r. Data d => a -> c (d -> r) -> d -> (a, c r))
76 -> (forall g. a -> g -> (a, c g))
79 gfoldlAccum k z a d = unA (gfoldl k' z' d) a
81 k' c y = A (\a -> let (a', c') = unA c a in k a' c' y)
82 z' f = A (\a -> z a f)
85 -- | A type constructor for accumulation
86 newtype A a c d = A (a -> (a, c d))
90 -- | gmapT with accumulation
92 => (forall d. Data d => a -> d -> (a,d))
94 gmapAccumT f a d = let (a',d') = gfoldlAccum k z a d
97 k a (ID c) d = let (a',d') = f a d
102 -- | gmapT with accumulation
103 gmapAccumM :: (Data d, Monad m)
104 => (forall d. Data d => a -> d -> (a, m d))
105 -> a -> d -> (a, m d)
106 gmapAccumM f = gfoldlAccum k z
108 k a c d = let (a',d') = f a d
109 in (a', d' >>= \d'' -> c >>= \c' -> return (c' d''))
110 z a x = (a, return x)
113 -- | gmapQl with accumulation
114 gmapAccumQl :: Data d
117 -> (forall d. Data d => a -> d -> (a,r'))
119 gmapAccumQl o r f a d = let (a',r) = gfoldlAccum k z a d
122 k a (CONST c) d = let (a',r') = f a d
123 in (a', CONST (c `o` r'))
127 -- | gmapQr with accumulation
128 gmapAccumQr :: Data d
131 -> (forall d. Data d => a -> d -> (a,r'))
133 gmapAccumQr o r f a d = let (a',l) = gfoldlAccum k z a d
136 k a (Qr c) d = let (a',r') = f a d
137 in (a', Qr (\r -> c (r' `o` r)))
141 -- | gmapQ with accumulation
143 => (forall d. Data d => a -> d -> (a,q))
144 -> a -> d -> (a, [q])
145 gmapAccumQ f = gmapAccumQr (:) [] f
149 ------------------------------------------------------------------------------
151 -- Helper type constructors
153 ------------------------------------------------------------------------------
156 -- | The identity type constructor needed for the definition of gmapAccumT
157 newtype ID x = ID { unID :: x }
160 -- | The constant type constructor needed for the definition of gmapAccumQl
161 newtype CONST c a = CONST { unCONST :: c }
164 -- | The type constructor needed for the definition of gmapAccumQr
165 newtype Qr r a = Qr { unQr :: r -> r }
169 ------------------------------------------------------------------------------
171 -- Mapping combinators for twin traversal
173 ------------------------------------------------------------------------------
176 -- | Twin map for transformation
177 gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT)
178 gzipWithT f x y = case gmapAccumT perkid funs y of
180 _ -> error "gzipWithT"
182 perkid a d = (tail a, unGenericT' (head a) d)
183 funs = gmapQ (\k -> GenericT' (f k)) x
187 -- | Twin map for monadic transformation
188 gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
189 gzipWithM f x y = case gmapAccumM perkid funs y of
191 _ -> error "gzipWithM"
193 perkid a d = (tail a, unGenericM' (head a) d)
194 funs = gmapQ (\k -> GenericM' (f k)) x
197 -- | Twin map for monadic transformation
198 gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
199 gzipWithQ f x y = case gmapAccumQ perkid funs y of
201 _ -> error "gzipWithQ"
203 perkid a d = (tail a, unGenericQ' (head a) d)
204 funs = gmapQ (\k -> GenericQ' (f k)) x
208 ------------------------------------------------------------------------------
210 -- Typical twin traversals
212 ------------------------------------------------------------------------------
214 -- | Generic equality: an alternative to \"deriving Eq\"
215 geq :: Data a => a -> a -> Bool
219 Testing for equality of two terms goes like this. Firstly, we
220 establish the equality of the two top-level datatype
221 constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,
222 to compare the two lists of immediate subterms.
224 (Note for the experts: the type of the worker geq' is rather general
225 but precision is recovered via the restrictive type of the top-level
226 operation geq. The imprecision of geq' is caused by the type system's
227 unability to express the type equivalence for the corresponding
228 couples of immediate subterms from the two given input terms.)
234 geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
235 geq' x y = (toConstr x == toConstr y)
236 && and (gzipWithQ geq' x y)
239 -- | Generic zip controlled by a function with type-specific branches
240 gzip :: (forall a b. (Data a, Data b) => a -> b -> Maybe b)
241 -> (forall a b. (Data a, Data b) => a -> b -> Maybe b)
243 -- See testsuite/.../Generics/gzip.hs for an illustration
247 if toConstr x == toConstr y
248 then gzipWithM (gzip f) x y