Confused by instances

Hello, Haskellers, I feel like I'm missing something obvious, but here's some example code:
module Instance where
data Value = Value Integer
class ValueClass a where fromValue :: Value -> a
instance ValueClass Bool where fromValue (Value n) = n /= 0
instance ValueClass String where fromValue (Value n) = show n
instance (Num a) => ValueClass a where fromValue (Value n) = fromInteger n
The Bool instance compiles fine. The String instance fails, and that would be because String is a synonym for [Char], and we can't create instances for those. There's a slight hack in the Prelude which allows you to define your own list show function, and that's exactly what gets done by Show Char, right? I'm sorry about calling it a hack but, well, it is. :) What I'm really confused by is the response to instance (Num a) => ValueClass a -- what I am trying to say is "if a is an instance of Num, then can be an instance of ValueClass too, and here's how". But ghc says: Instance.hs:14:0: Illegal instance declaration for `ValueClass a' (All instance types must be of the form (T a1 ... an) where a1 ... an are distinct type *variables* Use -XFlexibleInstances if you want to disable this.) In the instance declaration for `ValueClass a' I don't understand why what I'm doing above is different from, for example, instance Show a => Show [a], or Monad m => MonadState s (StateT s m) ... I imagine that it's related to the fact that the difference between those two and what I have is that they have either the same class on each side of the =>, or new type variables on the right. But I'm having trouble abstracting from that to the general rule. Any help would be greatly appreciated. In context, I'm attempting to wrap up different types inside a data type, and rather than extracting the value with getBoolean, getInteger, getString etc, I thought I would let type classes work for me, and just say fromValue instead. Is this silly? You can tell me, I won't be hurt. cheers, Fraser.

On Apr 28, 2008, at 16:22 , Fraser Wilson wrote:
instance (Num a) => ValueClass a where fromValue (Value n) = fromInteger n
What I'm really confused by is the response to instance (Num a) => ValueClass a -- what I am trying to say is "if a is an instance of Num, then can be an instance of ValueClass too, and here's how".
The format is instance [context =>] classname instance. Your classname is ValueClass. Your instance is a. a is not of the form (T a1 ... an). (How to fix it? Not sure, and am trying to get myself out of here and on the road :) -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

On Mon, Apr 28, 2008 at 10:50 PM, Brandon S. Allbery KF8NH < allbery@ece.cmu.edu> wrote:
The format is instance [context =>] classname instance. Your classname is ValueClass. Your instance is a. a is not of the form (T a1 ... an).
But neither is instance (Show a) => Show [a] ... *sound of penny dropping * Ah. Wood, trees, all that. Thanks! cheers, Fraser.

