[Haskell-cafe] Overlapping instances with "instance F a => G a"
Bryan Gardiner
bog at khumba.net
Thu Jan 1 21:29:59 UTC 2015
Hi cafe! Happy New Year.
I'm writing a version of the Binary typeclass that encodes values with
host endianness, and I have the code at the bottom of the message.
HostBinary provides the encoding/decoding interface, and with
HostBinaryNum I want to be able to write only e.g. "instance
HostBinaryNum Int32" for numeric types. I had the manual HostBinary
Word8 and HostBinary Int8 instances before I wrote HostBinaryNum.
What I can't see is why I get this error at all:
Binary.hs:21:29:
Overlapping instances for HostBinary Word8
arising from a use of ‘hget’
Matching instances:
instance HostBinary Word8 -- Defined at Binary.hs:16:10
instance HostBinaryNum a => HostBinary a
-- Defined at Binary.hs:26:10
In the second argument of ‘fmap’, namely ‘(hget :: Get Word8)’
In the expression: fmap fromIntegral (hget :: Get Word8)
In an equation for ‘hget’:
hget = fmap fromIntegral (hget :: Get Word8)
and also why commenting out either the HostBinary Int8 or the
HostBinaryNum a => HostBinary a instances fixes the problem; and
yet, the HostBinaryNum Word8 is accepted!
Doesn't "HostBinaryNum a => HostBinary a" create a HostBinary instance
for all instances of HostBinaryNum only? So why would it cause
problems with an Int8 instance, and why isn't the HostBinaryNum Word8
instance needed to trigger a collision with the explicit HostBinary
Word8? GHC 7.8.3, if it matters.
Thanks for any clarifiation you can provide,
Bryan
Binary.hs:
{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
module Binary where
import Data.Binary.Get
import Data.Binary.Put
import Data.Bits
import Data.Int
import Data.Word
import Foreign.Storable
class HostBinary a where
hget :: Get a
hput :: a -> Put
instance HostBinary Word8 where
hget = getWord8
hput = putWord8
instance HostBinary Int8 where
hget = fmap fromIntegral (hget :: Get Word8)
hput = hput . (fromIntegral :: Int8 -> Word8)
class (Bits a, Integral a, Storable a) => HostBinaryNum a
instance HostBinaryNum a => HostBinary a where
hget = getNum
hput = putNum
--instance HostBinaryNum Word8
getNum :: (Bits a, Integral a, Storable a) => Get a
getNum = undefined
putNum :: (Bits a, Integral a, Storable a) => a -> Put
putNum = undefined
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 801 bytes
Desc: not available
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20150101/70cc4311/attachment.sig>
More information about the Haskell-Cafe
mailing list