--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
--- Portability : non-portable
+-- Portability : non-portable (local universal quantification)
--
-- \"Scrap your boilerplate\" --- Generic programming in Haskell
--- See <http://www.cs.vu.nl/boilerplate/>.
+-- See <http://www.cs.vu.nl/boilerplate/>. The present module provides
+-- frequently used generic traversal schemes.
--
-----------------------------------------------------------------------------
-module Data.Generics.Schemes (
+module Data.Generics.Schemes (
- -- * Frequently used generic traversal schemes
everywhere,
everywhere',
everywhereBut,
everywhereM,
somewhere,
- everything,
- listify,
+ everything,
+ listify,
something,
- synthesize,
+ synthesize,
+ gsize,
+ glength,
+ gdepth,
+ gcount,
+ gnodecount,
+ gtypecount,
+ gfindtype
) where
------------------------------------------------------------------------------
+#ifdef __HADDOCK__
+import Prelude
+#endif
import Data.Generics.Basics
import Data.Generics.Aliases
import Control.Monad
-
-- | Apply a transformation everywhere in bottom-up manner
everywhere :: (forall a. Data a => a -> a)
-> (forall a. Data a => a -> a)
-- use gmapQ to recurse into immediate subterms;
-- use ordinary foldl to reduce list of intermediate results
--
-everything k f x
+everything k f x
= foldl k (f x) (gmapQ (everything k f) x)
-- | Bottom-up synthesis of a data structure;
-- 1st argument z is the initial element for the synthesis;
-- 2nd argument o is for reduction of results from subterms;
--- 3rd argument f updates the sythesised data according to the given term
+-- 3rd argument f updates the synthesised data according to the given term
--
-synthesize :: s -> (s -> s -> s) -> GenericQ (s -> s) -> GenericQ s
+synthesize :: s -> (t -> s -> s) -> GenericQ (s -> t) -> GenericQ t
synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))
+
+
+-- | Compute size of an arbitrary data structure
+gsize :: Data a => a -> Int
+gsize t = 1 + sum (gmapQ gsize t)
+
+
+-- | Count the number of immediate subterms of the given term
+glength :: GenericQ Int
+glength = length . gmapQ (const ())
+
+
+-- | Determine depth of the given term
+gdepth :: GenericQ Int
+gdepth = (+) 1 . foldr max 0 . gmapQ gdepth
+
+
+-- | Determine the number of all suitable nodes in a given term
+gcount :: GenericQ Bool -> GenericQ Int
+gcount p = everything (+) (\x -> if p x then 1 else 0)
+
+
+-- | Determine the number of all nodes in a given term
+gnodecount :: GenericQ Int
+gnodecount = gcount (const True)
+
+
+-- | Determine the number of nodes of a given type in a given term
+gtypecount :: Typeable a => a -> GenericQ Int
+gtypecount (_::a) = gcount (False `mkQ` (\(_::a) -> True))
+
+
+-- | Find (unambiguously) an immediate subterm of a given type
+gfindtype :: (Data x, Typeable y) => x -> Maybe y
+gfindtype = singleton
+ . foldl unJust []
+ . gmapQ (Nothing `mkQ` Just)
+ where
+ unJust l (Just x) = x:l
+ unJust l Nothing = l
+ singleton [s] = Just s
+ singleton _ = Nothing