Mixing own and derived instances with Generic Deriving Mechanism

Dear Pedro, Cafe, Thanks again for helping me out last December. I have been playing a bit more with deriving show and now ran into an interesting problem mixing my own instances with derived instances. Hope you can enlighten me there!
{-# LANGUAGE DeriveGeneric #-} module Test where import GHC.Generics import Generics.Deriving.Show
The Generic Deriving Mechanism adds the keyword 'default' to class definitions. With this keyword we can define a type-generic definition of that method when not given. For example, if we define our own MyData type, we can derive the GShow methods:
data MyData = MyData MyFancyType deriving Generic instance GShow MyData
We can also still give our own definition, for example if we want values of the MyFancyType to always be shown as the same string:
data MyFancyType = MyFancy1 | MyFancy2 deriving Generic instance GShow MyFancyType where gshow _ = "Fancy!"
There is something strange here though: when we use gshow directly on a MyFancyType value our own instance definition is used, evaluating as expected to "Fancy!".
ex1 = gshow MyFancy1
But as soon as we are inside a derived method, we will continue using derived instances even though we defined our own. The example below evaluates to "MyData MyFancy1", rather than "MyData Fancy!":
ex2 = gshow (MyData MyFancy1)
The default methods of GShow are defined in terms of methods from GShow' which operate on the type-representation. From this representation I do not see a way to recover the information that a type has a GShow instance. Am I correct (I hope not :) or is there a way out? Cheers, Maarten Faddegon

Hi Maarten, The problem here is that your instance of GShow MyFancyType defines gshow, but the function that is defined generically is actually gshowsPrec, with the others being given defaults. For this to work as you'd expect it to, you have to define gshowsPrec in the instance GShow MyFancyType. This is a bit unfortunate, but because gshowsPrec has a generic default, it cannot have the usual default (like showsPrec does). Cheers, Pedro On Sat, Feb 1, 2014 at 12:11 PM, Maarten Faddegon < haskell-cafe@maartenfaddegon.nl> wrote:
Dear Pedro, Cafe,
Thanks again for helping me out last December. I have been playing a bit more with deriving show and now ran into an interesting problem mixing my own instances with derived instances. Hope you can enlighten me there!
{-# LANGUAGE DeriveGeneric #-} module Test where import GHC.Generics import Generics.Deriving.Show
The Generic Deriving Mechanism adds the keyword 'default' to class definitions. With this keyword we can define a type-generic definition of that method when not given. For example, if we define our own MyData type, we can derive the GShow methods:
data MyData = MyData MyFancyType deriving Generic instance GShow MyData
We can also still give our own definition, for example if we want values of the MyFancyType to always be shown as the same string:
data MyFancyType = MyFancy1 | MyFancy2 deriving Generic instance GShow MyFancyType where gshow _ = "Fancy!"
There is something strange here though: when we use gshow directly on a MyFancyType value our own instance definition is used, evaluating as expected to "Fancy!".
ex1 = gshow MyFancy1
But as soon as we are inside a derived method, we will continue using derived instances even though we defined our own. The example below evaluates to "MyData MyFancy1", rather than "MyData Fancy!":
ex2 = gshow (MyData MyFancy1)
The default methods of GShow are defined in terms of methods from GShow' which operate on the type-representation. From this representation I do not see a way to recover the information that a type has a GShow instance. Am I correct (I hope not :) or is there a way out?
Cheers,
Maarten Faddegon

Thanks! I rewrote my example from gshow into gshowPrec and now it works as expected :) Would it be correct to say that the 'from'-function does a shallow convert of my value into the type representation (up to the constant representations), and from there we either use an ad-hoc instance of gshowPrec, or we do another shallow convert one layer deeper via the default gShowPrec? Cheers, Maarten On 02/02/14 16:02, José Pedro Magalhães wrote:
Hi Maarten,
The problem here is that your instance of GShow MyFancyType defines gshow, but the function that is defined generically is actually gshowsPrec, with the others being given defaults. For this to work as you'd expect it to, you have to define gshowsPrec in the instance GShow MyFancyType. This is a bit unfortunate, but because gshowsPrec has a generic default, it cannot have the usual default (like showsPrec does).
Cheers, Pedro
On Sat, Feb 1, 2014 at 12:11 PM, Maarten Faddegon
mailto:haskell-cafe@maartenfaddegon.nl> wrote: Dear Pedro, Cafe,
Thanks again for helping me out last December. I have been playing a bit more with deriving show and now ran into an interesting problem mixing my own instances with derived instances. Hope you can enlighten me there!
> {-# LANGUAGE DeriveGeneric #-} > module Test where > import GHC.Generics > import Generics.Deriving.Show
The Generic Deriving Mechanism adds the keyword 'default' to class definitions. With this keyword we can define a type-generic definition of that method when not given. For example, if we define our own MyData type, we can derive the GShow methods:
> data MyData = MyData MyFancyType deriving Generic > instance GShow MyData
We can also still give our own definition, for example if we want values of the MyFancyType to always be shown as the same string:
> data MyFancyType = MyFancy1 | MyFancy2 deriving Generic > instance GShow MyFancyType where > gshow _ = "Fancy!"
There is something strange here though: when we use gshow directly on a MyFancyType value our own instance definition is used, evaluating as expected to "Fancy!".
> ex1 = gshow MyFancy1
But as soon as we are inside a derived method, we will continue using derived instances even though we defined our own. The example below evaluates to "MyData MyFancy1", rather than "MyData Fancy!":
> ex2 = gshow (MyData MyFancy1)
The default methods of GShow are defined in terms of methods from GShow' which operate on the type-representation. From this representation I do not see a way to recover the information that a type has a GShow instance. Am I correct (I hope not :) or is there a way out?
Cheers,
Maarten Faddegon

Hi Maarten, On Tue, Feb 4, 2014 at 12:53 PM, Maarten Faddegon < haskell-cafe@maartenfaddegon.nl> wrote:
Thanks! I rewrote my example from gshow into gshowPrec and now it works as expected :)
Would it be correct to say that the 'from'-function does a shallow convert of my value into the type representation (up to the constant representations),
This is true, yes.
and from there we either use an ad-hoc instance of gshowPrec, or we do another shallow convert one layer deeper via the default gShowPrec?
The shallow vs. deep representation isn't really at play here. The outermost type (|MyData|) is not the same as the innermost type (|MyFancyType|). The issue is that you defined an adhoc |gshow|, but in fact the function that was being used is |gshowsPrec|, which was using the generic default. That and the fact that the generic |gshow| is defined in terms of |gshowsPrec|. Cheers, Pedro
Cheers,
Maarten
On 02/02/14 16:02, José Pedro Magalhães wrote:
Hi Maarten,
The problem here is that your instance of GShow MyFancyType defines gshow, but the function that is defined generically is actually gshowsPrec, with the others being given defaults. For this to work as you'd expect it to, you have to define gshowsPrec in the instance GShow MyFancyType. This is a bit unfortunate, but because gshowsPrec has a generic default, it cannot have the usual default (like showsPrec does).
Cheers, Pedro
On Sat, Feb 1, 2014 at 12:11 PM, Maarten Faddegon < haskell-cafe@maartenfaddegon.nl> wrote:
Dear Pedro, Cafe,
Thanks again for helping me out last December. I have been playing a bit more with deriving show and now ran into an interesting problem mixing my own instances with derived instances. Hope you can enlighten me there!
{-# LANGUAGE DeriveGeneric #-} module Test where import GHC.Generics import Generics.Deriving.Show
The Generic Deriving Mechanism adds the keyword 'default' to class definitions. With this keyword we can define a type-generic definition of that method when not given. For example, if we define our own MyData type, we can derive the GShow methods:
data MyData = MyData MyFancyType deriving Generic instance GShow MyData
We can also still give our own definition, for example if we want values of the MyFancyType to always be shown as the same string:
data MyFancyType = MyFancy1 | MyFancy2 deriving Generic instance GShow MyFancyType where gshow _ = "Fancy!"
There is something strange here though: when we use gshow directly on a MyFancyType value our own instance definition is used, evaluating as expected to "Fancy!".
ex1 = gshow MyFancy1
But as soon as we are inside a derived method, we will continue using derived instances even though we defined our own. The example below evaluates to "MyData MyFancy1", rather than "MyData Fancy!":
ex2 = gshow (MyData MyFancy1)
The default methods of GShow are defined in terms of methods from GShow' which operate on the type-representation. From this representation I do not see a way to recover the information that a type has a GShow instance. Am I correct (I hope not :) or is there a way out?
Cheers,
Maarten Faddegon
participants (2)
-
José Pedro Magalhães
-
Maarten Faddegon