1{-# LANGUAGE RankNTypes, CPP #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  Data.Generics.Aliases
5-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
6-- License     :  BSD-style (see the LICENSE file)
7--
8-- Maintainer  :  generics@haskell.org
9-- Stability   :  experimental
10-- Portability :  non-portable (local universal quantification)
11--
12-- \"Scrap your boilerplate\" --- Generic programming in Haskell
13-- See <http://www.cs.uu.nl/wiki/GenericProgramming/SYB>.
14-- The present module provides a number of declarations for typical generic
15-- function types, corresponding type case, and others.
16--
17-----------------------------------------------------------------------------
18
19module Data.Generics.Aliases (
20
21        -- * Combinators to \"make\" generic functions via cast
22        mkT, mkQ, mkM, mkMp, mkR,
23        ext0, extT, extQ, extM, extMp, extB, extR,
24
25        -- * Type synonyms for generic function types
26        GenericT,
27        GenericQ,
28        GenericM,
29        GenericB,
30        GenericR,
31        Generic,
32        Generic'(..),
33        GenericT'(..),
34        GenericQ'(..),
35        GenericM'(..),
36
37        -- * Ingredients of generic functions
38        orElse,
39
40        -- * Function combinators on generic functions
41        recoverMp,
42        recoverQ,
43        choiceMp,
44        choiceQ,
45
46        -- * Type extension for unary type constructors
47        ext1,
48        ext1T,
49        ext1M,
50        ext1Q,
51        ext1R,
52        ext1B,
53
54        -- * Type extension for binary type constructors
55        ext2T,
56        ext2M,
57        ext2Q,
58        ext2R,
59        ext2B
60
61  ) where
62
63#ifdef __HADDOCK__
64import Prelude
65#endif
66import Control.Monad
67import Data.Data
68
69------------------------------------------------------------------------------
70--
71--      Combinators to "make" generic functions
72--      We use type-safe cast in a number of ways to make generic functions.
73--
74------------------------------------------------------------------------------
75
76-- | Make a generic transformation;
77--   start from a type-specific case;
78--   preserve the term otherwise
79--
80mkT :: ( Typeable a
81       , Typeable b
82       )
83    => (b -> b)
84    -> a
85    -> a
86mkT = extT id
87
88
89-- | Make a generic query;
90--   start from a type-specific case;
91--   return a constant otherwise
92--
93mkQ :: ( Typeable a
94       , Typeable b
95       )
96    => r
97    -> (b -> r)
98    -> a
99    -> r
100(r `mkQ` br) a = case cast a of
101                        Just b  -> br b
102                        Nothing -> r
103
104
105-- | Make a generic monadic transformation;
106--   start from a type-specific case;
107--   resort to return otherwise
108--
109mkM :: ( Monad m
110       , Typeable a
111       , Typeable b
112       )
113    => (b -> m b)
114    -> a
115    -> m a
116mkM = extM return
117
118
119{-
120
121For the remaining definitions, we stick to a more concise style, i.e.,
122we fold maybes with "maybe" instead of case ... of ..., and we also
123use a point-free style whenever possible.
124
125-}
126
127
128-- | Make a generic monadic transformation for MonadPlus;
129--   use \"const mzero\" (i.e., failure) instead of return as default.
130--
131mkMp :: ( MonadPlus m
132        , Typeable a
133        , Typeable b
134        )
135     => (b -> m b)
136     -> a
137     -> m a
138mkMp = extM (const mzero)
139
140
141-- | Make a generic builder;
142--   start from a type-specific ase;
143--   resort to no build (i.e., mzero) otherwise
144--
145mkR :: ( MonadPlus m
146       , Typeable a
147       , Typeable b
148       )
149    => m b -> m a
150mkR f = mzero `extR` f
151
152
153-- | Flexible type extension
154ext0 :: (Typeable a, Typeable b) => c a -> c b -> c a
155ext0 def ext = maybe def id (gcast ext)
156
157
158-- | Extend a generic transformation by a type-specific case
159extT :: ( Typeable a
160        , Typeable b
161        )
162     => (a -> a)
163     -> (b -> b)
164     -> a
165     -> a
166extT def ext = unT ((T def) `ext0` (T ext))
167
168
169-- | Extend a generic query by a type-specific case
170extQ :: ( Typeable a
171        , Typeable b
172        )
173     => (a -> q)
174     -> (b -> q)
175     -> a
176     -> q
177extQ f g a = maybe (f a) g (cast a)
178
179
180-- | Extend a generic monadic transformation by a type-specific case
181extM :: ( Monad m
182        , Typeable a
183        , Typeable b
184        )
185     => (a -> m a) -> (b -> m b) -> a -> m a
186extM def ext = unM ((M def) `ext0` (M ext))
187
188
189-- | Extend a generic MonadPlus transformation by a type-specific case
190extMp :: ( MonadPlus m
191         , Typeable a
192         , Typeable b
193         )
194      => (a -> m a) -> (b -> m b) -> a -> m a
195extMp = extM
196
197
198-- | Extend a generic builder
199extB :: ( Typeable a
200        , Typeable b
201        )
202     => a -> b -> a
203extB a = maybe a id . cast
204
205
206-- | Extend a generic reader
207extR :: ( Monad m
208        , Typeable a
209        , Typeable b
210        )
211     => m a -> m b -> m a
212extR def ext = unR ((R def) `ext0` (R ext))
213
214
215
216------------------------------------------------------------------------------
217--
218--      Type synonyms for generic function types
219--
220------------------------------------------------------------------------------
221
222
223-- | Generic transformations,
224--   i.e., take an \"a\" and return an \"a\"
225--
226type GenericT = forall a. Data a => a -> a
227
228
229-- | Generic queries of type \"r\",
230--   i.e., take any \"a\" and return an \"r\"
231--
232type GenericQ r = forall a. Data a => a -> r
233
234
235-- | Generic monadic transformations,
236--   i.e., take an \"a\" and compute an \"a\"
237--
238type GenericM m = forall a. Data a => a -> m a
239
240
241-- | Generic builders
242--   i.e., produce an \"a\".
243--
244type GenericB = forall a. Data a => a
245
246
247-- | Generic readers, say monadic builders,
248--   i.e., produce an \"a\" with the help of a monad \"m\".
249--
250type GenericR m = forall a. Data a => m a
251
252
253-- | The general scheme underlying generic functions
254--   assumed by gfoldl; there are isomorphisms such as
255--   GenericT = Generic T.
256--
257type Generic c = forall a. Data a => a -> c a
258
259
260-- | Wrapped generic functions;
261--   recall: [Generic c] would be legal but [Generic' c] not.
262--
263data Generic' c = Generic' { unGeneric' :: Generic c }
264
265
266-- | Other first-class polymorphic wrappers
267newtype GenericT'   = GT { unGT :: forall a. Data a => a -> a }
268newtype GenericQ' r = GQ { unGQ :: GenericQ r }
269newtype GenericM' m = GM { unGM :: forall a. Data a => a -> m a }
270
271
272-- | Left-biased choice on maybes
273orElse :: Maybe a -> Maybe a -> Maybe a
274x `orElse` y = case x of
275                 Just _  -> x
276                 Nothing -> y
277
278
279{-
280
281The following variations take "orElse" to the function
282level. Furthermore, we generalise from "Maybe" to any
283"MonadPlus". This makes sense for monadic transformations and
284queries. We say that the resulting combinators modell choice. We also
285provide a prime example of choice, that is, recovery from failure. In
286the case of transformations, we recover via return whereas for
287queries a given constant is returned.
288
289-}
290
291-- | Choice for monadic transformations
292choiceMp :: MonadPlus m => GenericM m -> GenericM m -> GenericM m
293choiceMp f g x = f x `mplus` g x
294
295
296-- | Choice for monadic queries
297choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r)
298choiceQ f g x = f x `mplus` g x
299
300
301-- | Recover from the failure of monadic transformation by identity
302recoverMp :: MonadPlus m => GenericM m -> GenericM m
303recoverMp f = f `choiceMp` return
304
305
306-- | Recover from the failure of monadic query by a constant
307recoverQ :: MonadPlus m => r -> GenericQ (m r) -> GenericQ (m r)
308recoverQ r f = f `choiceQ` const (return r)
309
310
311
312------------------------------------------------------------------------------
313--      Type extension for unary type constructors
314------------------------------------------------------------------------------
315
316#if __GLASGOW_HASKELL__ >= 707
317#define Typeable1 Typeable
318#define Typeable2 Typeable
319#endif
320
321-- | Flexible type extension
322ext1 :: (Data a, Typeable1 t)
323     => c a
324     -> (forall d. Data d => c (t d))
325     -> c a
326ext1 def ext = maybe def id (dataCast1 ext)
327
328
329-- | Type extension of transformations for unary type constructors
330ext1T :: (Data d, Typeable1 t)
331      => (forall e. Data e => e -> e)
332      -> (forall f. Data f => t f -> t f)
333      -> d -> d
334ext1T def ext = unT ((T def) `ext1` (T ext))
335
336
337-- | Type extension of monadic transformations for type constructors
338ext1M :: (Monad m, Data d, Typeable1 t)
339      => (forall e. Data e => e -> m e)
340      -> (forall f. Data f => t f -> m (t f))
341      -> d -> m d
342ext1M def ext = unM ((M def) `ext1` (M ext))
343
344
345-- | Type extension of queries for type constructors
346ext1Q :: (Data d, Typeable1 t)
347      => (d -> q)
348      -> (forall e. Data e => t e -> q)
349      -> d -> q
350ext1Q def ext = unQ ((Q def) `ext1` (Q ext))
351
352
353-- | Type extension of readers for type constructors
354ext1R :: (Monad m, Data d, Typeable1 t)
355      => m d
356      -> (forall e. Data e => m (t e))
357      -> m d
358ext1R def ext = unR ((R def) `ext1` (R ext))
359
360
361-- | Type extension of builders for type constructors
362ext1B :: (Data a, Typeable1 t)
363      => a
364      -> (forall b. Data b => (t b))
365      -> a
366ext1B def ext = unB ((B def) `ext1` (B ext))
367
368------------------------------------------------------------------------------
369--      Type extension for binary type constructors
370------------------------------------------------------------------------------
371
372-- | Flexible type extension
373ext2 :: (Data a, Typeable2 t)
374     => c a
375     -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))
376     -> c a
377ext2 def ext = maybe def id (dataCast2 ext)
378
379
380-- | Type extension of transformations for unary type constructors
381ext2T :: (Data d, Typeable2 t)
382      => (forall e. Data e => e -> e)
383      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> t d1 d2)
384      -> d -> d
385ext2T def ext = unT ((T def) `ext2` (T ext))
386
387
388-- | Type extension of monadic transformations for type constructors
389ext2M :: (Monad m, Data d, Typeable2 t)
390      => (forall e. Data e => e -> m e)
391      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> m (t d1 d2))
392      -> d -> m d
393ext2M def ext = unM ((M def) `ext2` (M ext))
394
395
396-- | Type extension of queries for type constructors
397ext2Q :: (Data d, Typeable2 t)
398      => (d -> q)
399      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)
400      -> d -> q
401ext2Q def ext = unQ ((Q def) `ext2` (Q ext))
402
403
404-- | Type extension of readers for type constructors
405ext2R :: (Monad m, Data d, Typeable2 t)
406      => m d
407      -> (forall d1 d2. (Data d1, Data d2) => m (t d1 d2))
408      -> m d
409ext2R def ext = unR ((R def) `ext2` (R ext))
410
411
412-- | Type extension of builders for type constructors
413ext2B :: (Data a, Typeable2 t)
414      => a
415      -> (forall d1 d2. (Data d1, Data d2) => (t d1 d2))
416      -> a
417ext2B def ext = unB ((B def) `ext2` (B ext))
418
419------------------------------------------------------------------------------
420--
421--      Type constructors for type-level lambdas
422--
423------------------------------------------------------------------------------
424
425
426-- | The type constructor for transformations
427newtype T x = T { unT :: x -> x }
428
429-- | The type constructor for transformations
430newtype M m x = M { unM :: x -> m x }
431
432-- | The type constructor for queries
433newtype Q q x = Q { unQ :: x -> q }
434
435-- | The type constructor for readers
436newtype R m x = R { unR :: m x }
437
438-- | The type constructor for builders
439newtype B x = B {unB :: x}
440