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