Deriving vs. type constructors

I'm struggling with a problem related to generic programming, boiling down to this: ----snip---- {-# LANGUAGE StandaloneDeriving, KindSignatures, UndecidableInstances #-} data Foo (v :: * -> *) = Foo (v Bar) deriving instance (Show (v Bar)) => Show (Foo v) data Bar = Bar deriving Show ----snip---- So the Show instance for Foo v wants the rather specific Show instance for v Bar. But now imagine that v is always something like Maybe, itself done using something like this presumably: instance Show a => Show (Maybe a) where ... Can I somehow state as a constraint that Foo v has a Show instance if v is a type constructor like Maybe, i.e. once with a Show instances for any arguments that has a Show instance? (You can't see *why* I want to do this in this example - I actually have something like 100 nested datatypes which thread v through, and *every single one of them* adds to the context I need for every one of them.) I feel I want to write something like this: deriving instance (Show a => Show (v a)) => Show (Foo v) Is there a way to do this? Help would be much appreciated! -- Regards, Mike

I don't think this currently possible. I think you are asking for the
following GHC ticket: https://ghc.haskell.org/trac/ghc/ticket/5927
On Oct 15, 2014 4:56 PM, "Michael Sperber"
I'm struggling with a problem related to generic programming, boiling down to this:
----snip---- {-# LANGUAGE StandaloneDeriving, KindSignatures, UndecidableInstances #-}
data Foo (v :: * -> *) = Foo (v Bar)
deriving instance (Show (v Bar)) => Show (Foo v)
data Bar = Bar deriving Show ----snip----
So the Show instance for Foo v wants the rather specific Show instance for v Bar.
But now imagine that v is always something like Maybe, itself done using something like this presumably:
instance Show a => Show (Maybe a) where ...
Can I somehow state as a constraint that Foo v has a Show instance if v is a type constructor like Maybe, i.e. once with a Show instances for any arguments that has a Show instance?
(You can't see *why* I want to do this in this example - I actually have something like 100 nested datatypes which thread v through, and *every single one of them* adds to the context I need for every one of them.)
I feel I want to write something like this:
deriving instance (Show a => Show (v a)) => Show (Foo v)
Is there a way to do this?
Help would be much appreciated!
-- Regards, Mike _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Possibly you can work around this issue uainh the constraints package
http://hackage.haskell.org/package/constraints
On Oct 15, 2014 6:18 PM, "Atze van der Ploeg"
I don't think this currently possible. I think you are asking for the following GHC ticket: https://ghc.haskell.org/trac/ghc/ticket/5927
On Oct 15, 2014 4:56 PM, "Michael Sperber"
wrote: I'm struggling with a problem related to generic programming, boiling down to this:
----snip---- {-# LANGUAGE StandaloneDeriving, KindSignatures, UndecidableInstances #-}
data Foo (v :: * -> *) = Foo (v Bar)
deriving instance (Show (v Bar)) => Show (Foo v)
data Bar = Bar deriving Show ----snip----
So the Show instance for Foo v wants the rather specific Show instance for v Bar.
But now imagine that v is always something like Maybe, itself done using something like this presumably:
instance Show a => Show (Maybe a) where ...
Can I somehow state as a constraint that Foo v has a Show instance if v is a type constructor like Maybe, i.e. once with a Show instances for any arguments that has a Show instance?
(You can't see *why* I want to do this in this example - I actually have something like 100 nested datatypes which thread v through, and *every single one of them* adds to the context I need for every one of them.)
I feel I want to write something like this:
deriving instance (Show a => Show (v a)) => Show (Foo v)
Is there a way to do this?
Help would be much appreciated!
-- Regards, Mike _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

It's hard to know if this will solve your problem, but sometimes it
helps to make your type more generic, and recover the original type
using a type synonym. Something like this:
{-# LANGUAGE StandaloneDeriving, KindSignatures, UndecidableInstances #-}
data FooG a (v :: * -> *) = Foo (v a)
type Foo = FooG Bar
deriving instance (Show (v a)) => Show (FooG a v)
data Bar = Bar
deriving Show
You don't even need the standalone deriving now, but it shows that the
constraint will now be less specific.
Another alternative could be to use something like `Show` from
`Data.Functor.Classes` in transformers. That would mean you'd have to
write your own `Show` instance, though.
Erik
On Wed, Oct 15, 2014 at 4:55 PM, Michael Sperber
I'm struggling with a problem related to generic programming, boiling down to this:
----snip---- {-# LANGUAGE StandaloneDeriving, KindSignatures, UndecidableInstances #-}
data Foo (v :: * -> *) = Foo (v Bar)
deriving instance (Show (v Bar)) => Show (Foo v)
data Bar = Bar deriving Show ----snip----
So the Show instance for Foo v wants the rather specific Show instance for v Bar.
But now imagine that v is always something like Maybe, itself done using something like this presumably:
instance Show a => Show (Maybe a) where ...
Can I somehow state as a constraint that Foo v has a Show instance if v is a type constructor like Maybe, i.e. once with a Show instances for any arguments that has a Show instance?
(You can't see *why* I want to do this in this example - I actually have something like 100 nested datatypes which thread v through, and *every single one of them* adds to the context I need for every one of them.)
I feel I want to write something like this:
deriving instance (Show a => Show (v a)) => Show (Foo v)
Is there a way to do this?
Help would be much appreciated!
-- Regards, Mike _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (3)
-
Atze van der Ploeg
-
Erik Hesselink
-
Michael Sperber