1 -----------------------------------------------------------------------------
3 -- Module : Data.Generics
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
11 -- Data types for generic definitions (GHC only).
13 -----------------------------------------------------------------------------
15 module Data.Generics (
18 -- * Data types for the sum-of-products type encoding
19 (:*:)(..), (:+:)(..), Unit(..),
22 -- * Typeable and types-save cast
23 Typeable(..), cast, sameType,
25 -- * The Data class and related types
26 Data( gmapT, gmapQ, gmapM,
27 gfoldl, gfoldr, gunfold,
31 -- * Transformations (T), queries (Q), monadic transformations (Q),
32 -- and twin transformations (TT)
33 GenericT, GenericQ, GenericM,
38 -- * Traversal combinators
39 everything, something, everywhere, everywhereBut,
40 synthesize, branches, undefineds,
42 -- * Generic operations: equality, zip, read, show
43 geq, gzip, gshow, gread,
46 match, tick, count, alike
51 import Prelude -- So that 'make depend' works
53 #ifdef __GLASGOW_HASKELL__
55 import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) )
64 ---------------------------------------------
66 -- Operations involving Typeable only
68 ---------------------------------------------
70 -- | Apply a function if appropriate or preserve term
71 mkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a
72 mkT f = case cast f of
76 -- | Apply a function if appropriate or return a constant
77 mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
78 (r `mkQ` br) a = case cast a of
84 -- | Apply a monadic transformation if appropriate; resort to return otherwise
85 mkM :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), Monad m)
86 => (b -> m b) -> a -> m a
87 mkM f = case cast f of
91 -- | Extend a transformation
92 extT :: (Typeable a, Typeable b) => (a -> a) -> (b -> b) -> a -> a
93 extT f g = case cast g of
98 extQ :: (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q
99 extQ f g a = case cast a of
103 -- | Extend a monadic transformation
104 extM :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), Monad m)
105 => (a -> m a) -> (b -> m b) -> a -> m a
106 extM f g = case cast g of
110 -- | Test two entities to be of the same type
111 sameType :: (Typeable a, Typeable b) => a -> b -> Bool
112 sameType (_::a) = False `mkQ` (\(_::a) -> True)
116 -- | Make a twin transformation
117 -- Note: Should be worked on
118 mkTT :: (Typeable a, Typeable b, Typeable c)
121 mkTT (f::a ->a->a) x y =
122 case (cast x,cast y) of
123 (Just (x'::a),Just (y'::a)) -> cast (f x' y')
129 -------------------------------------------------------------------
131 -- The representation of datatype constructors
132 -- To be extended by fixity, associativity, and what else?
134 -------------------------------------------------------------------
136 -- | Describes a constructor
137 data Constr = Constr { conString :: String }
141 ---------------------------------------------
143 -- The Data class and its operations
145 ---------------------------------------------
147 -- A class for traversal
149 class Typeable a => Data a where
150 gmapT :: (forall b. Data b => b -> b) -> a -> a
151 gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
152 gmapM :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
154 gfoldl :: (forall a b. Data a => c (a -> b) -> a -> c b)
155 -> (forall g. g -> c g)
158 gfoldr :: (forall a b. Data a => a -> c (a -> b) -> c b)
159 -> (forall g. g -> c g)
163 -- | Find the constructor
166 -- | Does not look at a; Could live in Typeable as well maybe
167 consOf :: a -> [Constr]
169 gunfold :: (forall a b. Data a => c (a -> b) -> c b)
170 -> (forall g. g -> c g)
174 -- No default method for gfoldl, gunfold, conOf, consOf
176 -- Default methods for gfoldr, gmapT, gmapQ, gmapM,
177 -- in terms of gfoldl
179 gfoldr f z = gfoldl (flip f) z
181 gmapT f x = unID (gfoldl k ID x)
183 k (ID c) x = ID (c (f x))
185 gmapQ f x = unQ (gfoldl k (const (Q id)) x) []
187 k (Q c) x = Q (\rs -> c (f x : rs))
189 gmapM f = gfoldl k return
196 -- Default definition for gfoldl copes with basic datatypes
201 A variation for gmapQ using an ordinary constant type constructor.
202 A problem is here that the associativety might be wrong.
204 newtype Phantom x y = Phantom x
205 runPhantom (Phantom x) = x
207 gmapQ f = runPhantom . gfoldl f' z
209 f' r a = Phantom (f a : runPhantom r)
210 z = const (Phantom [])
214 -- | Instructive type synonyms
215 type GenericT = forall a. Data a => a -> a
216 type GenericQ r = forall a. Data a => a -> r
217 type GenericM m = forall a. Data a => a -> m a
220 -- Auxiliary type constructors for the default methods (not exported)
221 newtype ID x = ID { unID :: x }
222 newtype Q r a = Q { unQ :: [r]->[r] }
223 newtype TQ r a = TQ { unTQ :: ([r]->[r],[GenericQ' r]) }
225 -- A twin variation on gmapQ
226 -- Note: Nested GenericQ (GenericQ ...) buggy in GHC 5.04
229 (forall a b. (Data a, Data b) => a -> b -> r)
230 -> (forall a b. (Data a, Data b) => a -> b -> [r])
232 tmapQ g x y = fst (unTQ (gfoldl k z y)) []
234 k (TQ (c,l)) x = TQ (\rs -> c (unQ' (head l) x:rs), tail l)
235 z _ = TQ (id,gmapQ (\x -> Q' (g x)) x)
237 -- A first-class polymorphic version of GenericQ
239 data GenericQ' u = Q' { unQ' :: forall a. Data a => a -> u }
243 -- A first-class polymorphic version of GenericM
245 data Monad m => GenericM' m = M' { unM' :: forall a. Data a => a -> m a }
247 -- A type constructor for monadic twin transformations
248 newtype TM m a = TM { unTM :: (m a,[GenericM' m]) }
250 -- A twin variation on gmapM
252 tmapM :: forall m. Monad m
253 => (forall a b. (Data a, Data b) => a -> b -> m b)
254 -> (forall a b. (Data a, Data b) => a -> b -> m b)
255 tmapM g x y = fst (unTM (gfoldl k z y))
257 k (TM (f,l)) x = TM (f >>= \f' -> unM' (head l) x >>= return . f',tail l)
258 z f = TM (return f,gmapQ (\x -> M' (g x)) x)
260 ---------------------------------------------
262 -- Combinators for data structure traversal
264 ---------------------------------------------
266 -- | Summarise all nodes in top-down, left-to-right
269 -> (forall a. Data a => a -> r)
272 = foldl k (f x) (gmapQ (everything k f) x)
276 -- | Look up something by means of a recognizer
277 something :: (forall a. Data a => a -> Maybe u)
278 -> (forall a. Data a => a -> Maybe u)
279 something = everything orElse
283 -- | Left-biased choice
284 orElse :: Maybe a -> Maybe a -> Maybe a
285 x `orElse` y = case x of
291 -- | Some people like folding over the first maybe instead
292 x `orElse'` y = maybe y Just x
296 -- | Bottom-up synthesis of a data structure
297 synthesize :: (forall a. Data a => a -> s -> s)
300 -> (forall a. Data a => a -> s)
301 synthesize f o z x = f x (foldr o z (gmapQ (synthesize f o z) x))
305 -- | Apply a transformation everywhere in bottom-up manner
306 everywhere :: (forall a. Data a => a -> a)
307 -> (forall a. Data a => a -> a)
308 everywhere f = f . gmapT (everywhere f)
312 -- | Variation with stop condition
313 everywhereBut :: GenericQ Bool
314 -> GenericT -> GenericT
317 | otherwise = f (gmapT (everywhereBut q f) x)
321 -- | Monadic variation
322 everywhereM :: (Monad m, Data a)
323 => (forall b. Data b => b -> m b)
325 everywhereM f x = do x' <- gmapM (everywhereM f) x
329 -- | Count immediate subterms
330 branches :: Data a => a -> Int
331 branches = length . gmapQ (const ())
334 -- | Construct term with undefined subterms
335 undefineds :: Data a => Constr -> Maybe a
336 undefineds i = gunfold (maybe Nothing (\x -> Just (x undefined)))
341 ---------------------------------------------
343 -- Generic equality, zip, read, show
345 ---------------------------------------------
347 -- | Generic equality
348 geq :: forall a. Data a => a -> a -> Bool
351 geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
352 geq' x y = and ( (conString (conOf x) == conString (conOf y))
359 gzip :: (forall a b. (Data a, Data b) => a -> b -> Maybe b)
360 -> (forall a b. (Data a, Data b) => a -> b -> Maybe b)
364 if conString (conOf x) == conString (conOf y)
365 then tmapM (gzip f) x y
370 gshow :: Data a => a -> String
372 ++ conString (conOf t)
373 ++ concat (gmapQ ((++) " ". gshow) t)
378 -- The type constructor for unfold a la ReadS from the Prelude
379 newtype GRead i a = GRead (i -> Maybe (a, i))
380 unGRead (GRead x) = x
385 gread :: Data a => String -> Maybe (a, String)
387 = do s' <- return $ dropWhile ((==) ' ') s
388 guard (not (s' == ""))
389 guard (head s' == '(')
390 (c,s'') <- breakConOf (dropWhile ((==) ' ') (tail s'))
391 (a,s''') <- unGRead (gunfold f z c) s''
392 guard (not (s''' == ""))
393 guard (head s''' == ')')
396 f cab = GRead (\s -> do (ab,s') <- unGRead cab s
399 z c = GRead (\s -> Just (c,s))
402 -- Get Constr at front
403 breakConOf :: String -> Maybe (Constr, String)
405 -- Assume an infix operators in parantheses
407 = case break ((==) ')') s of
408 (s'@(_:_),(')':s'')) -> Just (Constr ("(" ++ s' ++ ")"), s'')
411 -- Special treatment of multiple token constructors
412 breakConOf ('[':']':s) = Just (Constr "[]",s)
414 -- Try lex for ordinary constructor and basic datatypes
417 [(s'@(_:_),s'')] -> Just (Constr s',s'')
422 ---------------------------------------------
424 -- Instances of the Data class
426 ---------------------------------------------
428 instance Data Float where
429 conOf x = Constr (show x)
431 gunfold f z c = z (read (conString c))
433 instance Data Char where
434 conOf x = Constr (show x)
436 gunfold f z c = z (read (conString c))
439 instance Data String where
440 conOf x = Constr (show x)
442 gunfold f z = z . read
446 instance Data Bool where
447 conOf False = Constr "False"
448 conOf True = Constr "True"
449 consOf _ = [Constr "False",Constr "True"]
450 gunfold f z (Constr "False") = z False
451 gunfold f z (Constr "True") = z True
453 instance Data a => Data [a] where
455 gmapT f (x:xs) = (f x:f xs)
457 gmapQ f (x:xs) = [f x,f xs]
458 gmapM f [] = return []
459 gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
461 gfoldl f z (x:xs) = z (:) `f` x `f` xs
463 gfoldr f z (x:xs) = f xs (f x (z (:)))
464 conOf [] = Constr "[]"
465 conOf (_:_) = Constr "(:)"
466 gunfold f z (Constr "[]") = z []
467 gunfold f z (Constr "(:)") = f (f (z (:)))
468 consOf _ = [Constr "[]",Constr "(:)"]
473 {- ----------------------------------------------------
474 Comments illustrating generic instances
476 An illustrative instance for a nested datatype
478 data Nest a = Box a | Wrap (Nest [a])
480 nestTc = mkTyCon "Nest"
482 instance Typeable a => Typeable (Nest a) where
483 typeOf n = mkAppTy nestTc [typeOf (paratype n)]
485 paratype :: Nest a -> a
486 paratype _ = undefined
488 instance (Data a, Data [a]) => Data (Nest a) where
489 gmapT f (Box a) = Box (f a)
490 gmapT f (Wrap w) = Wrap (f w)
491 gmapQ f (Box a) = [f a]
492 gmapQ f (Wrap w) = [f w]
493 gmapM f (Box a) = f a >>= return . Box
494 gmapM f (Wrap w) = f w >>= return . Wrap
495 conOf (Box _) = Constr "Box"
496 conOf (Wrap _) = Constr "Wrap"
497 consOf _ = map Constr ["Box","Wrap"]
498 gunfold f z "Box" = f (z Box)
499 gunfold f z "Wrap" = f (z Wrap)
503 -- An illustrative instance for local quantors
505 instance Data GenericT' where
506 gmapT f (T' g) = (T' (f g))
507 conOf _ = Constr "T'"
508 consOf _ = map Constr ["T'"]
512 instance Typeable GenericT' where
517 -- The instance for function types
518 -- needs -fallow-undecidable-instances
520 instance Typeable (a -> b) => Data (a -> b) where
524 conOf _ = Constr "->"
525 consOf _ = [Constr "->"]
529 --------------------------------------------------------
530 -- A first-class polymorphic version of GenericT
531 -- Note: needed because [GenericT] not valid in GHC 5.04
533 {- Comment out for now (SLPJ 17 Apr 03)
535 data GenericT' = T' (forall a. Data a => a -> a)
538 -- A type constructor for twin transformations
540 newtype IDL r a = IDL (a,[GenericT'])
545 -- A twin variation on gmapT
547 tmapT :: (forall a b. (Data a, Data b) => a -> b -> b)
548 -> (forall a b. (Data a, Data b) => a -> b -> b)
549 tmapT g x y = fst (unIDL (gfoldl k z y))
551 k (IDL (f,l)) x = IDL (f (unT' (head l) x),tail l)
552 z f = IDL (f,gmapQ (\x -> T' (g x)) x)
556 -- A first-class polymorphic version of GenericQ
558 data GenericQ' u = Q' (forall a. Data a => a -> u)
570 -- Compute arity of term constructor
573 -- | Turn a predicate into a filter
574 match :: (Typeable a, Typeable b) => (a -> Bool) -> b -> Maybe a
575 match f = Nothing `mkQ` (\ a -> if f a then Just a else Nothing)
579 -- | Turn a predicate into a ticker
580 tick :: (Typeable a, Typeable b) => (a -> Bool) -> b -> Int
581 tick f = 0 `mkQ` (\a -> if f a then 1 else 0)
585 -- | Turn a ticker into a counter
586 count :: (Typeable a, Data b) => (a -> Bool) -> b -> Int
587 count f = everything (+) (tick f)
591 -- | Lift a monomorphic predicate to the polymorphic level
592 alike :: (Typeable a, Typeable b) => (a -> Bool) -> b -> Bool
593 alike f = False `mkQ` f