Remove Control.Parallel*, now in package parallel
[packages/random.git] / 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 (local universal quantification)
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