4132aa204d3bb9e2e02394c6c3aa559720823bad
[packages/base.git] / Data / Generics.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Data.Generics
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, ralf@cwi.nl
8 -- Stability : experimental
9 -- Portability : non-portable
10 --
11 -- Generic programming in Haskell;
12 -- see <http://www.cs.vu.nl/boilerplate>.
13 --
14 -----------------------------------------------------------------------------
15
16 module Data.Generics (
17
18 -- The Typeable class and the type-safe cast operation;
19 -- re-exported for convenience
20 Typeable(..), cast,
21
22 -- * Prime types of generic functions
23 GenericT, GenericQ, GenericM, GenericB,
24
25 -- * Combinators to \"make\" generic functions
26 mkT, mkQ, mkM, mkF, mkB,
27 extT, extQ, extM, extF, extB,
28
29 -- * The Data class for folding and unfolding constructor applications
30 Data(
31 gfoldl,
32 gunfold,
33 conOf,
34 consOf
35 ),
36
37 -- * Typical generic maps defined in terms of gfoldl
38
39 gmapT,
40 gmapQ,
41 gmapM,
42 gmapF,
43
44 -- * The Constr datatype for describing datatype constructors
45 Constr(..),
46
47 -- * Frequently used generic traversal schemes
48 everywhere,
49 everywhere',
50 everywhereBut,
51 everywhereM,
52 somewhere,
53 everything,
54 listify,
55 something,
56 synthesize,
57
58 -- * Generic operations such as show, equality, read
59 glength,
60 gcount,
61 garity,
62 gundefineds,
63 gnodecount,
64 gtypecount,
65 gshow,
66 geq,
67 gzip,
68 gread,
69
70 -- * Miscellaneous further combinators
71 sameType, orElse, recoverF, recoverQ, choiceF, choiceQ
72
73 #ifndef __HADDOCK__
74 ,
75 -- Data types for the sum-of-products type encoding;
76 -- included for backwards compatibility; maybe obsolete
77 (:*:)(..), (:+:)(..), Unit(..)
78 #endif
79
80 ) where
81
82 ------------------------------------------------------------------------------
83
84 import Prelude -- So that 'make depend' works
85
86 #ifdef __GLASGOW_HASKELL__
87 #ifndef __HADDOCK__
88 import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) )
89 #endif
90 #endif
91
92 import Data.Maybe
93 import Data.Dynamic
94 import Control.Monad
95
96
97
98 ------------------------------------------------------------------------------
99 --
100 -- Prime types of generic functions
101 --
102 ------------------------------------------------------------------------------
103
104 -- | Generic transformations,
105 -- i.e., take an \"a\" and return an \"a\"
106 --
107 type GenericT = forall a. Data a => a -> a
108
109
110 -- | Generic queries of type "r",
111 -- i.e., take any \"a\" and return an \"r\"
112 --
113 type GenericQ r = forall a. Data a => a -> r
114
115
116 -- | Generic monadic transformations,
117 -- i.e., take an \"a\" and compute an \"a\"
118 --
119 type GenericM m = forall a. Data a => a -> m a
120
121
122 -- | Generic builders with input i,
123 -- i.e., take an \"i\" and compute a pair of type (a,i)
124 --
125 type GenericB m i = forall a. Data a => i -> m (a,i)
126
127
128
129 ------------------------------------------------------------------------------
130 --
131 -- Combinators to "make" generic functions
132 -- We use type-safe cast in a number of ways to make generic functions.
133 --
134 ------------------------------------------------------------------------------
135
136 -- | Make a generic transformation;
137 -- start from a type-specific case;
138 -- preserve the term otherwise
139 --
140 mkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a
141 mkT f = case cast f of
142 Just g -> g
143 Nothing -> id
144
145
146 -- | Make a generic query;
147 -- start from a type-specific case;
148 -- return a constant otherwise
149 --
150 mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
151 (r `mkQ` br) a = case cast a of
152 Just b -> br b
153 Nothing -> r
154
155
156 -- | Make a generic monadic transformation;
157 -- start from a type-specific case;
158 -- resort to return otherwise
159 --
160 mkM :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), Monad m)
161 => (b -> m b) -> a -> m a
162 mkM f = case cast f of
163 Just g -> g
164 Nothing -> return
165
166
167 {-
168
169 For the remaining definitions, we stick to a more concise style, i.e.,
170 we fold maybies with "maybe" instead of case ... of ..., and we also
171 use a point-free style whenever possible.
172
173 -}
174
175
176 -- | Make a generic monadic transformation for MonadPlus;
177 -- use "const mzero" (i.e., failure) instead of return as default.
178 --
179 mkF :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), MonadPlus m)
180 => (b -> m b) -> a -> m a
181 mkF = maybe (const mzero) id . cast
182
183
184 -- | Make a generic builder;
185 -- start from a type-specific ase;
186 -- resort to no build (i.e., mzero) otherwise
187 --
188 mkB :: (Typeable a, Typeable b,
189 Typeable i,
190 Typeable (m (a,i)), Typeable (m (b,i)),
191 MonadPlus m)
192 => (i -> m (b,i)) -> i -> m (a,i)
193 mkB = maybe (const mzero) id . cast
194
195
196 -- | Extend a generic transformation by a type-specific case
197 extT :: (Typeable a, Typeable b) => (a -> a) -> (b -> b) -> a -> a
198 extT f = maybe f id . cast
199
200
201 -- | Extend a generic query by a type-specific case
202 extQ :: (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q
203 extQ f g a = maybe (f a) g (cast a)
204
205
206 -- | Extend a generic monadic transformation by a type-specific case
207 extM :: (Typeable a, Typeable b,
208 Typeable (m a), Typeable (m b),
209 Monad m)
210 => (a -> m a) -> (b -> m b) -> a -> m a
211 extM f = maybe f id . cast
212
213
214 -- | Extend a generic MonadPlus transformation by a type-specific case
215 extF :: (Typeable a, Typeable b,
216 Typeable (m a), Typeable (m b),
217 MonadPlus m)
218 => (a -> m a) -> (b -> m b) -> a -> m a
219 extF = extM
220
221
222 -- | Extend a generic builder by a type-specific case
223 extB :: (Typeable a, Typeable b,
224 Typeable i,
225 Typeable (m (a,i)), Typeable (m (b,i)),
226 MonadPlus m)
227 => (i -> m (a,i)) -> (i -> m (b,i)) -> i -> m (a,i)
228 extB f = maybe f id . cast
229
230
231
232 ------------------------------------------------------------------------------
233 --
234 -- The Data class
235 --
236 ------------------------------------------------------------------------------
237
238 {-
239
240 The Data class comprehends two important primitives "gfoldl" and
241 "gunfold" for folding and unfolding constructor applications, say
242 terms. Besides, there are helpers "conOf" and "consOf" for retrieving
243 constructors from terms and types. Finally, typical ways of mapping
244 over immediate subterms are defined as "gmap" combinators in terms
245 of gfoldl. A generic programmer does not necessarily need to use
246 the ingenious gfoldl/gunfold couple but rather the "gmap" combinators.
247
248 -}
249
250 class Typeable a => Data a where
251
252 {-
253
254 Folding constructor applications ("gfoldl")
255
256 The combinator takes two arguments "f" and "z" to fold over a term
257 "x". The result type is parametric via a type constructor "c" in the
258 type of "gfoldl". The purpose of "z" is to define how the empty
259 constructor application is folded. So "z" is like the neutral / start
260 element for list folding. The purpose of "f" is to define how the
261 nonempty constructor application is folded. That is, "f" takes the
262 folded "tail" of the constructor application and its head, i.e., an
263 immediate subterm, and combines them in some way. See the Data
264 instances in this file which illustrate gfoldl. Conclusion: the type
265 of gfoldl is a headache, but operationally it is simple generalisation
266 of a list fold.
267
268 -}
269
270 -- | Left-associative fold operation for constructor applications
271 gfoldl :: (forall a b. Data a => c (a -> b) -> a -> c b)
272 -> (forall g. g -> c g)
273 -> a -> c a
274
275 {-
276
277 Unfolding constructor applications ("gunfold")
278
279 The combinator takes alike "gfoldl" two arguments "f" and "z", but
280 this time its about constructing (say, unfolding) constructor
281 applications rather than folding. The input for unfolding is primarily
282 an opaque representation of the desired constructor, which is
283 essentially a string representation of the constructor. (It is in the
284 responsibility of the programmer not to attempt unfolding invalid
285 constructors. This is like the side condition that a programmer must
286 not apply the "head" function to the empty list.) Besides the
287 constructor, we also have to provide the "input" for constructing
288 immediate subterms. This is anticipated via the type constructor "c"
289 in the type of "gunfold". For example, in the case of a generic read
290 function, "c" models string-processing functions. So "z" defines how
291 to construct the empty constructor application, and "f" takes an
292 incomplete constructor application to add more immediate subterm.
293 Conclusion: the type of gunfoldl and what it does is a headache, but
294 operationally it is a simple generalisation of the underappreciated
295 list unfold.
296
297 -}
298
299 -- | Unfold operation to build terms from constructors and others
300 gunfold :: (forall a b. Data a => c (a -> b) -> c b)
301 -> (forall g. g -> c g)
302 -> Constr
303 -> c a
304
305 -- Default definition for gfoldl
306 -- which copes immediately with basic datatypes
307 --
308 gfoldl _ z = z
309
310 -- | Obtain the constructor from a given term
311 conOf :: a -> Constr
312
313 -- | List all constructors for a given type
314 consOf :: a -> [Constr]
315
316
317
318 ------------------------------------------------------------------------------
319 --
320 -- Typical generic maps defined in terms of gfoldl
321 --
322 ------------------------------------------------------------------------------
323
324 {-
325
326 The combinators gmapT, gmapQ, gmapM, gmapF can all be defined in terms
327 of gfoldl. We provide corresponding default definitions leaving open
328 the opportunity to provide datatype-specific definitions if needed.
329
330 (Also, the inclusion of the gmap combinators as members of class Data
331 allows the programmer or the compiler to derive specialised, and maybe
332 more efficient code per datatype. Note: gfoldl is more higher-order
333 than the gmap combinators. This is subject to ongoing benchmarking
334 experiments.)
335
336 Conceptually, the definition of the gmap combinators in terms of the
337 primitive gfoldl requires the identification of the gfoldl function
338 arguments. Technically, we also need to identify the type constructor
339 c used all over the type of gfoldl.
340
341 -}
342
343 -- | A generic transformation that maps over the immediate subterms
344 gmapT :: (forall b. Data b => b -> b) -> a -> a
345
346 -- Use an identity datatype constructor ID (see below)
347 -- to instantiate the type constructor c in the type of gfoldl,
348 -- and perform injections ID and projections unID accordingly.
349 --
350 gmapT f x = unID (gfoldl k ID x)
351 where
352 k (ID c) x = ID (c (f x))
353
354
355 -- | A generic query that processes the immediate subterms and returns a list
356 gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
357
358 -- Use a phantom + function datatype constructor Q (see below),
359 -- to instantiate the type constructor c in the type of gfoldl,
360 -- and perform injections Q and projections unQ accordingly.
361 --
362 gmapQ f x = unQ (gfoldl k (const (Q id)) x) []
363 where
364 k (Q c) x = Q (\rs -> c (f x : rs))
365
366
367 -- | A generic monadic transformation that maps over the immediate subterms
368 gmapM :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
369
370 -- Use immediately the monad datatype constructor
371 -- to instantiate the type constructor c in the type of gfoldl,
372 -- so injection and projection is done by return and >>=.
373 --
374 gmapM f = gfoldl k return
375 where
376 k c x = do c' <- c
377 x' <- f x
378 return (c' x')
379
380
381 -- | Transformation of at least one immediate subterm does not fail
382 gmapF :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
383
384 -- Use a datatype constructor F (see below)
385 -- to instantiate the type constructor c in the type of gfoldl.
386 --
387 gmapF f x = unF (gfoldl k z x) >>= \(x',b) ->
388 if b then return x' else mzero
389 where
390 z g = F (return (g,False))
391 k (F c) x
392 = F ( c >>= \(h,b) ->
393 (f x >>= \x' -> return (h x',True))
394 `mplus` return (h x, b)
395 )
396
397
398 -- | The identity type constructor needed for the definition of gmapT
399 newtype ID x = ID { unID :: x }
400
401
402 -- | A phantom datatype constructor used in definition of gmapQ;
403 -- the function-typed component is needed to mediate between
404 -- left-associative constructor application vs. right-associative lists.
405 --
406 newtype Q r a = Q { unQ :: [r] -> [r] }
407
408
409 -- | A pairing type constructor needed for the definition of gmapF;
410 -- we keep track of the fact if a subterm was ever transformed successfully.
411 newtype F m x = F { unF :: m (x, Bool) }
412
413
414
415 ------------------------------------------------------------------------------
416 --
417 -- The Constr datatype for describing datatype constructors
418 -- To be extended by fixity, associativity, and maybe others.
419 --
420 ------------------------------------------------------------------------------
421
422 -- | Description of datatype constructors
423 data Constr = Constr { conString :: String } deriving (Eq, Typeable)
424
425
426 {-
427
428 It is interesting to observe that we can determine the arity of a
429 constructor without further meta-information. To this end, we use
430 gunfold to construct a term from a given constructor while leaving the
431 subterms undefined; see "gundefineds" below. Here we instantiate the
432 type constructor c of the gunfold type by the identity type
433 constructor ID. In a subsequent step we determine the number of
434 subterms by folding as captured in the generic operation "glength"
435 elsewhere in this module. Note that we need a type argument to specify
436 the intended type of the constructor.
437
438 -}
439
440
441 -- | Compute arity of a constructor against a type argument
442 garity :: Data a => (a -> ()) -> Constr -> Int
443 garity ta = glength . gundefineds ta
444
445
446 -- | Construct a term from a constructor with undefined subterms
447 gundefineds :: Data a => (a -> ()) -> Constr -> a
448 gundefineds (_::a -> ()) = (unID :: ID a -> a)
449 . gunfold ((\f -> ID (f undefined)) . unID) ID
450
451
452
453 ------------------------------------------------------------------------------
454 --
455 -- Frequently used generic traversal schemes
456 --
457 ------------------------------------------------------------------------------
458
459 -- | Apply a transformation everywhere in bottom-up manner
460 everywhere :: (forall a. Data a => a -> a)
461 -> (forall a. Data a => a -> a)
462
463 -- Use gmapT to recurse into immediate subterms;
464 -- recall: gmapT preserves the outermost constructor;
465 -- post-process recursively transformed result via f
466 --
467 everywhere f = f . gmapT (everywhere f)
468
469
470 -- | Apply a transformation everywhere in top-down manner
471 everywhere' :: (forall a. Data a => a -> a)
472 -> (forall a. Data a => a -> a)
473
474 -- Arguments of (.) are flipped compared to everywhere
475 everywhere' f = gmapT (everywhere' f) . f
476
477
478 -- | Variation on everywhere with an extra stop condition
479 everywhereBut :: GenericQ Bool -> GenericT -> GenericT
480
481 -- Guarded to let traversal cease if predicate q holds for x
482 everywhereBut q f x
483 | q x = x
484 | otherwise = f (gmapT (everywhereBut q f) x)
485
486
487 -- | Monadic variation on everywhere
488 everywhereM :: Monad m => GenericM m -> GenericM m
489
490 -- Bottom-up order is also reflected in order of do-actions
491 everywhereM f x = do x' <- gmapM (everywhereM f) x
492 f x'
493
494
495 -- | Apply a monadic transformation at least somewhere
496 somewhere :: MonadPlus m => GenericM m -> GenericM m
497
498 -- We try "f" in top-down manner, but descent into "x" when we fail
499 -- at the root of the term. The transformation fails if "f" fails
500 -- everywhere, say succeeds nowhere.
501 --
502 somewhere f x = f x `mplus` gmapF (somewhere f) x
503
504
505 -- | Summarise all nodes in top-down, left-to-right order
506 everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
507
508 -- Apply f to x to summarise top-level node;
509 -- use gmapQ to recurse into immediate subterms;
510 -- use ordinary foldl to reduce list of intermediate results
511 --
512 everything k f x
513 = foldl k (f x) (gmapQ (everything k f) x)
514
515
516 -- | Get a list of all entities that meet a predicate
517 listify :: Typeable r => (r -> Bool) -> GenericQ [r]
518 listify p
519 = everything (++) ([] `mkQ` (\x -> if p x then [x] else []))
520
521
522 -- | Look up a subterm by means of a maybe-typed filter
523 something :: GenericQ (Maybe u) -> GenericQ (Maybe u)
524
525 -- "something" can be defined in terms of "everything"
526 -- when a suitable "choice" operator is used for reduction
527 --
528 something = everything orElse
529
530
531 -- | Bottom-up synthesis of a data structure;
532 -- 1st argument z is the initial element for the synthesis;
533 -- 2nd argument o is for reduction of results from subterms;
534 -- 3rd argument f updates the sythesised data according to the given term
535 --
536 synthesize :: s -> (s -> s -> s) -> GenericQ (s -> s) -> GenericQ s
537 synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))
538
539
540
541 -----------------------------------------------------------------------------
542 --
543 -- "Twin" variations on gmapT, gmapQ. gmapM,
544 -- i.e., these combinators take two terms at the same time.
545 -- They are needed for multi-parameter traversal as generic equality.
546 -- They are not exported.
547 --
548 -----------------------------------------------------------------------------
549
550 {-
551
552 We need type constructors for twin traversal as we needed type
553 constructor for the ordinary gmap combinators. These type constructors
554 again serve for the instantiation of the type constructor c used in
555 the definition of gfoldl. The type constructors for twin traversal are
556 elaborations of the type constructors ID, Q and monads that were used
557 for the ordinary gmap combinators. More precisely, we use a pairing
558 technique to always attach an additional component to the results of
559 folding. This additional component carries the list of generic
560 functions to be used for the intermediate subterms encountered during
561 folding.
562
563 -}
564
565 newtype TT r a = TT { unTT :: (a,[GenericT']) }
566 newtype TQ r a = TQ { unTQ :: ([r]->[r],[GenericQ' r]) }
567 newtype TM m a = TM { unTM :: (m a,[GenericM' m]) }
568
569
570 -- First-class polymorphic versions of GenericT/GenericQ/GenericM;
571 -- they are referenced in TQ amd TM above
572 --
573 data GenericT' = T' { unT' :: forall a. Data a => a -> a }
574 data GenericQ' u = Q' { unQ' :: forall a. Data a => a -> u }
575 data Monad m => GenericM' m = M' { unM' :: forall a. Data a => a -> m a }
576
577
578 {-
579
580 A twin variation on gmapT, where the pattern "GenericQ GenericT"
581 expresses that the argument terms x and y are processed rather
582 independently. So firstly, x is "queried" with a generic
583 transformation as intermediate result, and secondly, this generic
584 transformation is applied to y.
585
586 -}
587
588 tmapT :: GenericQ GenericT -> GenericQ GenericT
589 tmapT g x y = fst (unTT (gfoldl k z y))
590 where
591 k (TT (f,l)) x = TT (f (unT' (head l) x),tail l)
592 z f = TT (f,gmapQ (\x -> T' (g x)) x)
593
594
595
596 -- A twin variation on gmapQ
597
598 tmapQ :: forall r.
599 (forall a b. (Data a, Data b) => a -> b -> r)
600 -> (forall a b. (Data a, Data b) => a -> b -> [r])
601
602 tmapQ g x y = fst (unTQ (gfoldl k z y)) []
603 where
604 k (TQ (c,l)) x = TQ (\rs -> c (unQ' (head l) x:rs), tail l)
605 z _ = TQ (id,gmapQ (\x -> Q' (g x)) x)
606
607
608 -- A twin variation on gmapM
609
610 tmapM :: forall m. Monad m
611 => (forall a b. (Data a, Data b) => a -> b -> m b)
612 -> (forall a b. (Data a, Data b) => a -> b -> m b)
613 tmapM g x y = fst (unTM (gfoldl k z y))
614 where
615 k (TM (f,l)) x = TM (f >>= \f' -> unM' (head l) x >>= return . f',tail l)
616 z f = TM (return f,gmapQ (\x -> M' (g x)) x)
617
618
619
620 ------------------------------------------------------------------------------
621 --
622 -- Generic operations such as show, equality, read
623 --
624 ------------------------------------------------------------------------------
625
626 -- | Count the number of immediate subterms of the given term
627 glength :: GenericQ Int
628 glength = length . gmapQ (const ())
629
630
631 -- | Determine the number of all suitable nodes in a given term
632 gcount :: GenericQ Bool -> GenericQ Int
633 gcount p = everything (+) (\x -> if p x then 1 else 0)
634
635
636 -- | Determine the number of all nodes in a given term
637 gnodecount :: GenericQ Int
638 gnodecount = gcount (const True)
639
640
641 -- | Determine the number of nodes of a given type in a given term
642 gtypecount :: Typeable a => (a -> ()) -> GenericQ Int
643 gtypecount f = gcount (False `mkQ` (const True . f))
644
645
646 -- | Generic show: an alternative to "deriving Show"
647 gshow :: Data a => a -> String
648
649 -- This is a prefix-show using surrounding "(" and ")",
650 -- where we recurse into subterms with gmapQ.
651 --
652 gshow = ( \t ->
653 "("
654 ++ conString (conOf t)
655 ++ concat (gmapQ ((++) " " . gshow) t)
656 ++ ")"
657 ) `extQ` (show :: String -> String)
658
659
660 -- | Generic equality: an alternative to "deriving Eq"
661 geq :: Data a => a -> a -> Bool
662
663 {-
664
665 Testing for equality of two terms goes like this. Firstly, we
666 establish the equality of the two top-level datatype
667 constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,
668 to compare the two lists of immediate subterms.
669
670 (Note for the experts: the type of the worker geq' is rather general
671 but precision is recovered via the restrictive type of the top-level
672 operation geq. The imprecision of geq' is caused by the type system's
673 unability to express the type equivalence for the corresponding
674 couples of immediate subterms from the two given input terms.)
675
676 -}
677
678 geq x y = geq' x y
679 where
680 geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
681 geq' x y = and ( (conString (conOf x) == conString (conOf y))
682 : tmapQ geq' x y
683 )
684
685
686 -- | Generic zip controlled by a function with type-specific branches
687 gzip :: (forall a b. (Data a, Data b) => a -> b -> Maybe b)
688 -> (forall a b. (Data a, Data b) => a -> b -> Maybe b)
689
690 -- See testsuite/.../Generics/gzip.hs for an illustration
691 gzip f x y =
692 f x y
693 `orElse`
694 if conString (conOf x) == conString (conOf y)
695 then tmapM (gzip f) x y
696 else Nothing
697
698
699 -- | The type constructor for gunfold a la ReadS from the Haskell 98 Prelude;
700 -- we don't use lists here for simplicity but only maybes.
701 newtype GRead i a = GRead (i -> Maybe (a, i))
702 unGRead (GRead x) = x
703
704
705 -- | Generic read: an alternative to "deriving Read"
706 gread :: GenericB Maybe String
707
708 {-
709
710 This is a read operation which insists on prefix notation. (The
711 Haskell 98 read deals with infix operators as well. We will be able to
712 deal with such special cases as well as sonn as we include fixity
713 information into the definition of "Constr".) We use gunfold to
714 "parse" the input. To be precise, gunfold is used for all result types
715 except String. The type-specific case for String uses basic String
716 read. Another source of customisation would be to properly deal with
717 infix operators subject to the capture of that information in the
718 definition of Constr. The "gread" combinator properly checks the
719 validity of constructors before invoking gunfold in order to rule
720 out run-time errors.
721
722 -}
723
724 gread = gdefault `extB` scase
725
726 where
727
728 -- a specific case for strings
729 scase s = case reads s of
730 [x::(String,String)] -> Just x
731 _ -> Nothing
732
733 -- the generic default of gread
734 gdefault s =
735 do s' <- return $ dropWhile ((==) ' ') s
736 guard (not (s' == ""))
737 guard (head s' == '(')
738 (c,s'') <- prefixConstr (dropWhile ((==) ' ') (tail s'))
739 u <- return undefined
740 guard (or [consOf u == [], c `elem` consOf u])
741 (a,s''') <- unGRead (gunfold f z c) s''
742 _ <- return $ constrainTypes a u
743 guard (not (s''' == ""))
744 guard (head s''' == ')')
745 return (a, tail s''')
746
747 -- To force two types to be the same
748 constrainTypes :: a -> a -> ()
749 constrainTypes _ _ = ()
750
751 -- Argument f for unfolding
752 f :: Data a => GRead String (a -> b) -> GRead String b
753 f x = GRead (\s -> do (r,s') <- unGRead x s
754 (t,s'') <- gread s'
755 return (r t,s''))
756
757 -- Argument z for unfolding
758 z :: forall g. g -> GRead String g
759 z g = GRead (\s -> return (g,s))
760
761 -- Get Constr at front of string
762 prefixConstr :: String -> Maybe (Constr, String)
763
764 -- Assume an infix operators in parantheses
765 prefixConstr ('(':s)
766 = case break ((==) ')') s of
767 (s'@(_:_),(')':s'')) -> Just (Constr ("(" ++ s' ++ ")"), s'')
768 _ -> Nothing
769
770 -- Special treatment of multiple token constructors
771 prefixConstr ('[':']':s) = Just (Constr "[]",s)
772
773 -- Try lex for ordinary constructor and basic datatypes
774 prefixConstr s
775 = case lex s of
776 [(s'@(_:_),s'')] -> Just (Constr s',s'')
777 _ -> Nothing
778
779
780
781 ------------------------------------------------------------------------------
782 --
783 -- Instances of the Data class
784 --
785 ------------------------------------------------------------------------------
786
787 -- Basic datatype Int; folding and unfolding is trivial
788 instance Data Int where
789 conOf x = Constr (show x)
790 consOf _ = []
791 gunfold f z c = z (read (conString c))
792
793 -- Another basic datatype instance
794 instance Data Integer where
795 conOf x = Constr (show x)
796 consOf _ = []
797 gunfold f z c = z (read (conString c))
798
799 -- Another basic datatype instance
800 instance Data Float where
801 conOf x = Constr (show x)
802 consOf _ = []
803 gunfold f z c = z (read (conString c))
804
805 -- Another basic datatype instance
806 instance Data Char where
807 conOf x = Constr (show x)
808 consOf _ = []
809 gunfold f z c = z (read (conString c))
810
811 {-
812
813 Commented out;
814 subject to inclusion of a missing Typeable instance
815
816 -- Another basic datatype instance
817 instance Data Rational where
818 conOf x = Constr (show x)
819 consOf _ = []
820 gunfold f z c = z (read (conString c))
821
822 -}
823
824 -- Bool as a kind of enumeration type
825 instance Data Bool where
826 conOf False = Constr "False"
827 conOf True = Constr "True"
828 consOf _ = [Constr "False",Constr "True"]
829 gunfold f z (Constr "False") = z False
830 gunfold f z (Constr "True") = z True
831
832 {-
833
834 We should better not fold over characters in a string for efficiency.
835 However, the following instance would clearly overlap with the
836 instance for polymorphic lists. Given the current scheme of allowing
837 overlapping instances, this would imply that ANY module that imports
838 Data.Generics would need to explicitly and generally allow overlapping
839 instances. This is prohibitive and calls for a more constrained model
840 of allowing overlapping instances. The present instance would also be
841 more sensible for UNFOLDING. In the definition of gread, we still
842 obtained the favoured behaviour by using a type-specific case for
843 String.
844
845 -- instance Data String where
846 conOf x = Constr (show x)
847 consOf _ = []
848 gunfold f z c = z (read (conString c))
849
850 -}
851
852 -- Cons-lists are terms with two immediate subterms. Hence, the gmap
853 -- combinators do NOT coincide with the list fold/map combinators.
854 --
855 instance Data a => Data [a] where
856 gmapT f [] = []
857 gmapT f (x:xs) = (f x:f xs)
858 gmapQ f [] = []
859 gmapQ f (x:xs) = [f x,f xs]
860 gmapM f [] = return []
861 gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
862 gfoldl f z [] = z []
863 gfoldl f z (x:xs) = z (:) `f` x `f` xs
864 conOf [] = Constr "[]"
865 conOf (_:_) = Constr "(:)"
866 consOf _ = [Constr "[]",Constr "(:)"]
867 gunfold f z (Constr "[]") = z []
868 gunfold f z (Constr "(:)") = f (f (z (:)))
869
870 -- Yet enother polymorphic datatype constructor
871 instance Data a => Data (Maybe a) where
872 gfoldl f z Nothing = z Nothing
873 gfoldl f z (Just x) = z Just `f` x
874 conOf Nothing = Constr "Nothing"
875 conOf (Just _) = Constr "Just"
876 consOf _ = [Constr "Nothing", Constr "Just"]
877 gunfold f z c | conString c == "Nothing" = z Nothing
878 gunfold f z c | conString c == "Just" = f (z Just)
879
880 -- Yet enother polymorphic datatype constructor
881 instance (Data a, Data b) => Data (a,b) where
882 gfoldl f z (a,b) = z (,) `f` a `f` b
883 conOf _ = Constr "(,)"
884 consOf _ = [Constr "(,)"]
885 gunfold f z c | conString c == "(,)" = f (f (z (,)))
886
887 -- Functions are treated as "non-compound" data regarding folding while
888 -- unfolding is out of reach, maybe not anymore with Template Haskell.
889 --
890 instance (Typeable a, Typeable b) => Data (a -> b) where
891 conOf _ = Constr "->"
892 consOf _ = [Constr "->"]
893 gunfold _ _ _ = undefined
894
895
896
897 ------------------------------------------------------------------------------
898 --
899 -- Miscellaneous
900 --
901 ------------------------------------------------------------------------------
902
903 -- | Test for two objects to agree on the type
904 sameType :: (Typeable a, Typeable b) => a -> b -> Bool
905 sameType (_::a) = maybe False (\(_::a) -> True) . cast
906
907
908 -- | Left-biased choice on maybes (non-strict in right argument)
909 orElse :: Maybe a -> Maybe a -> Maybe a
910 x `orElse` y = maybe y Just x
911
912
913 -- Another definition of orElse
914 -- where the folding over maybies as defined by maybe is inlined
915 -- to ease readability
916 --
917 x `orElse'` y = case x of
918 Just _ -> x
919 Nothing -> y
920
921
922 {-
923
924 The following variations take "orElse" to the function
925 level. Furthermore, we generalise from "Maybe" to any
926 "MonadPlus". This makes sense for monadic transformations and
927 queries. We say that the resulting combinators modell choice. We also
928 provide a prime example of choice, that is, recovery from failure. In
929 the case of transformations, we recover via return whereas for
930 queries a given constant is returned.
931
932 -}
933
934 -- | Choice for monadic transformations
935 choiceF :: MonadPlus m => GenericM m -> GenericM m -> GenericM m
936 choiceF f g x = f x `mplus` g x
937
938
939 -- | Choice for monadic queries
940 choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r)
941 choiceQ f g x = f x `mplus` g x
942
943
944 -- | Recover from the failure of monadic transformation by identity
945 recoverF :: MonadPlus m => GenericM m -> GenericM m
946 recoverF f = f `choiceF` return
947
948
949 -- | Recover from the failure of monadic query by a constant
950 recoverQ :: MonadPlus m => r -> GenericQ (m r) -> GenericQ (m r)
951 recoverQ r f = f `choiceQ` const (return r)