[Hs-Generics] instance Data (in-)conveniences (Re: Traversible
Functor Data, or: X marks the spot)
Claus Reinke
claus.reinke at talk21.com
Sun Jun 29 18:40:50 EDT 2008
>> I suggest to separate the vacuous from the proper instances,
>> and to expose only the former via Data.Generics. That way,
>> the convenience is only an import away, but doesn't get in
>> the way of non-standard applications.
>
> The problem with this is that it leads to conflicting instances if you
> import both.
I was thinking of splitting Data.Generics.Instances, moving some
of its Data instances to Data.Generics.DummyInstances, and not
importing/exporting the latter from Data.Generics.
Importing both Data.Generics and Data.Generics.DummyInstances
would give the current situation, no conflicting instances. And those
who need application-specific instances instead of the dummies
can avoid importing the dummy instances.
In particular, the instances
instance (Data a, Data b) => Data (a -> b)
instance Typeable a => Data (IO a)
instance Typeable a => Data (Ptr a)
instance Typeable a => Data (StablePtr a)
instance Typeable a => Data (IORef a)
instance Typeable a => Data (ForeignPtr a)
instance (Typeable s, Typeable a) => Data (ST s a)
instance Typeable a => Data (TVar a)
instance Typeable a => Data (MVar a)
instance Typeable a => Data (STM a)
instance (Data a, Integral a) => Data (Ratio a)
claim to have polymorphic/generic components, but use the defaults
gfoldl _ z = z
gmapT f x = unID (gfoldl k ID x)
where
k (ID c) x = ID (c (f x))
meaning that gmapT (=id) will never get access to those component
types. Contrast this with the conventional instances for [], Maybe,
Either, (,..) in the same module, and especially the abstraction-
preserving instance for Array a b. And compare the not very
consistent results (sometimes the transformation is applied,
sometimes not):
> everywhere (mkT ((+1)::Int->Int)) (0,1)::(,) Int Int
(1,2)
> everywhere (mkT ((+1)::Int->Int)) (0%1)::Ratio Int
0%1
> everywhere (mkT ((+1)::Int->Int)) (return 0::[] Int)
[1]
> everywhere (mkT ((+1)::Int->Int)) (return 0::IO Int)
0
> everywhere (mkT ((+1)::Int->Int)) (return 0::() -> Int) ()
0
> everywhere (mkT ((+1)::Int->Int)) (array (0,0) [(0,0)] :: Array Int Int)
array (0,0) [(0,1)]
There isn't any straightforward "proper" Data instance for
those types, either. But if, say, I'd knew that, for a specific
application context, I'd want to apply my transformation
(b->b) to the range, and only to the range, of all functions
(a->b), via post-composition, how would I even do that,
given the existing instance Data (a->b)? I can bypass
monomorphic functions using extT, but what about
polymorphic functions?
> (\(f,g)->(f (),g 0))
$ everywhere (mkT (((+1).)::(()->Int)->(()->Int)))
(\()->(0::Int),\_->(0::Int))
(1,0)
Is there a way to do this without removing the existing
Data instance (which would allow me to define my own)?
Claus
More information about the Generics
mailing list