Data/Generics/Schemes.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Generics.Schemes
   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 provides
  13 -- frequently used generic traversal schemes.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Data.Generics.Schemes (
  18
  19         everywhere,
  20         everywhere',
  21         everywhereBut,
  22         everywhereM,
  23         somewhere,
  24         everything,
  25         listify,
  26         something,
  27         synthesize,
  28
  29  ) where
  30
  31 ------------------------------------------------------------------------------
  32
  33 #ifdef __HADDOCK__
  34 import Prelude
  35 #endif
  36 import Data.Generics.Basics
  37 import Data.Generics.Aliases
  38 import Control.Monad
  39
  40
  41 -- | Apply a transformation everywhere in bottom-up manner
  42 everywhere :: (forall a. Data a => a -> a)
  43            -> (forall a. Data a => a -> a)
  44
  45 -- Use gmapT to recurse into immediate subterms;
  46 -- recall: gmapT preserves the outermost constructor;
  47 -- post-process recursively transformed result via f
  48 --
  49 everywhere f = f . gmapT (everywhere f)
  50
  51
  52 -- | Apply a transformation everywhere in top-down manner
  53 everywhere' :: (forall a. Data a => a -> a)
  54             -> (forall a. Data a => a -> a)
  55
  56 -- Arguments of (.) are flipped compared to everywhere
  57 everywhere' f = gmapT (everywhere' f) . f
  58
  59
  60 -- | Variation on everywhere with an extra stop condition
  61 everywhereBut :: GenericQ Bool -> GenericT -> GenericT
  62
  63 -- Guarded to let traversal cease if predicate q holds for x
  64 everywhereBut q f x
  65     | q x       = x
  66     | otherwise = f (gmapT (everywhereBut q f) x)
  67
  68
  69 -- | Monadic variation on everywhere
  70 everywhereM :: Monad m => GenericM m -> GenericM m
  71
  72 -- Bottom-up order is also reflected in order of do-actions
  73 everywhereM f x = do x' <- gmapM (everywhereM f) x
  74                      f x'
  75
  76
  77 -- | Apply a monadic transformation at least somewhere
  78 somewhere :: MonadPlus m => GenericM m -> GenericM m
  79
  80 -- We try "f" in top-down manner, but descent into "x" when we fail
  81 -- at the root of the term. The transformation fails if "f" fails
  82 -- everywhere, say succeeds nowhere.
  83 --
  84 somewhere f x = f x `mplus` gmapMp (somewhere f) x
  85
  86
  87 -- | Summarise all nodes in top-down, left-to-right order
  88 everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
  89
  90 -- Apply f to x to summarise top-level node;
  91 -- use gmapQ to recurse into immediate subterms;
  92 -- use ordinary foldl to reduce list of intermediate results
  93 --
  94 everything k f x
  95   = foldl k (f x) (gmapQ (everything k f) x)
  96
  97
  98 -- | Get a list of all entities that meet a predicate
  99 listify :: Typeable r => (r -> Bool) -> GenericQ [r]
 100 listify p
 101   = everything (++) ([] `mkQ` (\x -> if p x then [x] else []))
 102
 103
 104 -- | Look up a subterm by means of a maybe-typed filter
 105 something :: GenericQ (Maybe u) -> GenericQ (Maybe u)
 106
 107 -- "something" can be defined in terms of "everything"
 108 -- when a suitable "choice" operator is used for reduction
 109 --
 110 something = everything orElse
 111
 112
 113 -- | Bottom-up synthesis of a data structure;
 114 --   1st argument z is the initial element for the synthesis;
 115 --   2nd argument o is for reduction of results from subterms;
 116 --   3rd argument f updates the sythesised data according to the given term
 117 --
 118 synthesize :: s  -> (s -> s -> s) -> GenericQ (s -> s) -> GenericQ s
 119 synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))