Proposal: Add the unordered-containers package and the hashable package to the Haskell Platform
Gábor Lehel
illissius at gmail.com
Wed Mar 20 15:37:28 CET 2013
On Wed, Mar 20, 2013 at 1:25 PM, Herbert Valerio Riedel <hvr at gnu.org> wrote:
> Gábor Lehel <illissius-Re5JQEeQqe8AvxtiuMwx3w at 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.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/libraries/attachments/20130320/d036083d/attachment.htm>
More information about the Libraries
mailing list