1 -----------------------------------------------------------------------------
3 -- Module : Data.Generics.Basics
4 -- Copyright : (c) The University of Glasgow, CWI 2001--2004
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (local universal quantification)
11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell.
12 -- See <http://www.cs.vu.nl/boilerplate/>. This module provides
13 -- the 'Data' class with its primitives for generic programming.
15 -----------------------------------------------------------------------------
17 module Data.Generics.Basics (
19 -- * Module Data.Typeable re-exported for convenience
22 -- * The Data class for processing constructor applications
24 gfoldl, -- :: ... -> a -> c a
25 gunfold, -- :: ... -> Constr -> c a
26 toConstr, -- :: a -> Constr
27 dataTypeOf, -- :: a -> DataType
28 dataCast1, -- mediate types and unary type constructors
29 dataCast2, -- mediate types and binary type constructors
30 -- Generic maps defined in terms of gfoldl
41 -- * Datatype representations
42 DataType, -- abstract, instance of: Show
44 mkDataType, -- :: String -> [Constr] -> DataType
45 mkIntType, -- :: String -> DataType
46 mkFloatType, -- :: String -> DataType
47 mkStringType, -- :: String -> DataType
48 mkNorepType, -- :: String -> DataType
50 dataTypeName, -- :: DataType -> String
51 DataRep(..), -- instance of: Eq, Show
52 dataTypeRep, -- :: DataType -> DataRep
53 -- ** Convenience functions
54 repConstr, -- :: DataType -> ConstrRep -> Constr
55 isAlgType, -- :: DataType -> Bool
56 dataTypeConstrs,-- :: DataType -> [Constr]
57 indexConstr, -- :: DataType -> ConIndex -> Constr
58 maxConstrIndex, -- :: DataType -> ConIndex
59 isNorepType, -- :: DataType -> Bool
61 -- * Data constructor representations
62 Constr, -- abstract, instance of: Eq, Show
63 ConIndex, -- alias for Int, start at 1
64 Fixity(..), -- instance of: Eq, Show
66 mkConstr, -- :: DataType -> String -> Fixity -> Constr
67 mkIntConstr, -- :: DataType -> Integer -> Constr
68 mkFloatConstr, -- :: DataType -> Double -> Constr
69 mkStringConstr, -- :: DataType -> String -> Constr
71 constrType, -- :: Constr -> DataType
72 ConstrRep(..), -- instance of: Eq, Show
73 constrRep, -- :: Constr -> ConstrRep
74 constrFields, -- :: Constr -> [String]
75 constrFixity, -- :: Constr -> Fixity
76 -- ** Convenience function: algebraic data types
77 constrIndex, -- :: Constr -> ConIndex
78 -- ** From strings to constructors and vice versa: all data types
79 showConstr, -- :: Constr -> String
80 readConstr, -- :: DataType -> String -> Maybe Constr
82 -- * Convenience functions: take type constructors apart
83 tyconUQname, -- :: String -> String
84 tyconModule, -- :: String -> String
86 -- * Generic operations defined in terms of 'gunfold'
87 fromConstr, -- :: Constr -> a
88 fromConstrB, -- :: ... -> Constr -> a
89 fromConstrM -- :: Monad m => ... -> Constr -> m a
94 ------------------------------------------------------------------------------
96 import Prelude -- necessary to get dependencies right
104 ------------------------------------------------------------------------------
108 ------------------------------------------------------------------------------
111 The 'Data' class comprehends a fundamental primitive 'gfoldl' for
112 folding over constructor applications, say terms. This primitive can
113 be instantiated in several ways to map over the immediate subterms
114 of a term; see the @gmap@ combinators later in this class. Indeed, a
115 generic programmer does not necessarily need to use the ingenious gfoldl
116 primitive but rather the intuitive @gmap@ combinators. The 'gfoldl'
117 primitive is completed by means to query top-level constructors, to
118 turn constructor representations into proper terms, and to list all
119 possible datatype constructors. This completion allows us to serve
120 generic programming scenarios like read, show, equality, term generation.
122 The combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with
123 default definitions in terms of 'gfoldl', leaving open the opportunity
124 to provide datatype-specific definitions.
125 (The inclusion of the @gmap@ combinators as members of class 'Data'
126 allows the programmer or the compiler to derive specialised, and maybe
127 more efficient code per datatype. /Note/: 'gfoldl' is more higher-order
128 than the @gmap@ combinators. This is subject to ongoing benchmarking
129 experiments. It might turn out that the @gmap@ combinators will be
130 moved out of the class 'Data'.)
132 Conceptually, the definition of the @gmap@ combinators in terms of the
133 primitive 'gfoldl' requires the identification of the 'gfoldl' function
134 arguments. Technically, we also need to identify the type constructor
135 @c@ for the construction of the result type from the folded term type.
137 In the definition of @gmapQ@/x/ combinators, we use phantom type
138 constructors for the @c@ in the type of 'gfoldl' because the result type
139 of a query does not involve the (polymorphic) type of the term argument.
140 In the definition of 'gmapQl' we simply use the plain constant type
141 constructor because 'gfoldl' is left-associative anyway and so it is
142 readily suited to fold a left-associative binary operation over the
143 immediate subterms. In the definition of gmapQr, extra effort is
144 needed. We use a higher-order accumulation trick to mediate between
145 left-associative constructor application vs. right-associative binary
146 operation (e.g., @(:)@). When the query is meant to compute a value
147 of type @r@, then the result type withing generic folding is @r -> r@.
148 So the result of folding is a function to which we finally pass the
151 With the @-fglasgow-exts@ option, GHC can generate instances of the
152 'Data' class automatically. For example, given the declaration
154 > data T a b = C1 a b | C2 deriving (Typeable, Data)
156 GHC will generate an instance that is equivalent to
158 > instance (Data a, Data b) => Data (T a b) where
159 > gfoldl k z (C1 a b) = z C1 `k` a `k` b
160 > gfoldl k z C2 = z C2
162 > gunfold k z c = case constrIndex c of
166 > toConstr (C1 _ _) = con_C1
167 > toConstr C2 = con_C2
169 > dataTypeOf _ = ty_T
171 > con_C1 = mkConstr ty_T "C1" [] Prefix
172 > con_C2 = mkConstr ty_T "C2" [] Prefix
173 > ty_T = mkDataType "Module.T" [con_C1, con_C2]
175 This is suitable for datatypes that are exported transparently.
179 class Typeable a => Data a where
181 -- | Left-associative fold operation for constructor applications.
183 -- The type of 'gfoldl' is a headache, but operationally it is a simple
184 -- generalisation of a list fold.
186 -- The default definition for 'gfoldl' is @'const' 'id'@, which is
187 -- suitable for abstract datatypes with no substructures.
188 gfoldl :: (forall a b. Data a => c (a -> b) -> a -> c b)
189 -- ^ defines how nonempty constructor applications are
190 -- folded. It takes the folded tail of the constructor
191 -- application and its head, i.e., an immediate subterm,
192 -- and combines them in some way.
193 -> (forall g. g -> c g)
194 -- ^ defines how the empty constructor application is
195 -- folded, like the neutral \/ start element for list
198 -- ^ structure to be folded.
200 -- ^ result, with a type defined in terms of @a@, but
201 -- variability is achieved by means of type constructor
202 -- @c@ for the construction of the actual result type.
204 -- See the 'Data' instances in this file for an illustration of 'gfoldl'.
208 -- | Unfolding constructor applications
209 gunfold :: (forall b r. Data b => c (b -> r) -> c r)
210 -> (forall r. r -> c r)
214 -- | Obtaining the constructor from a given datum.
215 -- For proper terms, this is meant to be the top-level constructor.
216 -- Primitive datatypes are here viewed as potentially infinite sets of
217 -- values (i.e., constructors).
218 toConstr :: a -> Constr
221 -- | The outer type constructor of the type
222 dataTypeOf :: a -> DataType
226 ------------------------------------------------------------------------------
228 -- Mediate types and type constructors
230 ------------------------------------------------------------------------------
232 -- | Mediate types and unary type constructors.
233 -- In 'Data' instances of the form @T a@, 'dataCast1' should be defined
236 -- The default definition is @'const' 'Nothing'@, which is appropriate
237 -- for non-unary type constructors.
238 dataCast1 :: Typeable1 t
239 => (forall a. Data a => c (t a))
241 dataCast1 _ = Nothing
243 -- | Mediate types and binary type constructors.
244 -- In 'Data' instances of the form @T a b@, 'dataCast2' should be
245 -- defined as 'gcast2'.
247 -- The default definition is @'const' 'Nothing'@, which is appropriate
248 -- for non-binary type constructors.
249 dataCast2 :: Typeable2 t
250 => (forall a b. (Data a, Data b) => c (t a b))
252 dataCast2 _ = Nothing
256 ------------------------------------------------------------------------------
258 -- Typical generic maps defined in terms of gfoldl
260 ------------------------------------------------------------------------------
263 -- | A generic transformation that maps over the immediate subterms
265 -- The default definition instantiates the type constructor @c@ in the
266 -- type of 'gfoldl' to an identity datatype constructor, using the
267 -- isomorphism pair as injection and projection.
268 gmapT :: (forall b. Data b => b -> b) -> a -> a
270 -- Use an identity datatype constructor ID (see below)
271 -- to instantiate the type constructor c in the type of gfoldl,
272 -- and perform injections ID and projections unID accordingly.
274 gmapT f x = unID (gfoldl k ID x)
276 k (ID c) x = ID (c (f x))
279 -- | A generic query with a left-associative binary operator
280 gmapQl :: (r -> r' -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
281 gmapQl o r f = unCONST . gfoldl k z
283 k c x = CONST $ (unCONST c) `o` f x
286 -- | A generic query with a right-associative binary operator
287 gmapQr :: (r' -> r -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
288 gmapQr o r f x = unQr (gfoldl k (const (Qr id)) x) r
290 k (Qr c) x = Qr (\r -> c (f x `o` r))
293 -- | A generic query that processes the immediate subterms and returns a list
294 -- of results. The list is given in the same order as originally specified
295 -- in the declaratoin of the data constructors.
296 gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
297 gmapQ f = gmapQr (:) [] f
300 -- | A generic query that processes one child by index (zero-based)
301 gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
302 gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
304 k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
308 -- | A generic monadic transformation that maps over the immediate subterms
310 -- The default definition instantiates the type constructor @c@ in
311 -- the type of 'gfoldl' to the monad datatype constructor, defining
312 -- injection and projection using 'return' and '>>='.
313 gmapM :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
315 -- Use immediately the monad datatype constructor
316 -- to instantiate the type constructor c in the type of gfoldl,
317 -- so injection and projection is done by return and >>=.
319 gmapM f = gfoldl k return
326 -- | Transformation of at least one immediate subterm does not fail
327 gmapMp :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
331 The type constructor that we use here simply keeps track of the fact
332 if we already succeeded for an immediate subterm; see Mp below. To
333 this end, we couple the monadic computation with a Boolean.
337 gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
338 if b then return x' else mzero
340 z g = Mp (return (g,False))
342 = Mp ( c >>= \(h,b) ->
343 (f x >>= \x' -> return (h x',True))
344 `mplus` return (h x,b)
347 -- | Transformation of one immediate subterm with success
348 gmapMo :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
352 We use the same pairing trick as for gmapMp,
353 i.e., we use an extra Bool component to keep track of the
354 fact whether an immediate subterm was processed successfully.
355 However, we cut of mapping over subterms once a first subterm
356 was transformed successfully.
360 gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
361 if b then return x' else mzero
363 z g = Mp (return (g,False))
365 = Mp ( c >>= \(h,b) -> if b
367 else (f x >>= \x' -> return (h x',True))
368 `mplus` return (h x,b)
372 -- | The identity type constructor needed for the definition of gmapT
373 newtype ID x = ID { unID :: x }
376 -- | The constant type constructor needed for the definition of gmapQl
377 newtype CONST c a = CONST { unCONST :: c }
380 -- | Type constructor for adding counters to queries
381 data Qi q a = Qi Int (Maybe q)
384 -- | The type constructor used in definition of gmapQr
385 newtype Qr r a = Qr { unQr :: r -> r }
388 -- | The type constructor used in definition of gmapMp
389 newtype Mp m x = Mp { unMp :: m (x, Bool) }
393 ------------------------------------------------------------------------------
397 ------------------------------------------------------------------------------
400 -- | Build a term skeleton
401 fromConstr :: Data a => Constr -> a
402 fromConstr = fromConstrB undefined
405 -- | Build a term and use a generic function for subterms
406 fromConstrB :: Data a
407 => (forall a. Data a => a)
410 fromConstrB f = unID . gunfold k z
416 -- | Monadic variation on 'fromConstrB'
417 fromConstrM :: (Monad m, Data a)
418 => (forall a. Data a => m a)
421 fromConstrM f = gunfold k z
423 k c = do { c' <- c; b <- f; return (c' b) }
428 ------------------------------------------------------------------------------
430 -- Datatype and constructor representations
432 ------------------------------------------------------------------------------
436 -- | Representation of datatypes.
437 -- A package of constructor representations with names of type and module.
439 data DataType = DataType
447 -- | Representation of constructors
449 { conrep :: ConstrRep
450 , constring :: String
451 , confields :: [String] -- for AlgRep only
452 , confixity :: Fixity -- for AlgRep only
453 , datatype :: DataType
456 instance Show Constr where
460 -- | Equality of constructors
461 instance Eq Constr where
462 c == c' = constrRep c == constrRep c'
465 -- | Public representation of datatypes
466 data DataRep = AlgRep [Constr]
473 -- The list of constructors could be an array, a balanced tree, or others.
476 -- | Public representation of constructors
477 data ConstrRep = AlgConstr ConIndex
480 | StringConstr String
485 -- | Unique index for datatype constructors,
486 -- counting from 1 in the order they are given in the program text.
490 -- | Fixity of constructors
492 | Infix -- Later: add associativity and precedence
497 ------------------------------------------------------------------------------
499 -- Observers for datatype representations
501 ------------------------------------------------------------------------------
504 -- | Gets the type constructor including the module
505 dataTypeName :: DataType -> String
510 -- | Gets the public presentation of a datatype
511 dataTypeRep :: DataType -> DataRep
512 dataTypeRep = datarep
515 -- | Gets the datatype of a constructor
516 constrType :: Constr -> DataType
517 constrType = datatype
520 -- | Gets the public presentation of constructors
521 constrRep :: Constr -> ConstrRep
525 -- | Look up a constructor by its representation
526 repConstr :: DataType -> ConstrRep -> Constr
528 case (dataTypeRep dt, cr) of
529 (AlgRep cs, AlgConstr i) -> cs !! (i-1)
530 (IntRep, IntConstr i) -> mkIntConstr dt i
531 (FloatRep, FloatConstr f) -> mkFloatConstr dt f
532 (StringRep, StringConstr str) -> mkStringConstr dt str
533 _ -> error "repConstr"
537 ------------------------------------------------------------------------------
539 -- Representations of algebraic data types
541 ------------------------------------------------------------------------------
544 -- | Constructs an algebraic datatype
545 mkDataType :: String -> [Constr] -> DataType
546 mkDataType str cs = DataType
548 , datarep = AlgRep cs
552 -- | Constructs a constructor
553 mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
554 mkConstr dt str fields fix =
556 { conrep = AlgConstr idx
563 idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
564 showConstr c == str ]
567 -- | Gets the constructors of an algebraic datatype
568 dataTypeConstrs :: DataType -> [Constr]
569 dataTypeConstrs dt = case datarep dt of
570 (AlgRep cons) -> cons
571 _ -> error "dataTypeConstrs"
574 -- | Gets the field labels of a constructor. The list of labels
575 -- is returned in the same order as they were given in the original
576 -- constructor declaration.
577 constrFields :: Constr -> [String]
578 constrFields = confields
581 -- | Gets the fixity of a constructor
582 constrFixity :: Constr -> Fixity
583 constrFixity = confixity
587 ------------------------------------------------------------------------------
589 -- From strings to constr's and vice versa: all data types
591 ------------------------------------------------------------------------------
594 -- | Gets the string for a constructor
595 showConstr :: Constr -> String
596 showConstr = constring
599 -- | Lookup a constructor via a string
600 readConstr :: DataType -> String -> Maybe Constr
602 case dataTypeRep dt of
603 AlgRep cons -> idx cons
604 IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
605 FloatRep -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
606 StringRep -> Just (mkStringConstr dt str)
610 -- Read a value and build a constructor
611 mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
612 mkReadCon f = case (reads str) of
613 [(t,"")] -> Just (f t)
616 -- Traverse list of algebraic datatype constructors
617 idx :: [Constr] -> Maybe Constr
618 idx cons = let fit = filter ((==) str . showConstr) cons
624 ------------------------------------------------------------------------------
626 -- Convenience funtions: algebraic data types
628 ------------------------------------------------------------------------------
631 -- | Test for an algebraic type
632 isAlgType :: DataType -> Bool
633 isAlgType dt = case datarep dt of
638 -- | Gets the constructor for an index (algebraic datatypes only)
639 indexConstr :: DataType -> ConIndex -> Constr
640 indexConstr dt idx = case datarep dt of
641 (AlgRep cs) -> cs !! (idx-1)
642 _ -> error "indexConstr"
645 -- | Gets the index of a constructor (algebraic datatypes only)
646 constrIndex :: Constr -> ConIndex
647 constrIndex con = case constrRep con of
648 (AlgConstr idx) -> idx
649 _ -> error "constrIndex"
652 -- | Gets the maximum constructor index of an algebraic datatype
653 maxConstrIndex :: DataType -> ConIndex
654 maxConstrIndex dt = case dataTypeRep dt of
655 AlgRep cs -> length cs
656 _ -> error "maxConstrIndex"
660 ------------------------------------------------------------------------------
662 -- Representation of primitive types
664 ------------------------------------------------------------------------------
667 -- | Constructs the 'Int' type
668 mkIntType :: String -> DataType
669 mkIntType = mkPrimType IntRep
672 -- | Constructs the 'Float' type
673 mkFloatType :: String -> DataType
674 mkFloatType = mkPrimType FloatRep
677 -- | Constructs the 'String' type
678 mkStringType :: String -> DataType
679 mkStringType = mkPrimType StringRep
682 -- | Helper for 'mkIntType', 'mkFloatType', 'mkStringType'
683 mkPrimType :: DataRep -> String -> DataType
684 mkPrimType dr str = DataType
690 -- Makes a constructor for primitive types
691 mkPrimCon :: DataType -> String -> ConstrRep -> Constr
692 mkPrimCon dt str cr = Constr
696 , confields = error "constrFields"
697 , confixity = error "constrFixity"
701 mkIntConstr :: DataType -> Integer -> Constr
702 mkIntConstr dt i = case datarep dt of
703 IntRep -> mkPrimCon dt (show i) (IntConstr i)
704 _ -> error "mkIntConstr"
707 mkFloatConstr :: DataType -> Double -> Constr
708 mkFloatConstr dt f = case datarep dt of
709 FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
710 _ -> error "mkFloatConstr"
713 mkStringConstr :: DataType -> String -> Constr
714 mkStringConstr dt str = case datarep dt of
715 StringRep -> mkPrimCon dt str (StringConstr str)
716 _ -> error "mkStringConstr"
719 ------------------------------------------------------------------------------
721 -- Non-representations for non-presentable types
723 ------------------------------------------------------------------------------
726 -- | Constructs a non-representation for a non-presentable type
727 mkNorepType :: String -> DataType
728 mkNorepType str = DataType
734 -- | Test for a non-representable type
735 isNorepType :: DataType -> Bool
736 isNorepType dt = case datarep dt of
742 ------------------------------------------------------------------------------
744 -- Convenience for qualified type constructors
746 ------------------------------------------------------------------------------
749 -- | Gets the unqualified type constructor:
750 -- drop *.*.*... before name
752 tyconUQname :: String -> String
753 tyconUQname x = let x' = dropWhile (not . (==) '.') x
754 in if x' == [] then x else tyconUQname (tail x')
757 -- | Gets the module of a type constructor:
758 -- take *.*.*... before name
759 tyconModule :: String -> String
760 tyconModule x = let (a,b) = break ((==) '.') x
763 else a ++ tyconModule' (tail b)
765 tyconModule' x = let x' = tyconModule x
766 in if x' == "" then "" else ('.':x')