On Wed, Mar 20, 2013 at 1:25 PM, Herbert Valerio Riedel <hvr@gnu.org> wrote:
Gábor Lehel <illissius-Re5JQEeQqe8AvxtiuMwx3w@public.gmane.org> writes:

> Compatibility issues aside, is there any reason newtypes aren't a good
> solution here? You could get away with just one:

this may be a bit off-topic, but I've been wondering for some time now,
how to compose newtype-based typeclass instances?

for instance, now we have a special newtype for 'Int's,

> instance Hashable (FasterInsecureHashing Int) where
>     hash = unFIH

then for some reson we have a another package, which uses newtypes to
provide alternative instances for newtypes, let's say the binary package
starts defining a 'Binary' newtype-wrapped instance for serializing to
PDP-byteordering, .i.e.

instance Binary (PdpSerialization Int) where
    put i = ...
    get = ...


How do would I combine those two newtypes, if I wanted to have a nested
data-structure such as

  IntMap Int (Int,[(Int,Int)])

hashed with the FasterInsecureHashing variant, as well as serialized
with the PdpSerialization instances?

cheers,
  hvr


instance Hashable a => Hashable (PdpSerialization a) where
    hash = hash . unPDP
    hashWithSalt s = hashWithSalt s . unPDP

instance Binary a => Binary (FasterInsecureHashing a) where
    put = put . unFIH
    get = fmap FIH get

Something like that? For classes orthogonal to their intended purpose, instances for the newtypes could just forward to the base impl (of course raising the usual dependency versus orphan instance issues, but that's orthogonal ;). And then just nest the newtypes as you would expect.

Alternately, if the libraries don't provide these instances, and you don't want orphans, you could use something like this solution in your own code:

{-# LANGUAGE FlexibleContexts #-}

newtype FIHPDP a = FIHPDP { unFIHPDP :: a }

instance Hashable (FasterInsecureHashing a) => Hashable (FIHPDP a) where
    hashWithSalt s = hashWithSalt s . FasterInsecureHashing . unFIHPDP

instance Binary (PdpSerialization a) => Binary (FIHPDP a) where
    put = put . PdpSerialization . unFIHPDP
    get = fmap (FIHPDP . unPDP) get


FWIW it's also possible to avoid FlexibleInstances and FlexibleContexts:

class Hashable a where
    hash :: a -> Int
    hashWithSalt :: Int -> a -> Int

-- only for impl purposes
class FasterInsecureHashable a where
    fasterInsecureHash :: a -> Int
    fasterInsecureHashWithSalt :: Int -> a -> Int

newtype FasterInsecureHashing a = FIH { unFIH :: a }

instance FasterInsecureHashable a => Hashable (FasterInsecureHashing a) where
    hash = fasterInsecureHash
    hashWithSalt = fasterInsecureHashWithSalt

instance Hashable ByteString where
    hashWithSalt = ...SipHash...

instance FasterInsecureHashable ByteString where
    fasterInsecureHashWithSalt = ...CityHash...

instance FasterInsecureHashable a => Hashable FIHPDP a where ...

And now let's stop side-tracking.

--
Your ship was destroyed in a monadic eruption.