Overlapping Instances

Following is a simplification of some code which I have written. I have an overlapping Show instance for A, which is more specific than the general instance for arrays, so I would expect it to be acceptable as an overlapping instance. Nevertheless, I get the following compiler error: Overlapping instances for Show A arising from a use of `show' at 13:17-22 Matching instances: instance (Ix a, Show a, Show b) => Show (Array a b) -- Defined in GHC.Arr instance [overlap ok] Show A -- Defined at 9:9-14 In the expression: show a In the definition of `show': show (B a) = show a In the instance declaration for `Show B' Compilation failed. I've tried UndecidableInstances and IncoherentInstances, but they don't seem to help. What am I doing wrong? Many thanks in advance for any assistance. -John {-# LANGUAGE TypeSynonymInstances, OverlappingInstances #-} import Data.Array type A = Array Int Bool data B = B A instance Show A where show a = "foo" instance Show B where show (B a) = show a

Hi John,
from what I gather this is because Show instance for "Array a b",
which you are overlapping, is defined in a module without the
OverlappingInstances declaration. Check the last few paragraphs of
this from the GHC's user's guide:
http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/type-class-extension...
Markus Läll
On Sun, Oct 24, 2010 at 4:54 PM, John Smith
Following is a simplification of some code which I have written. I have an overlapping Show instance for A, which is more specific than the general instance for arrays, so I would expect it to be acceptable as an overlapping instance. Nevertheless, I get the following compiler error:
Overlapping instances for Show A arising from a use of `show' at 13:17-22 Matching instances: instance (Ix a, Show a, Show b) => Show (Array a b) -- Defined in GHC.Arr instance [overlap ok] Show A -- Defined at 9:9-14 In the expression: show a In the definition of `show': show (B a) = show a In the instance declaration for `Show B' Compilation failed.
I've tried UndecidableInstances and IncoherentInstances, but they don't seem to help. What am I doing wrong?
Many thanks in advance for any assistance.
-John
{-# LANGUAGE TypeSynonymInstances, OverlappingInstances #-}
import Data.Array
type A = Array Int Bool
data B = B A
instance Show A where show a = "foo"
instance Show B where show (B a) = show a
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

Thank you very much for explaining the problem. (I'd read the documentation, but didn't understand where I'd gone wrong.) I found a ticket to fix this at http://hackage.haskell.org/trac/ghc/ticket/3877 On 24/10/2010 16:37, Markus Läll wrote:
Hi John,
from what I gather this is because Show instance for "Array a b", which you are overlapping, is defined in a module without the OverlappingInstances declaration. Check the last few paragraphs of this from the GHC's user's guide:
http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/type-class-extension...
Markus Läll
On Sun, Oct 24, 2010 at 4:54 PM, John Smith
wrote: Following is a simplification of some code which I have written. I have an overlapping Show instance for A, which is more specific than the general instance for arrays, so I would expect it to be acceptable as an overlapping instance. Nevertheless, I get the following compiler error:
Overlapping instances for Show A arising from a use of `show' at 13:17-22 Matching instances: instance (Ix a, Show a, Show b) => Show (Array a b) -- Defined in GHC.Arr instance [overlap ok] Show A -- Defined at 9:9-14 In the expression: show a In the definition of `show': show (B a) = show a In the instance declaration for `Show B' Compilation failed.
I've tried UndecidableInstances and IncoherentInstances, but they don't seem to help. What am I doing wrong?
Many thanks in advance for any assistance.
-John
{-# LANGUAGE TypeSynonymInstances, OverlappingInstances #-}
import Data.Array
type A = Array Int Bool
data B = B A
instance Show A where show a = "foo"
instance Show B where show (B a) = show a

Thank you. Why does this code succeed for a, but stills fails on instance Show B? Do they not both invoke the same Show A? {-# LANGUAGE TypeSynonymInstances, OverlappingInstances, IncoherentInstances #-} import Data.Array type A = Array Int Bool data B = B A instance Show A where show a = "foo" instance Show B where show (B a) = show a a = show $ listArray (1,3) $ repeat True On 24/10/2010 16:37, Markus Läll wrote:
Hi John,
from what I gather this is because Show instance for "Array a b", which you are overlapping, is defined in a module without the OverlappingInstances declaration. Check the last few paragraphs of this from the GHC's user's guide:
http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/type-class-extension...
Markus Läll
On Sun, Oct 24, 2010 at 4:54 PM, John Smith
wrote: Following is a simplification of some code which I have written. I have an overlapping Show instance for A, which is more specific than the general instance for arrays, so I would expect it to be acceptable as an overlapping instance. Nevertheless, I get the following compiler error:
Overlapping instances for Show A arising from a use of `show' at 13:17-22 Matching instances: instance (Ix a, Show a, Show b) => Show (Array a b) -- Defined in GHC.Arr instance [overlap ok] Show A -- Defined at 9:9-14 In the expression: show a In the definition of `show': show (B a) = show a In the instance declaration for `Show B' Compilation failed.
I've tried UndecidableInstances and IncoherentInstances, but they don't seem to help. What am I doing wrong?
Many thanks in advance for any assistance.
-John
{-# LANGUAGE TypeSynonymInstances, OverlappingInstances #-}
import Data.Array
type A = Array Int Bool
data B = B A
instance Show A where show a = "foo"
instance Show B where show (B a) = show a

I think the IncoherentInstances doesn't solve the problem. It does also not seem to be the problem (just) of Show B -- the overlap-error arises whenever you actually try to use show on "Array Int Bool". Like, when you specifiy the type of a as:
a = show $ listArray (1,3 :: Int) $ repeat True even when the Show B instance is commented out, you get the same error...
I can't exactly tell, because I'm quite new for Haskell myself, but it
might be, that TypeSynonymInstances works only for those cases, where:
- no Show instance for that type exists, or
- a Show instance for that type exists, but the module where it was
defined also uses the OverlappingInstances flag (try it with a custom
type!)
The end of the GHC docs section also says, that this choice of how
things happen is open for dispute, but it seems it has not came up
recently enouugh to change it.
With the two ways to implement it, right now we have the promise, that
when you define an instance for a type you created, it cannot be
overlapped by others (unless wrapped in a newtype). But when the
system is changed, the user user of some module gets to create more
specific instances for types in that module.
--
Markus Läll
On Mon, Oct 25, 2010 at 11:00 PM, John Smith
Thank you. Why does this code succeed for a, but stills fails on instance Show B? Do they not both invoke the same Show A?
{-# LANGUAGE TypeSynonymInstances, OverlappingInstances, IncoherentInstances #-}
import Data.Array
type A = Array Int Bool
data B = B A
instance Show A where show a = "foo"
instance Show B where show (B a) = show a
a = show $ listArray (1,3) $ repeat True
On 24/10/2010 16:37, Markus Läll wrote:
Hi John,
from what I gather this is because Show instance for "Array a b", which you are overlapping, is defined in a module without the OverlappingInstances declaration. Check the last few paragraphs of this from the GHC's user's guide:
http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/type-class-extension...
Markus Läll
On Sun, Oct 24, 2010 at 4:54 PM, John Smith
wrote: Following is a simplification of some code which I have written. I have an overlapping Show instance for A, which is more specific than the general instance for arrays, so I would expect it to be acceptable as an overlapping instance. Nevertheless, I get the following compiler error:
Overlapping instances for Show A arising from a use of `show' at 13:17-22 Matching instances: instance (Ix a, Show a, Show b) => Show (Array a b) -- Defined in GHC.Arr instance [overlap ok] Show A -- Defined at 9:9-14 In the expression: show a In the definition of `show': show (B a) = show a In the instance declaration for `Show B' Compilation failed.
I've tried UndecidableInstances and IncoherentInstances, but they don't seem to help. What am I doing wrong?
Many thanks in advance for any assistance.
-John
{-# LANGUAGE TypeSynonymInstances, OverlappingInstances #-}
import Data.Array
type A = Array Int Bool
data B = B A
instance Show A where show a = "foo"
instance Show B where show (B a) = show a
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

El lun, 25-10-2010 a las 22:00 +0200, John Smith escribió:
Thank you. Why does this code succeed for a, but stills fails on instance Show B? Do they not both invoke the same Show A?
No, a doesn't use the instance for Array Int Bool. The (1,3) get defaulted to Integers. The following code will complain, though:
{-# LANGUAGE TypeSynonymInstances, OverlappingInstances, IncoherentInstances #-}
import Data.Array
type A = Array Int Bool
data B = B A
instance Show A where show a = "foo"
a = show $ listArray (1::Int,3) $ repeat True
participants (3)
-
John Smith
-
Jürgen Doser
-
Markus Läll