-----------------------------------------------------------------------------
-- |
-- Module : Data.Generics
--- Copyright : (c) The University of Glasgow 2001
+-- Copyright : (c) The University of Glasgow, CWI 2001--2003
-- License : BSD-style (see the file libraries/base/LICENSE)
--
--- Maintainer : libraries@haskell.org
+-- Maintainer : libraries@haskell.org, ralf@cwi.nl
-- Stability : experimental
-- Portability : non-portable
--
--- Data types for generic definitions.
+-- Generic programming in Haskell;
+-- see <http://www.cs.vu.nl/boilerplate/>.
--
-----------------------------------------------------------------------------
module Data.Generics (
- -- * Data types for the sum-of-products type encoding
- (:*:)(..), (:+:)(..), Unit(..),
-
- -- * Typeable and types-save cast
- Typeable(..), cast, sameType,
-
- -- * The Data class and related types
- Data( gmapT, gmapQ, gmapM,
- gfoldl, gfoldr, gunfold,
- conOf, consOf ),
- Constr(..),
-
- -- * Transformations (T), queries (Q), monadic transformations (Q),
- -- and twin transformations (TT)
- GenericT, GenericQ, GenericM,
- mkT, mkQ, mkM,
- extT, extQ, extM,
- mkTT,
-
-
- -- * Traversal combinators
- everything, something, everywhere, everywhereBut,
- synthesize, branches, undefineds,
-
- -- * Generic operations: equality, zip, read, show
- geq, gzip, gshow, gread,
-
- -- * Miscellaneous
- match, tick, count, alike
+ -- The Typeable class and the type-safe cast operation;
+ -- re-exported for convenience
+ Typeable(..), cast,
+
+ -- * Prime types of generic functions
+ GenericT, GenericQ, GenericM, GenericB,
+
+ -- * Combinators to \"make\" generic functions
+ mkT, mkQ, mkM, mkF, mkB,
+ extT, extQ, extM, extF, extB,
+
+ -- * The Data class for folding and unfolding constructor applications
+ Data(
+ gfoldl,
+ gunfold,
+ conOf,
+ consOf
+ ),
+
+ -- * Typical generic maps defined in terms of gfoldl
+
+ gmapT,
+ gmapQ,
+ gmapM,
+ gmapF,
+
+ -- * The Constr datatype for describing datatype constructors
+ Constr(..),
+
+ -- * Frequently used generic traversal schemes
+ everywhere,
+ everywhere',
+ everywhereBut,
+ everywhereM,
+ somewhere,
+ everything,
+ listify,
+ something,
+ synthesize,
+
+ -- * Generic operations such as show, equality, read
+ glength,
+ gcount,
+ garity,
+ gundefineds,
+ gnodecount,
+ gtypecount,
+ gshow,
+ geq,
+ gzip,
+ gread,
+
+ -- * Miscellaneous further combinators
+ sameType, orElse, recoverF, recoverQ, choiceF, choiceQ
+
+#ifndef __HADDOCK__
+ ,
+ -- Data types for the sum-of-products type encoding;
+ -- included for backwards compatibility; maybe obsolete
+ (:*:)(..), (:+:)(..), Unit(..)
+#endif
) where
+------------------------------------------------------------------------------
+
import Prelude -- So that 'make depend' works
#ifdef __GLASGOW_HASKELL__
+#ifndef __HADDOCK__
import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) )
#endif
+#endif
+import Data.Maybe
import Data.Dynamic
import Control.Monad
----------------------------------------------
+------------------------------------------------------------------------------
+--
+-- Prime types of generic functions
+--
+------------------------------------------------------------------------------
+
+-- | Generic transformations,
+-- i.e., take an \"a\" and return an \"a\"
+--
+type GenericT = forall a. Data a => a -> a
+
+
+-- | Generic queries of type \"r\",
+-- i.e., take any \"a\" and return an \"r\"
+--
+type GenericQ r = forall a. Data a => a -> r
+
+
+-- | Generic monadic transformations,
+-- i.e., take an \"a\" and compute an \"a\"
+--
+type GenericM m = forall a. Data a => a -> m a
+
+
+-- | Generic builders with input i,
+-- i.e., take an \"i\" and compute a pair of type (a,i)
+--
+type GenericB m i = forall a. Data a => i -> m (a,i)
+
+
+
+------------------------------------------------------------------------------
--
--- Operations involving Typeable only
+-- Combinators to "make" generic functions
+-- We use type-safe cast in a number of ways to make generic functions.
--
----------------------------------------------
+------------------------------------------------------------------------------
--- | Apply a function if appropriate or preserve term
+-- | Make a generic transformation;
+-- start from a type-specific case;
+-- preserve the term otherwise
+--
mkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT f = case cast f of
Just g -> g
Nothing -> id
--- | Apply a function if appropriate or return a constant
+
+-- | Make a generic query;
+-- start from a type-specific case;
+-- return a constant otherwise
+--
mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
(r `mkQ` br) a = case cast a of
Just b -> br b
Nothing -> r
-
--- | Apply a monadic transformation if appropriate; resort to return otherwise
+-- | Make a generic monadic transformation;
+-- start from a type-specific case;
+-- resort to return otherwise
+--
mkM :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), Monad m)
=> (b -> m b) -> a -> m a
mkM f = case cast f of
Just g -> g
Nothing -> return
--- | Extend a transformation
+
+{-
+
+For the remaining definitions, we stick to a more concise style, i.e.,
+we fold maybies with "maybe" instead of case ... of ..., and we also
+use a point-free style whenever possible.
+
+-}
+
+
+-- | Make a generic monadic transformation for MonadPlus;
+-- use \"const mzero\" (i.e., failure) instead of return as default.
+--
+mkF :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), MonadPlus m)
+ => (b -> m b) -> a -> m a
+mkF = maybe (const mzero) id . cast
+
+
+-- | Make a generic builder;
+-- start from a type-specific ase;
+-- resort to no build (i.e., mzero) otherwise
+--
+mkB :: (Typeable a, Typeable b,
+ Typeable i,
+ Typeable (m (a,i)), Typeable (m (b,i)),
+ MonadPlus m)
+ => (i -> m (b,i)) -> i -> m (a,i)
+mkB = maybe (const mzero) id . cast
+
+
+-- | Extend a generic transformation by a type-specific case
extT :: (Typeable a, Typeable b) => (a -> a) -> (b -> b) -> a -> a
-extT f g = case cast g of
- Just g' -> g'
- Nothing -> f
+extT f = maybe f id . cast
--- | Extend a query
+
+-- | Extend a generic query by a type-specific case
extQ :: (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q
-extQ f g a = case cast a of
- Just b -> g b
- Nothing -> f a
-
--- | Extend a monadic transformation
-extM :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), Monad m)
- => (a -> m a) -> (b -> m b) -> a -> m a
-extM f g = case cast g of
- Just g' -> g'
- Nothing -> f
-
--- | Test two entities to be of the same type
-sameType :: (Typeable a, Typeable b) => a -> b -> Bool
-sameType (_::a) = False `mkQ` (\(_::a) -> True)
+extQ f g a = maybe (f a) g (cast a)
+-- | Extend a generic monadic transformation by a type-specific case
+extM :: (Typeable a, Typeable b,
+ Typeable (m a), Typeable (m b),
+ Monad m)
+ => (a -> m a) -> (b -> m b) -> a -> m a
+extM f = maybe f id . cast
--- | Make a twin transformation
--- Note: Should be worked on
-mkTT :: (Typeable a, Typeable b, Typeable c)
- => (a -> a -> a)
- -> b -> c -> Maybe c
-mkTT (f::a ->a->a) x y =
- case (cast x,cast y) of
- (Just (x'::a),Just (y'::a)) -> cast (f x' y')
- _ -> Nothing
+-- | Extend a generic MonadPlus transformation by a type-specific case
+extF :: (Typeable a, Typeable b,
+ Typeable (m a), Typeable (m b),
+ MonadPlus m)
+ => (a -> m a) -> (b -> m b) -> a -> m a
+extF = extM
----------------------------------------------
+-- | Extend a generic builder by a type-specific case
+extB :: (Typeable a, Typeable b,
+ Typeable i,
+ Typeable (m (a,i)), Typeable (m (b,i)),
+ MonadPlus m)
+ => (i -> m (a,i)) -> (i -> m (b,i)) -> i -> m (a,i)
+extB f = maybe f id . cast
+
+
+
+------------------------------------------------------------------------------
--
--- The Data class and its operations
+-- The Data class
--
----------------------------------------------
+------------------------------------------------------------------------------
+
+{-
--- A class for traversal
+The Data class comprehends two important primitives "gfoldl" and
+"gunfold" for folding and unfolding constructor applications, say
+terms. Besides, there are helpers "conOf" and "consOf" for retrieving
+constructors from terms and types. Finally, typical ways of mapping
+over immediate subterms are defined as "gmap" combinators in terms
+of gfoldl. A generic programmer does not necessarily need to use
+the ingenious gfoldl/gunfold couple but rather the "gmap" combinators.
+
+-}
class Typeable a => Data a where
- gmapT :: (forall b. Data b => b -> b) -> a -> a
- gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
- gmapM :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
+{-
+
+Folding constructor applications ("gfoldl")
+
+The combinator takes two arguments "f" and "z" to fold over a term
+"x". The result type is parametric via a type constructor "c" in the
+type of "gfoldl". The purpose of "z" is to define how the empty
+constructor application is folded. So "z" is like the neutral / start
+element for list folding. The purpose of "f" is to define how the
+nonempty constructor application is folded. That is, "f" takes the
+folded "tail" of the constructor application and its head, i.e., an
+immediate subterm, and combines them in some way. See the Data
+instances in this file which illustrate gfoldl. Conclusion: the type
+of gfoldl is a headache, but operationally it is simple generalisation
+of a list fold.
+
+-}
+
+ -- | Left-associative fold operation for constructor applications
gfoldl :: (forall a b. Data a => c (a -> b) -> a -> c b)
-> (forall g. g -> c g)
-> a -> c a
- gfoldr :: (forall a b. Data a => a -> c (a -> b) -> c b)
- -> (forall g. g -> c g)
- -> a -> c a
+{-
+Unfolding constructor applications ("gunfold")
+
+The combinator takes alike "gfoldl" two arguments "f" and "z", but
+this time its about constructing (say, unfolding) constructor
+applications rather than folding. The input for unfolding is primarily
+an opaque representation of the desired constructor, which is
+essentially a string representation of the constructor. (It is in the
+responsibility of the programmer not to attempt unfolding invalid
+constructors. This is like the side condition that a programmer must
+not apply the "head" function to the empty list.) Besides the
+constructor, we also have to provide the "input" for constructing
+immediate subterms. This is anticipated via the type constructor "c"
+in the type of "gunfold". For example, in the case of a generic read
+function, "c" models string-processing functions. So "z" defines how
+to construct the empty constructor application, and "f" takes an
+incomplete constructor application to add more immediate subterm.
+Conclusion: the type of gunfoldl and what it does is a headache, but
+operationally it is a simple generalisation of the underappreciated
+list unfold.
- -- | Find the constructor
- conOf :: a -> Constr
- -- | Does not look at a; Could live in Typeable as well maybe
- consOf :: a -> [Constr]
+-}
+ -- | Unfold operation to build terms from constructors and others
gunfold :: (forall a b. Data a => c (a -> b) -> c b)
-> (forall g. g -> c g)
- -> c a
-> Constr
-> c a
- -- No default method for gfoldl, gunfold, conOf, consOf
+ -- Default definition for gfoldl
+ -- which copes immediately with basic datatypes
+ --
+ gfoldl _ z = z
+
+ -- | Obtain the constructor from a given term
+ conOf :: a -> Constr
+
+ -- | List all constructors for a given type
+ consOf :: a -> [Constr]
+
+
+
+------------------------------------------------------------------------------
+--
+-- Typical generic maps defined in terms of gfoldl
+--
+------------------------------------------------------------------------------
+
+{-
- -- Default methods for gfoldr, gmapT, gmapQ, gmapM,
- -- in terms of gfoldl
+The combinators gmapT, gmapQ, gmapM, gmapF can all be defined in terms
+of gfoldl. We provide corresponding default definitions leaving open
+the opportunity to provide datatype-specific definitions if needed.
- gfoldr f z = gfoldl (flip f) z
+(Also, the inclusion of the gmap combinators as members of class Data
+allows the programmer or the compiler to derive specialised, and maybe
+more efficient code per datatype. Note: gfoldl is more higher-order
+than the gmap combinators. This is subject to ongoing benchmarking
+experiments.)
+Conceptually, the definition of the gmap combinators in terms of the
+primitive gfoldl requires the identification of the gfoldl function
+arguments. Technically, we also need to identify the type constructor
+c used all over the type of gfoldl.
+
+-}
+
+ -- | A generic transformation that maps over the immediate subterms
+ gmapT :: (forall b. Data b => b -> b) -> a -> a
+
+ -- Use an identity datatype constructor ID (see below)
+ -- to instantiate the type constructor c in the type of gfoldl,
+ -- and perform injections ID and projections unID accordingly.
+ --
gmapT f x = unID (gfoldl k ID x)
where
k (ID c) x = ID (c (f x))
+
+ -- | A generic query that processes the immediate subterms and returns a list
+ gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
+
+ -- Use a phantom + function datatype constructor Q (see below),
+ -- to instantiate the type constructor c in the type of gfoldl,
+ -- and perform injections Q and projections unQ accordingly.
+ --
gmapQ f x = unQ (gfoldl k (const (Q id)) x) []
where
k (Q c) x = Q (\rs -> c (f x : rs))
+
+ -- | A generic monadic transformation that maps over the immediate subterms
+ gmapM :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
+
+ -- Use immediately the monad datatype constructor
+ -- to instantiate the type constructor c in the type of gfoldl,
+ -- so injection and projection is done by return and >>=.
+ --
gmapM f = gfoldl k return
- where
- k c x = do c' <- c
- x' <- f x
- return (c' x')
+ where
+ k c x = do c' <- c
+ x' <- f x
+ return (c' x')
- -- Default definition for gfoldl copes with basic datatypes
- gfoldl _ z = z
+ -- | Transformation of at least one immediate subterm does not fail
+ gmapF :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
+ -- Use a datatype constructor F (see below)
+ -- to instantiate the type constructor c in the type of gfoldl.
+ --
+ gmapF f x = unF (gfoldl k z x) >>= \(x',b) ->
+ if b then return x' else mzero
+ where
+ z g = F (return (g,False))
+ k (F c) x
+ = F ( c >>= \(h,b) ->
+ (f x >>= \x' -> return (h x',True))
+ `mplus` return (h x, b)
+ )
-{-
- A variation for gmapQ using an ordinary constant type constructor.
- A problem is here that the associativety might be wrong.
- newtype Phantom x y = Phantom x
- runPhantom (Phantom x) = x
+-- | The identity type constructor needed for the definition of gmapT
+newtype ID x = ID { unID :: x }
- gmapQ f = runPhantom . gfoldl f' z
- where
- f' r a = Phantom (f a : runPhantom r)
- z = const (Phantom [])
--}
-
--- | Describes a constructor
-data Constr = Constr { conString :: String } -- Will be extended
+-- | A phantom datatype constructor used in definition of gmapQ;
+-- the function-typed component is needed to mediate between
+-- left-associative constructor application vs. right-associative lists.
+--
+newtype Q r a = Q { unQ :: [r] -> [r] }
--- | Instructive type synonyms
-type GenericT = forall a. Data a => a -> a
-type GenericQ r = forall a. Data a => a -> r
-type GenericM m = forall a. Data a => a -> m a
+-- | A pairing type constructor needed for the definition of gmapF;
+-- we keep track of the fact if a subterm was ever transformed successfully.
+newtype F m x = F { unF :: m (x, Bool) }
--- Auxiliary type constructors for the default methods (not exported)
-newtype ID x = ID { unID :: x }
-newtype Q r a = Q { unQ :: [r]->[r] }
-newtype TQ r a = TQ { unTQ :: ([r]->[r],[GenericQ' r]) }
--- A twin variation on gmapQ
--- Note: Nested GenericQ (GenericQ ...) buggy in GHC 5.04
-tmapQ :: forall r.
- (forall a b. (Data a, Data b) => a -> b -> r)
- -> (forall a b. (Data a, Data b) => a -> b -> [r])
+------------------------------------------------------------------------------
+--
+-- The Constr datatype for describing datatype constructors
+-- To be extended by fixity, associativity, and maybe others.
+--
+------------------------------------------------------------------------------
-tmapQ g x y = fst (unTQ (gfoldl k z y)) []
- where
- k (TQ (c,l)) x = TQ (\rs -> c (unQ' (head l) x:rs), tail l)
- z _ = TQ (id,gmapQ (\x -> Q' (g x)) x)
+-- | Description of datatype constructors
+data Constr = Constr { conString :: String } deriving (Eq, Typeable)
--- A first-class polymorphic version of GenericQ
-data GenericQ' u = Q' { unQ' :: forall a. Data a => a -> u }
+{-
+It is interesting to observe that we can determine the arity of a
+constructor without further meta-information. To this end, we use
+gunfold to construct a term from a given constructor while leaving the
+subterms undefined; see "gundefineds" below. Here we instantiate the
+type constructor c of the gunfold type by the identity type
+constructor ID. In a subsequent step we determine the number of
+subterms by folding as captured in the generic operation "glength"
+elsewhere in this module. Note that we need a type argument to specify
+the intended type of the constructor.
+-}
--- A first-class polymorphic version of GenericM
-data Monad m => GenericM' m = M' { unM' :: forall a. Data a => a -> m a }
+-- | Compute arity of a constructor against a type argument
+garity :: Data a => (a -> ()) -> Constr -> Int
+garity ta = glength . gundefineds ta
--- A type constructor for monadic twin transformations
-newtype TM m a = TM { unTM :: (m a,[GenericM' m]) }
--- A twin variation on gmapM
+-- | Construct a term from a constructor with undefined subterms
+gundefineds :: Data a => (a -> ()) -> Constr -> a
+gundefineds (_::a -> ()) = (unID :: ID a -> a)
+ . gunfold ((\f -> ID (f undefined)) . unID) ID
+
-tmapM :: forall m. Monad m
- => (forall a b. (Data a, Data b) => a -> b -> m b)
- -> (forall a b. (Data a, Data b) => a -> b -> m b)
-tmapM g x y = fst (unTM (gfoldl k z y))
- where
- k (TM (f,l)) x = TM (f >>= \f' -> unM' (head l) x >>= return . f',tail l)
- z f = TM (return f,gmapQ (\x -> M' (g x)) x)
----------------------------------------------
+------------------------------------------------------------------------------
--
--- Combinators for data structure traversal
+-- Frequently used generic traversal schemes
--
----------------------------------------------
+------------------------------------------------------------------------------
+
+-- | Apply a transformation everywhere in bottom-up manner
+everywhere :: (forall a. Data a => a -> a)
+ -> (forall a. Data a => a -> a)
--- | Summarise all nodes in top-down, left-to-right
-everything :: Data a
- => (r -> r -> r)
- -> (forall a. Data a => a -> r)
- -> a -> r
+-- Use gmapT to recurse into immediate subterms;
+-- recall: gmapT preserves the outermost constructor;
+-- post-process recursively transformed result via f
+--
+everywhere f = f . gmapT (everywhere f)
+
+
+-- | Apply a transformation everywhere in top-down manner
+everywhere' :: (forall a. Data a => a -> a)
+ -> (forall a. Data a => a -> a)
+
+-- Arguments of (.) are flipped compared to everywhere
+everywhere' f = gmapT (everywhere' f) . f
+
+
+-- | Variation on everywhere with an extra stop condition
+everywhereBut :: GenericQ Bool -> GenericT -> GenericT
+
+-- Guarded to let traversal cease if predicate q holds for x
+everywhereBut q f x
+ | q x = x
+ | otherwise = f (gmapT (everywhereBut q f) x)
+
+
+-- | Monadic variation on everywhere
+everywhereM :: Monad m => GenericM m -> GenericM m
+
+-- Bottom-up order is also reflected in order of do-actions
+everywhereM f x = do x' <- gmapM (everywhereM f) x
+ f x'
+
+
+-- | Apply a monadic transformation at least somewhere
+somewhere :: MonadPlus m => GenericM m -> GenericM m
+
+-- We try "f" in top-down manner, but descent into "x" when we fail
+-- at the root of the term. The transformation fails if "f" fails
+-- everywhere, say succeeds nowhere.
+--
+somewhere f x = f x `mplus` gmapF (somewhere f) x
+
+
+-- | Summarise all nodes in top-down, left-to-right order
+everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
+
+-- Apply f to x to summarise top-level node;
+-- use gmapQ to recurse into immediate subterms;
+-- use ordinary foldl to reduce list of intermediate results
+--
everything k f x
- = foldl k (f x) (gmapQ (everything k f) x)
+ = foldl k (f x) (gmapQ (everything k f) x)
+
+-- | Get a list of all entities that meet a predicate
+listify :: Typeable r => (r -> Bool) -> GenericQ [r]
+listify p
+ = everything (++) ([] `mkQ` (\x -> if p x then [x] else []))
--- | Look up something by means of a recognizer
-something :: (forall a. Data a => a -> Maybe u)
- -> (forall a. Data a => a -> Maybe u)
+-- | Look up a subterm by means of a maybe-typed filter
+something :: GenericQ (Maybe u) -> GenericQ (Maybe u)
+
+-- "something" can be defined in terms of "everything"
+-- when a suitable "choice" operator is used for reduction
+--
something = everything orElse
+-- | 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
+--
+synthesize :: s -> (s -> s -> s) -> GenericQ (s -> s) -> GenericQ s
+synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))
--- | Left-biased choice
-orElse :: Maybe a -> Maybe a -> Maybe a
-x `orElse` y = case x of
- Just _ -> x
- Nothing -> y
+-----------------------------------------------------------------------------
+--
+-- "Twin" variations on gmapT, gmapQ. gmapM,
+-- i.e., these combinators take two terms at the same time.
+-- They are needed for multi-parameter traversal as generic equality.
+-- They are not exported.
+--
+-----------------------------------------------------------------------------
+
+{-
--- | Some people like folding over the first maybe instead
-x `orElse'` y = maybe y Just x
+We need type constructors for twin traversal as we needed type
+constructor for the ordinary gmap combinators. These type constructors
+again serve for the instantiation of the type constructor c used in
+the definition of gfoldl. The type constructors for twin traversal are
+elaborations of the type constructors ID, Q and monads that were used
+for the ordinary gmap combinators. More precisely, we use a pairing
+technique to always attach an additional component to the results of
+folding. This additional component carries the list of generic
+functions to be used for the intermediate subterms encountered during
+folding.
+-}
+newtype TT r a = TT { unTT :: (a,[GenericT']) }
+newtype TQ r a = TQ { unTQ :: ([r]->[r],[GenericQ' r]) }
+newtype TM m a = TM { unTM :: (m a,[GenericM' m]) }
--- | Bottom-up synthesis of a data structure
-synthesize :: (forall a. Data a => a -> s -> s)
- -> (s -> s -> s)
- -> s
- -> (forall a. Data a => a -> s)
-synthesize f o z x = f x (foldr o z (gmapQ (synthesize f o z) x))
+-- First-class polymorphic versions of GenericT/GenericQ/GenericM;
+-- they are referenced in TQ amd TM above
+--
+data GenericT' = T' { unT' :: forall a. Data a => a -> a }
+data GenericQ' u = Q' { unQ' :: forall a. Data a => a -> u }
+data Monad m => GenericM' m = M' { unM' :: forall a. Data a => a -> m a }
--- | Apply a transformation everywhere in bottom-up manner
-everywhere :: (forall a. Data a => a -> a)
- -> (forall a. Data a => a -> a)
-everywhere f = f . gmapT (everywhere f)
+{-
+A twin variation on gmapT, where the pattern "GenericQ GenericT"
+expresses that the argument terms x and y are processed rather
+independently. So firstly, x is "queried" with a generic
+transformation as intermediate result, and secondly, this generic
+transformation is applied to y.
+-}
--- | Variation with stop condition
-everywhereBut :: GenericQ Bool
- -> GenericT -> GenericT
-everywhereBut q f x
- | q x = x
- | otherwise = f (gmapT (everywhereBut q f) x)
+tmapT :: GenericQ GenericT -> GenericQ GenericT
+tmapT g x y = fst (unTT (gfoldl k z y))
+ where
+ k (TT (f,l)) x = TT (f (unT' (head l) x),tail l)
+ z f = TT (f,gmapQ (\x -> T' (g x)) x)
--- | Monadic variation
-everywhereM :: (Monad m, Data a)
- => (forall b. Data b => b -> m b)
- -> a -> m a
-everywhereM f x = do x' <- gmapM (everywhereM f) x
- f x'
+-- A twin variation on gmapQ
+
+tmapQ :: forall r.
+ (forall a b. (Data a, Data b) => a -> b -> r)
+ -> (forall a b. (Data a, Data b) => a -> b -> [r])
+
+tmapQ g x y = fst (unTQ (gfoldl k z y)) []
+ where
+ k (TQ (c,l)) x = TQ (\rs -> c (unQ' (head l) x:rs), tail l)
+ z _ = TQ (id,gmapQ (\x -> Q' (g x)) x)
--- | Count immediate subterms
-branches :: Data a => a -> Int
-branches = length . gmapQ (const ())
+-- A twin variation on gmapM
+tmapM :: forall m. Monad m
+ => (forall a b. (Data a, Data b) => a -> b -> m b)
+ -> (forall a b. (Data a, Data b) => a -> b -> m b)
+tmapM g x y = fst (unTM (gfoldl k z y))
+ where
+ k (TM (f,l)) x = TM (f >>= \f' -> unM' (head l) x >>= return . f',tail l)
+ z f = TM (return f,gmapQ (\x -> M' (g x)) x)
--- | Construct term with undefined subterms
-undefineds :: Data a => Constr -> Maybe a
-undefineds i = gunfold (maybe Nothing (\x -> Just (x undefined)))
- Just
- Nothing
- i
----------------------------------------------
+------------------------------------------------------------------------------
--
--- Generic equality, zip, read, show
+-- Generic operations such as show, equality, read
--
----------------------------------------------
+------------------------------------------------------------------------------
+
+-- | Count the number of immediate subterms of the given term
+glength :: GenericQ Int
+glength = length . gmapQ (const ())
+
+
+-- | 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 f = gcount (False `mkQ` (const True . f))
+
+
+-- | Generic show: an alternative to \"deriving Show\"
+gshow :: Data a => a -> String
+
+-- This is a prefix-show using surrounding "(" and ")",
+-- where we recurse into subterms with gmapQ.
+--
+gshow = ( \t ->
+ "("
+ ++ conString (conOf t)
+ ++ concat (gmapQ ((++) " " . gshow) t)
+ ++ ")"
+ ) `extQ` (show :: String -> String)
+
+
+-- | Generic equality: an alternative to \"deriving Eq\"
+geq :: Data a => a -> a -> Bool
+
+{-
+
+Testing for equality of two terms goes like this. Firstly, we
+establish the equality of the two top-level datatype
+constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,
+to compare the two lists of immediate subterms.
+
+(Note for the experts: the type of the worker geq' is rather general
+but precision is recovered via the restrictive type of the top-level
+operation geq. The imprecision of geq' is caused by the type system's
+unability to express the type equivalence for the corresponding
+couples of immediate subterms from the two given input terms.)
+
+-}
--- | Generic equality
-geq :: forall a. Data a => a -> a -> Bool
geq x y = geq' x y
where
geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
- geq' x y = and ( (conString (conOf x) == conString (conOf y)) : tmapQ geq' x y)
-
+ geq' x y = and ( (conString (conOf x) == conString (conOf y))
+ : tmapQ geq' x y
+ )
--- | Generic zip
+-- | Generic zip controlled by a function with type-specific branches
gzip :: (forall a b. (Data a, Data b) => a -> b -> Maybe b)
-> (forall a b. (Data a, Data b) => a -> b -> Maybe b)
+
+-- See testsuite/.../Generics/gzip.hs for an illustration
gzip f x y =
f x y
`orElse`
else Nothing
--- Generic show
-gshow :: Data a => a -> String
-gshow t = "(" ++ conString (conOf t) ++ concat (gmapQ ((++) " ". gshow) t) ++ ")"
-
-
-
--- The type constructor for unfold a la ReadS from the Prelude
+-- | The type constructor for gunfold a la ReadS from the Haskell 98 Prelude;
+-- we don't use lists here for simplicity but only maybes.
newtype GRead i a = GRead (i -> Maybe (a, i))
unGRead (GRead x) = x
+-- | Generic read: an alternative to \"deriving Read\"
+gread :: GenericB Maybe String
--- Generic read
-gread :: Data a => String -> Maybe (a, String)
-gread s
- = do s' <- return $ dropWhile ((==) ' ') s
- guard (not (s' == ""))
- guard (head s' == '(')
- (c,s'') <- breakConOf (dropWhile ((==) ' ') (tail s'))
- (a,s''') <- unGRead (gunfold f z e c) s''
- guard (not (s''' == ""))
- guard (head s''' == ')')
- return (a,tail s''')
- where
- f cab = GRead (\s -> do (ab,s') <- unGRead cab s
- (a,s'') <- gread s'
- return (ab a,s''))
- z c = GRead (\s -> Just (c,s))
- e = GRead (const Nothing)
-
-
--- Get Constr at front
-breakConOf :: String -> Maybe (Constr, String)
-
--- Assume an infix operators in parantheses
-breakConOf ('(':s)
- = case break ((==) ')') s of
- (s'@(_:_),(')':s'')) -> Just (Constr ("(" ++ s' ++ ")"), s'')
- _ -> Nothing
+{-
--- Special treatment of multiple token constructors
-breakConOf ('[':']':s) = Just (Constr "[]",s)
+This is a read operation which insists on prefix notation. (The
+Haskell 98 read deals with infix operators as well. We will be able to
+deal with such special cases as well as sonn as we include fixity
+information into the definition of "Constr".) We use gunfold to
+"parse" the input. To be precise, gunfold is used for all result types
+except String. The type-specific case for String uses basic String
+read. Another source of customisation would be to properly deal with
+infix operators subject to the capture of that information in the
+definition of Constr. The "gread" combinator properly checks the
+validity of constructors before invoking gunfold in order to rule
+out run-time errors.
--- Try lex for ordinary constructor and basic datatypes
-breakConOf s
- = case lex s of
- [(s'@(_:_),s'')] -> Just (Constr s',s'')
- _ -> Nothing
+-}
+gread = gdefault `extB` scase
+ where
----------------------------------------------
+ -- a specific case for strings
+ scase s = case reads s of
+ [x::(String,String)] -> Just x
+ _ -> Nothing
+
+ -- the generic default of gread
+ gdefault s =
+ do s' <- return $ dropWhile ((==) ' ') s
+ guard (not (s' == ""))
+ guard (head s' == '(')
+ (c,s'') <- prefixConstr (dropWhile ((==) ' ') (tail s'))
+ u <- return undefined
+ guard (or [consOf u == [], c `elem` consOf u])
+ (a,s''') <- unGRead (gunfold f z c) s''
+ _ <- return $ constrainTypes a u
+ guard (not (s''' == ""))
+ guard (head s''' == ')')
+ return (a, tail s''')
+
+ -- To force two types to be the same
+ constrainTypes :: a -> a -> ()
+ constrainTypes _ _ = ()
+
+ -- Argument f for unfolding
+ f :: Data a => GRead String (a -> b) -> GRead String b
+ f x = GRead (\s -> do (r,s') <- unGRead x s
+ (t,s'') <- gread s'
+ return (r t,s''))
+
+ -- Argument z for unfolding
+ z :: forall g. g -> GRead String g
+ z g = GRead (\s -> return (g,s))
+
+ -- Get Constr at front of string
+ prefixConstr :: String -> Maybe (Constr, String)
+
+ -- Assume an infix operators in parantheses
+ prefixConstr ('(':s)
+ = case break ((==) ')') s of
+ (s'@(_:_),(')':s'')) -> Just (Constr ("(" ++ s' ++ ")"), s'')
+ _ -> Nothing
+
+ -- Special treatment of multiple token constructors
+ prefixConstr ('[':']':s) = Just (Constr "[]",s)
+
+ -- Try lex for ordinary constructor and basic datatypes
+ prefixConstr s
+ = case lex s of
+ [(s'@(_:_),s'')] -> Just (Constr s',s'')
+ _ -> Nothing
+
+
+
+------------------------------------------------------------------------------
--
-- Instances of the Data class
--
----------------------------------------------
+------------------------------------------------------------------------------
+
+-- Basic datatype Int; folding and unfolding is trivial
+instance Data Int where
+ conOf x = Constr (show x)
+ consOf _ = []
+ gunfold f z c = z (read (conString c))
+
+-- Another basic datatype instance
+instance Data Integer where
+ conOf x = Constr (show x)
+ consOf _ = []
+ gunfold f z c = z (read (conString c))
+-- Another basic datatype instance
instance Data Float where
conOf x = Constr (show x)
consOf _ = []
- gunfold f z e c = z (read (conString c))
+ gunfold f z c = z (read (conString c))
+-- Another basic datatype instance
instance Data Char where
conOf x = Constr (show x)
consOf _ = []
- gunfold f z e c = z (read (conString c))
+ gunfold f z c = z (read (conString c))
+
+{-
+
+Commented out;
+subject to inclusion of a missing Typeable instance
-{- overlap
-instance Data String where
+-- Another basic datatype instance
+instance Data Rational where
conOf x = Constr (show x)
consOf _ = []
- gunfold f z e = z . read
+ gunfold f z c = z (read (conString c))
-}
+-- Bool as a kind of enumeration type
instance Data Bool where
conOf False = Constr "False"
conOf True = Constr "True"
consOf _ = [Constr "False",Constr "True"]
- gunfold f z e (Constr "False") = z False
- gunfold f z e (Constr "True") = z True
- gunfold _ _ e _ = e
+ gunfold f z (Constr "False") = z False
+ gunfold f z (Constr "True") = z True
+{-
+
+We should better not fold over characters in a string for efficiency.
+However, the following instance would clearly overlap with the
+instance for polymorphic lists. Given the current scheme of allowing
+overlapping instances, this would imply that ANY module that imports
+Data.Generics would need to explicitly and generally allow overlapping
+instances. This is prohibitive and calls for a more constrained model
+of allowing overlapping instances. The present instance would also be
+more sensible for UNFOLDING. In the definition of gread, we still
+obtained the favoured behaviour by using a type-specific case for
+String.
+
+-- instance Data String where
+ conOf x = Constr (show x)
+ consOf _ = []
+ gunfold f z c = z (read (conString c))
+
+-}
+
+-- Cons-lists are terms with two immediate subterms. Hence, the gmap
+-- combinators do NOT coincide with the list fold/map combinators.
+--
instance Data a => Data [a] where
gmapT f [] = []
gmapT f (x:xs) = (f x:f xs)
gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
gfoldl f z [] = z []
gfoldl f z (x:xs) = z (:) `f` x `f` xs
- gfoldr f z [] = z []
- gfoldr f z (x:xs) = f xs (f x (z (:)))
conOf [] = Constr "[]"
conOf (_:_) = Constr "(:)"
- gunfold f z e (Constr "[]") = z []
- gunfold f z e (Constr "(:)") = f (f (z (:)))
- gunfold _ _ e _ = e
consOf _ = [Constr "[]",Constr "(:)"]
+ gunfold f z (Constr "[]") = z []
+ gunfold f z (Constr "(:)") = f (f (z (:)))
+
+-- Yet enother polymorphic datatype constructor
+instance Data a => Data (Maybe a) where
+ gfoldl f z Nothing = z Nothing
+ gfoldl f z (Just x) = z Just `f` x
+ conOf Nothing = Constr "Nothing"
+ conOf (Just _) = Constr "Just"
+ consOf _ = [Constr "Nothing", Constr "Just"]
+ gunfold f z c | conString c == "Nothing" = z Nothing
+ gunfold f z c | conString c == "Just" = f (z Just)
+
+-- Yet enother polymorphic datatype constructor
+instance (Data a, Data b) => Data (a,b) where
+ gfoldl f z (a,b) = z (,) `f` a `f` b
+ conOf _ = Constr "(,)"
+ consOf _ = [Constr "(,)"]
+ gunfold f z c | conString c == "(,)" = f (f (z (,)))
+
+-- Functions are treated as "non-compound" data regarding folding while
+-- unfolding is out of reach, maybe not anymore with Template Haskell.
+--
+instance (Typeable a, Typeable b) => Data (a -> b) where
+ conOf _ = Constr "->"
+ consOf _ = [Constr "->"]
+ gunfold _ _ _ = undefined
+------------------------------------------------------------------------------
+--
+-- Miscellaneous
+--
+------------------------------------------------------------------------------
-{- ----------------------------------------------------
- Comments illustrating generic instances
-
- An illustrative instance for a nested datatype
-
- data Nest a = Box a | Wrap (Nest [a])
-
- nestTc = mkTyCon "Nest"
-
- instance Typeable a => Typeable (Nest a) where
- typeOf n = mkAppTy nestTc [typeOf (paratype n)]
- where
- paratype :: Nest a -> a
- paratype _ = undefined
-
- instance (Data a, Data [a]) => Data (Nest a) where
- gmapT f (Box a) = Box (f a)
- gmapT f (Wrap w) = Wrap (f w)
- gmapQ f (Box a) = [f a]
- gmapQ f (Wrap w) = [f w]
- gmapM f (Box a) = f a >>= return . Box
- gmapM f (Wrap w) = f w >>= return . Wrap
- conOf (Box _) = "Box"
- conOf (Wrap _) = "Wrap"
- consOf _ = ["Box","Wrap"]
- gunfold f z e "Box" = f (z Box)
- gunfold f z e "Wrap" = f (z Wrap)
- gunfold _ _ e _ = e
-
-
-
- -- An illustrative instance for local quantors
-
- instance Data GenericT' where
- gmapT f (T' g) = (T' (f g))
- conOf _ = "T'"
- consOf _ = ["T'"]
-
-
- -- test code only
- instance Typeable GenericT' where
- typeOf _ = undefined
-
-
-
- -- The instance for function types
- -- needs -fallow-undecidable-instances
-
-instance Typeable (a -> b) => Data (a -> b) where
- gmapT f = id
- gmapQ f = const []
- gmapM f = return
- conOf _ = "->"
- consOf _ = ["->"]
--}
-
-
---------------------------------------------------------
--- A first-class polymorphic version of GenericT
--- Note: needed because [GenericT] not valid in GHC 5.04
-
-{- Comment out for now (SLPJ 17 Apr 03)
-
-data GenericT' = T' (forall a. Data a => a -> a)
-unT' (T' x) = x
-
--- A type constructor for twin transformations
-
-newtype IDL r a = IDL (a,[GenericT'])
-unIDL (IDL x) = x
-
-
-
--- A twin variation on gmapT
-
-tmapT :: (forall a b. (Data a, Data b) => a -> b -> b)
- -> (forall a b. (Data a, Data b) => a -> b -> b)
-tmapT g x y = fst (unIDL (gfoldl k z y))
- where
- k (IDL (f,l)) x = IDL (f (unT' (head l) x),tail l)
- z f = IDL (f,gmapQ (\x -> T' (g x)) x)
+-- | Test for two objects to agree on the type
+sameType :: (Typeable a, Typeable b) => a -> b -> Bool
+sameType (_::a) = maybe False (\(_::a) -> True) . cast
+-- | Left-biased choice on maybes (non-strict in right argument)
+orElse :: Maybe a -> Maybe a -> Maybe a
+x `orElse` y = maybe y Just x
--- A first-class polymorphic version of GenericQ
-data GenericQ' u = Q' (forall a. Data a => a -> u)
-unQ' (Q' x) = x
+-- Another definition of orElse
+-- where the folding over maybies as defined by maybe is inlined
+-- to ease readability
+--
+x `orElse'` y = case x of
+ Just _ -> x
+ Nothing -> y
+{-
+The following variations take "orElse" to the function
+level. Furthermore, we generalise from "Maybe" to any
+"MonadPlus". This makes sense for monadic transformations and
+queries. We say that the resulting combinators modell choice. We also
+provide a prime example of choice, that is, recovery from failure. In
+the case of transformations, we recover via return whereas for
+queries a given constant is returned.
-}
+-- | Choice for monadic transformations
+choiceF :: MonadPlus m => GenericM m -> GenericM m -> GenericM m
+choiceF f g x = f x `mplus` g x
+-- | Choice for monadic queries
+choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r)
+choiceQ f g x = f x `mplus` g x
--- Compute arity of term constructor
-
-
--- | Turn a predicate into a filter
-match :: (Typeable a, Typeable b) => (a -> Bool) -> b -> Maybe a
-match f = Nothing `mkQ` (\ a -> if f a then Just a else Nothing)
-
-
-
--- | Turn a predicate into a ticker
-tick :: (Typeable a, Typeable b) => (a -> Bool) -> b -> Int
-tick f = 0 `mkQ` (\a -> if f a then 1 else 0)
-
-
-
--- | Turn a ticker into a counter
-count :: (Typeable a, Data b) => (a -> Bool) -> b -> Int
-count f = everything (+) (tick f)
-
-
-
--- | Lift a monomorphic predicate to the polymorphic level
-alike :: (Typeable a, Typeable b) => (a -> Bool) -> b -> Bool
-alike f = False `mkQ` f
-
+-- | Recover from the failure of monadic transformation by identity
+recoverF :: MonadPlus m => GenericM m -> GenericM m
+recoverF f = f `choiceF` return
+-- | Recover from the failure of monadic query by a constant
+recoverQ :: MonadPlus m => r -> GenericQ (m r) -> GenericQ (m r)
+recoverQ r f = f `choiceQ` const (return r)
projects / ghc-base.git / blobdiff