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         gsize,
  29         glength,
  30         gdepth,
  31         gcount,
  32         gnodecount,
  33         gtypecount,
  34         gfindtype
  35
  36  ) where
  37
  38 ------------------------------------------------------------------------------
  39
  40 #ifdef __HADDOCK__
  41 import Prelude
  42 #endif
  43 import Data.Generics.Basics
  44 import Data.Generics.Aliases
  45 import Control.Monad
  46
  47
  48 -- | Apply a transformation everywhere in bottom-up manner
  49 everywhere :: (forall a. Data a => a -> a)
  50            -> (forall a. Data a => a -> a)
  51
  52 -- Use gmapT to recurse into immediate subterms;
  53 -- recall: gmapT preserves the outermost constructor;
  54 -- post-process recursively transformed result via f
  55 --
  56 everywhere f = f . gmapT (everywhere f)
  57
  58
  59 -- | Apply a transformation everywhere in top-down manner
  60 everywhere' :: (forall a. Data a => a -> a)
  61             -> (forall a. Data a => a -> a)
  62
  63 -- Arguments of (.) are flipped compared to everywhere
  64 everywhere' f = gmapT (everywhere' f) . f
  65
  66
  67 -- | Variation on everywhere with an extra stop condition
  68 everywhereBut :: GenericQ Bool -> GenericT -> GenericT
  69
  70 -- Guarded to let traversal cease if predicate q holds for x
  71 everywhereBut q f x
  72     | q x       = x
  73     | otherwise = f (gmapT (everywhereBut q f) x)
  74
  75
  76 -- | Monadic variation on everywhere
  77 everywhereM :: Monad m => GenericM m -> GenericM m
  78
  79 -- Bottom-up order is also reflected in order of do-actions
  80 everywhereM f x = do x' <- gmapM (everywhereM f) x
  81                      f x'
  82
  83
  84 -- | Apply a monadic transformation at least somewhere
  85 somewhere :: MonadPlus m => GenericM m -> GenericM m
  86
  87 -- We try "f" in top-down manner, but descent into "x" when we fail
  88 -- at the root of the term. The transformation fails if "f" fails
  89 -- everywhere, say succeeds nowhere.
  90 --
  91 somewhere f x = f x `mplus` gmapMp (somewhere f) x
  92
  93
  94 -- | Summarise all nodes in top-down, left-to-right order
  95 everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
  96
  97 -- Apply f to x to summarise top-level node;
  98 -- use gmapQ to recurse into immediate subterms;
  99 -- use ordinary foldl to reduce list of intermediate results
 100 --
 101 everything k f x
 102   = foldl k (f x) (gmapQ (everything k f) x)
 103
 104
 105 -- | Get a list of all entities that meet a predicate
 106 listify :: Typeable r => (r -> Bool) -> GenericQ [r]
 107 listify p
 108   = everything (++) ([] `mkQ` (\x -> if p x then [x] else []))
 109
 110
 111 -- | Look up a subterm by means of a maybe-typed filter
 112 something :: GenericQ (Maybe u) -> GenericQ (Maybe u)
 113
 114 -- "something" can be defined in terms of "everything"
 115 -- when a suitable "choice" operator is used for reduction
 116 --
 117 something = everything orElse
 118
 119
 120 -- | Bottom-up synthesis of a data structure;
 121 --   1st argument z is the initial element for the synthesis;
 122 --   2nd argument o is for reduction of results from subterms;
 123 --   3rd argument f updates the synthesised data according to the given term
 124 --
 125 synthesize :: s  -> (s -> s -> s) -> GenericQ (s -> s) -> GenericQ s
 126 synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))
 127
 128
 129 -- | Compute size of an arbitrary data structure
 130 gsize :: Data a => a -> Int
 131 gsize t = 1 + sum (gmapQ gsize t)
 132
 133
 134 -- | Count the number of immediate subterms of the given term
 135 glength :: GenericQ Int
 136 glength = length . gmapQ (const ())
 137
 138
 139 -- | Determine depth of the given term
 140 gdepth :: GenericQ Int
 141 gdepth = (+) 1 . foldr max 0 . gmapQ gdepth
 142
 143
 144 -- | Determine the number of all suitable nodes in a given term
 145 gcount :: GenericQ Bool -> GenericQ Int
 146 gcount p =  everything (+) (\x -> if p x then 1 else 0)
 147
 148
 149 -- | Determine the number of all nodes in a given term
 150 gnodecount :: GenericQ Int
 151 gnodecount = gcount (const True)
 152
 153
 154 -- | Determine the number of nodes of a given type in a given term
 155 gtypecount :: Typeable a => a -> GenericQ Int
 156 gtypecount (_::a) = gcount (False `mkQ` (\(_::a) -> True))
 157
 158
 159 -- | Find (unambiguously) an immediate subterm of a given type
 160 gfindtype :: (Data x, Typeable y) => x -> Maybe y
 161 gfindtype = singleton
 162           . foldl unJust []
 163           . gmapQ (Nothing `mkQ` Just)
 164  where
 165   unJust l (Just x) = x:l
 166   unJust l Nothing  = l
 167   singleton [s] = Just s
 168   singleton _   = Nothing