[Haskell-beginners] Class and Instance Question

Adam C. Emerson azure at umich.edu
Fri May 20 03:05:39 CEST 2011


Good morning,

As my first "real" toy project (something trivial but with some
pretense of usefulness at least to me) in Haskell, I had been trying
to write an XDR encoder/decoder based on top of Data.Binary.  As such,
I have a typeclass:

class Encodable t where
    -- | Encode a value in the Put monad.
    put :: t -> Put
    -- | Decode a value in the Get monad
    get :: Get t

And I have various instances, all of which seem to work, except for
two.  My thought was to treat a list of Chars as a string and a list
of "encodable" types as a counted array.  Thus, I tried:

instance Encodable [Char] where
  put s = put $ runPut (putUTF8str s)
  get   = do bs <- get
             return (runGet getUTF8str bs)

and

instance (Encodable e) => Encodable [e] where
  put l = if (length l) > xdrmaxlen
          then fail "Length of data exceeds XDR maximum for arrays."
          else (put (length l) >> putFixed (length l) l)
  get   = do n <- get
             getFixed n

This failed, and the compiler suggested I try adding:

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}

But even with these two statements, I get:

*Data.XDR.Encodable> encode [1, 2, 3]

<interactive>:1:0:
    Overlapping instances for Encodable [t]
      arising from a use of `encode' at <interactive>:1:0-15
    Matching instances:
      instance [overlap ok] (Encodable e) => Encodable [e]
        -- Defined at /home/azure/programming/xdr/src/Data/XDR/Encodable.hs:226:9-38
      instance [overlap ok] Encodable [Char]
        -- Defined at /home/azure/programming/xdr/src/Data/XDR/Encodable.hs:160:9-24
    (The choice depends on the instantiation of `t'
     To pick the first instance above, use -XIncoherentInstances
     when compiling the other instance declarations)
    In the expression: encode [1, 2, 3]

So, the question I have, more than wondering how to get this to work
(I suspect I shouldn't even be doing this, and instead I should
newtype XDRInt and XDRString and so on), is why the two instances
overlap.  I have no instance for Char, so the first instance should
apply to lists of Char (which isn't Encodable.)  And the second should
apply to lists of Encodable things (which Char isn't.)

Is there a fairly comprehensible source I should read to understand
typeclasses and instances better?  (I've read my way through Real
World Haskell, the Wikibook, and A Gentle Introduction, though it's
possible they covered this and I just missed it.)

Thank you.



More information about the Beginners mailing list