2008/4/28 Fraser Wilson
On Mon, Apr 28, 2008 at 10:50 PM, Brandon S. Allbery KF8NH
wrote: The format is instance [context =>] classname instance. Your classname is ValueClass. Your instance is a. a is not of the form (T a1 ... an).
But neither is instance (Show a) => Show [a] ...
Yes it is, it's just a weird looking T, (namely []). This works just as well: instance (Show a) => Show ([] a) ... (Unless that's not H98, but I think it is) Instances have to have concrete constructors at their heads is for technical reasons, namely you can't in general do type inference with unrestricted instances. It is a pattern-matching algorithm as you'd expect, but it goes *backwards*, from right to left; i.e it sees the pattern [a] and generates a new constraint Show a. This is contrary to the intuition that it has a big set of instances, and when it sees, say, Show Int it adds Show [Int]. The direction of the arrow can be misleading :-) To answer your other question, no, there is no list show hack. What is being complained about is that you're using a type synonym as an instance. If you just expand the synonym everything works fine. This is not specific to lists, nor show. You're just not allowed to use synonyms in instances (and as the compiler suggests, this restriction can be lifted with {-# LANGUAGE FlexibleInstances #-}). Luke

On Mon, Apr 28, 2008 at 11:33 PM, Luke Palmer
To answer your other question, no, there is no list show hack.
Perhaps hack was a strong word. I'm not referring to type synonyms, but to the fact that Prelude's show class happens to have a special show function for lists, which happens to be handy when writing an instance for Show Char. I find the coupling here (between Show and a particular instance of Show, namely Show Char) to be disturbing -- Show should not (if you ask me) contain special machinery for specific instances. Not that I'll lose sleep over it, and of course the benefit (having pretty strings) far outweighs the philosophical cost. The showList function has always struck me as a bit of a wart though. cheers, Fraser.

On Mon, Apr 28, 2008 at 3:47 PM, Fraser Wilson
On Mon, Apr 28, 2008 at 11:33 PM, Luke Palmer
wrote: To answer your other question, no, there is no list show hack.
Perhaps hack was a strong word. I'm not referring to type synonyms, but to the fact that Prelude's show class happens to have a special show function for lists, which happens to be handy when writing an instance for Show Char.
Oh, showList, that hack! Right, I had forgotten about that :-) Luke

On Apr 28, 2008, at 17:47 , Fraser Wilson wrote:
Perhaps hack was a strong word. I'm not referring to type synonyms, but to the fact that Prelude's show class happens to have a special show function for lists, which happens to be handy when writing an instance for Show Char. I find the coupling here (between Show and a particular instance of Show, namely Show Char) to be disturbing -- Show should not (if you ask me) contain special machinery for specific instances. Not that I'll lose sleep over it, and of course the benefit (having pretty strings) far outweighs the philosophical cost.
This is what comes of overloading lists as strings. (And what goes along with it, namely slowness. See Data.ByteString for a solution that solves both problems but sadly is unlikely to replace String) -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

2008/4/28 Fraser Wilson
what I am trying to say is "if a is an instance of Num, then can be an instance of ValueClass too, and here's how".
Oh, didn't answer this one. This is almost canned response, questions like this get asked weekly on this list. Short answer: you can't. Longer answer: you can, but you have to wrap it in a newtype, which is irritating. newtype NumValue a = NumV a instance (Num a) => ValueClass (NumV a) where fromValue (Value n) = NumV (fromInteger n) Essentially you have to "tell the compiler" when you use this instance. So you still get all the power, but with less convenience (than the impossible thing you want). Abridged longest answer: you can, and you don't need a newtype, but only if you're The Devil. Here's an explanation, but *please do not do this*! It's unpredictable, poor style, a bad habit, nonmodular, etc. etc. etc. First enable undecidable instances: {-# LANGUAGE UndecidableInstances #-} With this pragma you are forfeiting your right to a terminating compiler. The compiler may "instance stack overflow" or run forever for no discernible reason. Now you are allowed exactly one instance of the form you desire: instance (Num a) => ValueClass a where fromValue (Value n) = fromInteger n If you're lucky, you might be able to define some well-formed instances in addition and have everything behave. It *will* break if you add another such instance, for example: instance (Read a) => ValueClass a where ... Because when the compiler sees fromValue, it will try to match it against the head of an instance. Both the Num and the Read forms match every type, so it will *pick one arbitrarily*, without backtracking. So if you wanted the Read one and it picked the Num one, you are permanently out of luck and you basically have to scrap everything. So, yeah, there's a little excursion into the dirty corners of the typeclass system. If you don't want to get spontaneously eaten by a bear, use a newtype as above :-). And now it's time to go make/edit a wiki page on the subject. Luke

On Mon, Apr 28, 2008 at 11:46 PM, Luke Palmer
2008/4/28 Fraser Wilson
: what I am trying to say is "if a is an instance of Num, then can be an instance of ValueClass too, and here's how".
Oh, didn't answer this one. This is almost canned response, questions like this get asked weekly on this list.
Thanks for the detailed response. In the end, I've just selected the types I'm really interested in, and added instances for those. It works a treat. cheers, Fraser.
participants (3)
-
Brandon S. Allbery KF8NH
-
Fraser Wilson
-
Luke Palmer