From cfee24f73ab4bc8348347af9507cf570c026d6b7 Mon Sep 17 00:00:00 2001
From: Andrew Martin <andrew.thaddeus@gmail.com>
Date: Tue, 18 Oct 2016 21:46:55 -0400
Subject: [PATCH 01/17] add Hashable1 and Hashable2 with auxiliary functions

---
 Data/Hashable/Class.hs | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs
index 5ab3cc4..27a41ef 100644
--- a/Data/Hashable/Class.hs
+++ b/Data/Hashable/Class.hs
@@ -24,6 +24,8 @@ module Data.Hashable.Class
     (
       -- * Computing hash values
       Hashable(..)
+    , Hashable1(..)
+    , Hashable2(..)
 #ifdef GENERICS
       -- ** Support for generics
     , GHashable(..)
@@ -35,6 +37,11 @@ module Data.Hashable.Class
     , hashPtrWithSalt
     , hashByteArray
     , hashByteArrayWithSalt
+      -- * Higher Rank Functions
+    , hash1
+    , hashWithSalt1
+    , hash2
+    , hashWithSalt2
     ) where
 
 import Control.Applicative (Const(..))
@@ -195,6 +202,30 @@ class GHashable f where
     ghashWithSalt :: Int -> f a -> Int
 #endif
 
+class Hashable1 t where
+  liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int
+  liftHash :: (a -> Int) -> t a -> Int
+  -- Figure out how to write this
+  -- liftHash f = liftHashWithSalt f defaultSalt
+
+class Hashable2 t where
+  liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
+  liftHash2 :: (a -> Int) -> (b -> Int) -> t a b -> Int
+  -- Figure out how to write this
+  -- liftHash2 f g = liftHashWithSalt2 f g defaultSalt
+
+hash1 :: (Hashable1 f, Hashable a) => f a -> Int
+hash1 = liftHash hash
+
+hashWithSalt1 :: (Hashable1 f, Hashable a) => Int -> f a -> Int
+hashWithSalt1 = liftHashWithSalt hashWithSalt
+
+hash2 :: (Hashable2 f, Hashable a, Hashable b) => f a b -> Int
+hash2 = liftHash2 hash hash
+
+hashWithSalt2 :: (Hashable2 f, Hashable a, Hashable b) => Int -> f a b -> Int
+hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt
+
 -- Since we support a generic implementation of 'hashWithSalt' we
 -- cannot also provide a default implementation for that method for
 -- the non-generic instance use case. Instead we provide
@@ -461,6 +492,12 @@ instance Hashable a => Hashable [a] where
         finalise (SP s l) = hashWithSalt s l
         step (SP s l) x   = SP (hashWithSalt s x) (l + 1)
 
+-- instance Hashable1 [] where
+--     liftHashWithSalt h salt arr = finalise (foldl' step (SP salt 0) arr)
+--       where
+--         finalise (SP s l) = hashWithSalt s l
+--         step (SP s l) x   = SP (h s x) (l + 1)
+
 instance Hashable B.ByteString where
     hashWithSalt salt bs = B.inlinePerformIO $
                            B.unsafeUseAsCStringLen bs $ \(p, len) ->

From 46dc659b24cbd7483267a0720399480810385488 Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Wed, 19 Oct 2016 10:16:37 -0400
Subject: [PATCH 02/17] Add instances and documentation

---
 Data/Hashable/Class.hs  | 77 ++++++++++++++++++++-------------
 Data/Hashable/Lifted.hs | 96 +++++++++++++++++++++++++++++++++++++++++
 hashable.cabal          |  1 +
 3 files changed, 145 insertions(+), 29 deletions(-)
 create mode 100644 Data/Hashable/Lifted.hs

diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs
index 27a41ef..f3dbf3b 100644
--- a/Data/Hashable/Class.hs
+++ b/Data/Hashable/Class.hs
@@ -38,10 +38,9 @@ module Data.Hashable.Class
     , hashByteArray
     , hashByteArrayWithSalt
       -- * Higher Rank Functions
-    , hash1
     , hashWithSalt1
-    , hash2
     , hashWithSalt2
+    , defaultLiftHashWithSalt
     ) where
 
 import Control.Applicative (Const(..))
@@ -203,29 +202,31 @@ class GHashable f where
 #endif
 
 class Hashable1 t where
-  liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int
-  liftHash :: (a -> Int) -> t a -> Int
-  -- Figure out how to write this
-  -- liftHash f = liftHashWithSalt f defaultSalt
+    -- | Lift a hashing function through the type constructor.
+    liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int
 
 class Hashable2 t where
-  liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
-  liftHash2 :: (a -> Int) -> (b -> Int) -> t a b -> Int
-  -- Figure out how to write this
-  -- liftHash2 f g = liftHashWithSalt2 f g defaultSalt
-
-hash1 :: (Hashable1 f, Hashable a) => f a -> Int
-hash1 = liftHash hash
+    -- | Lift a hashing function through the binary type constructor.
+    liftHashWithSalt2 :: (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
 
+-- | Lift the 'hashWithSalt' function through the type constructor.
+--
+-- > hashWithSalt1 = liftHashWithSalt hashWithSalt
 hashWithSalt1 :: (Hashable1 f, Hashable a) => Int -> f a -> Int
 hashWithSalt1 = liftHashWithSalt hashWithSalt
 
-hash2 :: (Hashable2 f, Hashable a, Hashable b) => f a b -> Int
-hash2 = liftHash2 hash hash
-
+-- | Lift the 'hashWithSalt' function through the type constructor.
+--
+-- > hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt
 hashWithSalt2 :: (Hashable2 f, Hashable a, Hashable b) => Int -> f a b -> Int
 hashWithSalt2 = liftHashWithSalt2 hashWithSalt hashWithSalt
 
+-- | Lift the 'hashWithSalt' function halfway through the type constructor.
+-- This function makes a suitable default implementation of 'liftHashWithSalt',
+-- given that the type constructor @t@ in question can unify with @f a@.
+defaultLiftHashWithSalt :: (Hashable2 f, Hashable a) => (Int -> b -> Int) -> Int -> f a b -> Int
+defaultLiftHashWithSalt h = liftHashWithSalt2 hashWithSalt h
+
 -- Since we support a generic implementation of 'hashWithSalt' we
 -- cannot also provide a default implementation for that method for
 -- the non-generic instance use case. Instead we provide
@@ -425,14 +426,23 @@ distinguisher = fromIntegral $ (maxBound :: Word) `quot` 3
 instance Hashable a => Hashable (Maybe a) where
     hash Nothing = 0
     hash (Just a) = distinguisher `hashWithSalt` a
-    hashWithSalt s Nothing = s `combine` 0
-    hashWithSalt s (Just a) = s `combine` distinguisher `hashWithSalt` a
+    hashWithSalt = hashWithSalt1
+
+instance Hashable1 Maybe where
+    liftHashWithSalt _ s Nothing = s `combine` 0
+    liftHashWithSalt h s (Just a) = s `combine` distinguisher `h` a
 
 instance (Hashable a, Hashable b) => Hashable (Either a b) where
     hash (Left a)  = 0 `hashWithSalt` a
     hash (Right b) = distinguisher `hashWithSalt` b
-    hashWithSalt s (Left a)  = s `combine` 0 `hashWithSalt` a
-    hashWithSalt s (Right b) = s `combine` distinguisher `hashWithSalt` b
+    hashWithSalt = hashWithSalt1
+
+instance Hashable a => Hashable1 (Either a) where
+    liftHashWithSalt = defaultLiftHashWithSalt
+
+instance Hashable2 Either where
+    liftHashWithSalt2 h _ s (Left a) = s `combine` 0 `h` a
+    liftHashWithSalt2 _ h s (Right b) = s `combine` distinguisher `h` b
 
 instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where
     hash (a1, a2) = hash a1 `hashWithSalt` a2
@@ -487,16 +497,13 @@ data SPInt = SP !Int !Int
 
 instance Hashable a => Hashable [a] where
     {-# SPECIALIZE instance Hashable [Char] #-}
-    hashWithSalt salt arr = finalise (foldl' step (SP salt 0) arr)
+    hashWithSalt = hashWithSalt1
+
+instance Hashable1 [] where
+    liftHashWithSalt h salt arr = finalise (foldl' step (SP salt 0) arr)
       where
         finalise (SP s l) = hashWithSalt s l
-        step (SP s l) x   = SP (hashWithSalt s x) (l + 1)
-
--- instance Hashable1 [] where
---     liftHashWithSalt h salt arr = finalise (foldl' step (SP salt 0) arr)
---       where
---         finalise (SP s l) = hashWithSalt s l
---         step (SP s l) x   = SP (h s x) (l + 1)
+        step (SP s l) x   = SP (h s x) (l + 1)
 
 instance Hashable B.ByteString where
     hashWithSalt salt bs = B.inlinePerformIO $
@@ -639,18 +646,30 @@ instance Hashable Version where
         salt `hashWithSalt` branch `hashWithSalt` tags
 
 #if MIN_VERSION_base(4,7,0)
+-- Using hashWithSalt1 would cause needless constraint
 instance Hashable (Fixed a) where
     hashWithSalt salt (MkFixed i) = hashWithSalt salt i
+instance Hashable1 Fixed where
+    liftHashWithSalt _ salt (MkFixed i) = hashWithSalt salt i
 #endif
 
 #if MIN_VERSION_base(4,8,0)
 instance Hashable a => Hashable (Identity a) where
-    hashWithSalt salt (Identity x) = hashWithSalt salt x
+    hashWithSalt = hashWithSalt1
+instance Hashable1 Identity where
+    liftHashWithSalt h salt (Identity x) = h salt x
 #endif
 
+-- Using hashWithSalt1 would cause needless constraint
 instance Hashable a => Hashable (Const a b) where
     hashWithSalt salt (Const x) = hashWithSalt salt x
 
+instance Hashable a => Hashable1 (Const a) where
+    liftHashWithSalt = defaultLiftHashWithSalt
+
+instance Hashable2 Const where
+    liftHashWithSalt2 f _ salt (Const x) = f salt x
+
 -- instances formerly provided by 'semigroups' package
 #if MIN_VERSION_base(4,9,0)
 instance Hashable a => Hashable (NE.NonEmpty a) where
diff --git a/Data/Hashable/Lifted.hs b/Data/Hashable/Lifted.hs
new file mode 100644
index 0000000..433d3a7
--- /dev/null
+++ b/Data/Hashable/Lifted.hs
@@ -0,0 +1,96 @@
+------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Hashable.Class
+-- Copyright   :  (c) Milan Straka 2010
+--                (c) Johan Tibell 2011
+--                (c) Bryan O'Sullivan 2011, 2012
+-- License     :  BSD-style
+-- Maintainer  :  johan.tibell@gmail.com
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Lifting of the 'Hashable' class to unary and binary type constructors.
+-- These classes are needed to express the constraints on arguments of
+-- types that are parameterized by type constructors. Fixed-point data
+-- types and monad transformers are such types.
+
+module Data.Hashable.Lifted
+    ( -- * Type Classes
+      Hashable1(..)
+    , Hashable2(..)
+      -- * Auxiliary Functions
+    , hashWithSalt1
+    , hashWithSalt2
+    , defaultLiftHashWithSalt
+      -- * Motivation
+      -- $motivation
+    ) where
+
+import Data.Hashable.Class
+
+-- $motivation
+--
+-- This type classes provided in this module are used to express constraints
+-- on type constructors in a Haskell98-compatible fashion. As an example, consider
+-- the following two types (Note that these instances are not actually provided
+-- because @hashable@ does not have @transformers@ or @free@ as a dependency):
+--
+-- > newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
+-- > data Free f a = Pure a | Free (f (Free f a))
+--
+-- The 'Hashable1' instances for @WriterT@ and @Free@ could be written as:
+--
+-- > instance (Hashable w, Hashable1 m) => Hashable1 (WriterT w m) where
+-- >     liftHashWithSalt h s (WriterT m) =
+-- >         liftHashWithSalt (liftHashWithSalt2 h hashWithSalt) s m
+-- > instance (Hashable1 f, Functor f) => Hashable1 (Free f) where
+-- >     liftHashWithSalt h = go where
+-- >         go s x = case x of
+-- >             Pure a -> h s a
+-- >             Free p -> liftHashWithSalt go p
+--
+-- The 'Hashable' instances for these types can be trivially recovered with
+-- 'hashWithSalt1':
+--
+-- > instance (Hashable w, Hashable1 m, Hashable a) => Hashable (WriterT w m a) where
+-- >     hashWithSalt = hashWithSalt1
+-- > instance (Hashable1 f, Hashable a) => Hashable1 (Free f a) where
+-- >     hashWithSalt = hashWithSalt1
+
+--
+-- $discussion
+--
+-- Regardless of whether 'hashWithSalt1' is used to provide an implementation
+-- of 'hashWithSalt', they should produce the same hash when called with
+-- the same arguments. This is the only law that 'Hashable1' and 'Hashable2'
+-- are expected to follow.
+--
+-- The typeclasses in this module only provide lifting for 'hashWithSalt', not
+-- for 'hash'. This is because such liftings cannot be defined in a way that
+-- would satisfy the @liftHash@ variant of the above law. As an illustration
+-- of the problem we run into, let us assume that 'Hashable1' were
+-- given a 'liftHash' method:
+--
+-- > class Hashable1 t where
+-- >     liftHash :: (Int -> a) -> t a -> Int
+-- >     liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int
+--
+-- Even for a type as simple as 'Maybe', the problem manifests itself. The
+-- 'Hashable' instance for 'Maybe' is:
+--
+-- > distinguisher :: Int
+-- > distinguisher = ...
+-- >
+-- > instance Hashable a => Hashable (Maybe a) where
+-- >     hash Nothing = 0
+-- >     hash (Just a) = distinguisher `hashWithSalt` a
+-- >     hashWithSalt s Nothing = ...
+-- >     hashWithSalt s (Just a) = ...
+--
+-- The implementation of 'hash' calls 'hashWithSalt' on @a@. The hypothetical
+-- @liftHash@ defined earlier only accepts an argument that corresponds to
+-- the implementation of 'hash' for @a@. Consequently, this formulation of
+-- @liftHash@ would not provide a way to match the current behavior of 'hash'
+-- for 'Maybe'. This problem gets worse when 'Either' and @[]@ are considered.
+-- The solution adopted in this library is to omit @liftHash@ entirely.
+
diff --git a/hashable.cabal b/hashable.cabal
index dd3207b..046f93f 100644
--- a/hashable.cabal
+++ b/hashable.cabal
@@ -39,6 +39,7 @@ Flag sse41
 
 Library
   Exposed-modules:   Data.Hashable
+                     Data.Hashable.Lifted
   Other-modules:     Data.Hashable.Class
   Build-depends:     base >= 4.0 && < 4.10,
                      bytestring >= 0.9 && < 0.11

From f42e268074a22bf006b454f391571e118e9553fd Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Wed, 19 Oct 2016 12:49:31 -0400
Subject: [PATCH 03/17] adapt generics support for Hashable1

---
 Data/Hashable/Class.hs   | 26 +++++++++++++----
 Data/Hashable/Generic.hs | 63 +++++++++++++++++++++++++---------------
 2 files changed, 60 insertions(+), 29 deletions(-)

diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs
index f3dbf3b..adc2335 100644
--- a/Data/Hashable/Class.hs
+++ b/Data/Hashable/Class.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,
              ScopedTypeVariables, UnliftedFFITypes #-}
 #ifdef GENERICS
-{-# LANGUAGE DefaultSignatures, FlexibleContexts #-}
+{-# LANGUAGE DefaultSignatures, FlexibleContexts, GADTs,
+    MultiParamTypeClasses #-}
 #endif
 
 ------------------------------------------------------------------------
@@ -29,6 +30,9 @@ module Data.Hashable.Class
 #ifdef GENERICS
       -- ** Support for generics
     , GHashable(..)
+    , ToHash(..)
+    , Zero
+    , One
 #endif
 
       -- * Creating new instances
@@ -193,17 +197,29 @@ class Hashable a where
     hash = hashWithSalt defaultSalt
 
 #ifdef GENERICS
-    default hashWithSalt :: (Generic a, GHashable (Rep a)) => Int -> a -> Int
-    hashWithSalt salt = ghashWithSalt salt . from
+    default hashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int
+    hashWithSalt salt = ghashWithSalt ToHash0 salt . from
+
+data Zero = Zero
+data One = One
+
+data ToHash arity a where
+    ToHash0 :: ToHash Zero a
+    ToHash1 :: (Int -> a -> Int) -> ToHash One a
 
 -- | The class of types that can be generically hashed.
-class GHashable f where
-    ghashWithSalt :: Int -> f a -> Int
+class GHashable arity f where
+    ghashWithSalt :: ToHash arity a -> Int -> f a -> Int
+
 #endif
 
 class Hashable1 t where
     -- | Lift a hashing function through the type constructor.
     liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int
+#ifdef GENERICS
+    default liftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int
+    liftHashWithSalt h salt = ghashWithSalt (ToHash1 h) salt . from1
+#endif
 
 class Hashable2 t where
     -- | Lift a hashing function through the binary type constructor.
diff --git a/Data/Hashable/Generic.hs b/Data/Hashable/Generic.hs
index 2f8680e..db1152c 100644
--- a/Data/Hashable/Generic.hs
+++ b/Data/Hashable/Generic.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures,
-             ScopedTypeVariables, TypeOperators #-}
+             ScopedTypeVariables, TypeOperators,
+             MultiParamTypeClasses, GADTs #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 ------------------------------------------------------------------------
@@ -21,43 +22,56 @@ import Data.Bits (shiftR)
 import Data.Hashable.Class
 import GHC.Generics
 
+
 -- Type without constructors
-instance GHashable V1 where
-    ghashWithSalt salt _ = hashWithSalt salt ()
+instance GHashable arity V1 where
+    ghashWithSalt _ salt _ = hashWithSalt salt ()
 
 -- Constructor without arguments
-instance GHashable U1 where
-    ghashWithSalt salt U1 = hashWithSalt salt ()
+instance GHashable arity U1 where
+    ghashWithSalt _ salt U1 = hashWithSalt salt ()
 
-instance (GHashable a, GHashable b) => GHashable (a :*: b) where
-    ghashWithSalt salt (x :*: y) = salt `ghashWithSalt` x `ghashWithSalt` y
+instance (GHashable arity a, GHashable arity b) => GHashable arity (a :*: b) where
+    ghashWithSalt toHash salt (x :*: y) =
+      (ghashWithSalt toHash (ghashWithSalt toHash salt x) y)
 
 -- Metadata (constructor name, etc)
-instance GHashable a => GHashable (M1 i c a) where
-    ghashWithSalt salt = ghashWithSalt salt . unM1
+instance GHashable arity a => GHashable arity (M1 i c a) where
+    ghashWithSalt targs salt = ghashWithSalt targs salt . unM1
 
 -- Constants, additional parameters, and rank-1 recursion
-instance Hashable a => GHashable (K1 i a) where
-    ghashWithSalt = hashUsing unK1
+instance Hashable a => GHashable arity (K1 i a) where
+    ghashWithSalt _ = hashUsing unK1
+
+instance GHashable One Par1 where
+    ghashWithSalt (ToHash1 h) salt = h salt . unPar1
+
+instance Hashable1 f => GHashable One (Rec1 f) where
+    ghashWithSalt (ToHash1 h) salt = liftHashWithSalt h salt . unRec1
 
-class GSum f where
-    hashSum :: Int -> Int -> Int -> f a -> Int
+class GSum arity f where
+    hashSum :: ToHash arity a -> Int -> Int -> Int -> f a -> Int
 
-instance (GSum a, GSum b, SumSize a, SumSize b) => GHashable (a :+: b) where
-    ghashWithSalt salt = hashSum salt 0 size
+instance (GSum arity a, GSum arity b, SumSize a, SumSize b) => GHashable arity (a :+: b) where
+    ghashWithSalt toHash salt = hashSum toHash salt 0 size
         where size = unTagged (sumSize :: Tagged (a :+: b))
 
-instance (GSum a, GSum b) => GSum (a :+: b) where
-    hashSum !salt !code !size s = case s of
-                                    L1 x -> hashSum salt code           sizeL x
-                                    R1 x -> hashSum salt (code + sizeL) sizeR x
-        where
-          sizeL = size `shiftR` 1
-          sizeR = size - sizeL
+instance (GSum arity a, GSum arity b) => GSum arity (a :+: b) where
+    hashSum toHash !salt !code !size s = case s of
+        L1 x -> hashSum toHash salt code           sizeL x
+        R1 x -> hashSum toHash salt (code + sizeL) sizeR x
+      where
+        sizeL = size `shiftR` 1
+        sizeR = size - sizeL
     {-# INLINE hashSum #-}
 
-instance GHashable a => GSum (C1 c a) where
-    hashSum !salt !code _ x = salt `hashWithSalt` code `ghashWithSalt` x
+instance GHashable arity a => GSum arity (C1 c a) where
+    hashSum toHash !salt !code _ (M1 x) = ghashWithSalt toHash (hashWithSalt salt code) x
+    {-# INLINE hashSum #-}
+
+instance GSum One Par1 where
+    hashSum (ToHash1 h) !salt !code _ (Par1 x) =
+      h (hashWithSalt salt code) x
     {-# INLINE hashSum #-}
 
 class SumSize f where
@@ -71,3 +85,4 @@ instance (SumSize a, SumSize b) => SumSize (a :+: b) where
 
 instance SumSize (C1 c a) where
     sumSize = Tagged 1
+

From 9779db914929391161d5fc90efef8a3e78e93c05 Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Wed, 19 Oct 2016 14:10:52 -0400
Subject: [PATCH 04/17] rename ToHash to HashArgs

---
 Data/Hashable/Class.hs   | 14 +++++++-------
 Data/Hashable/Generic.hs |  8 ++++----
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs
index e92786f..d634ae2 100644
--- a/Data/Hashable/Class.hs
+++ b/Data/Hashable/Class.hs
@@ -30,7 +30,7 @@ module Data.Hashable.Class
 #ifdef GENERICS
       -- ** Support for generics
     , GHashable(..)
-    , ToHash(..)
+    , HashArgs(..)
     , Zero
     , One
 #endif
@@ -199,18 +199,18 @@ class Hashable a where
 
 #ifdef GENERICS
     default hashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int
-    hashWithSalt salt = ghashWithSalt ToHash0 salt . from
+    hashWithSalt salt = ghashWithSalt HashArgs0 salt . from
 
 data Zero = Zero
 data One = One
 
-data ToHash arity a where
-    ToHash0 :: ToHash Zero a
-    ToHash1 :: (Int -> a -> Int) -> ToHash One a
+data HashArgs arity a where
+    HashArgs0 :: HashArgs Zero a
+    HashArgs1 :: (Int -> a -> Int) -> HashArgs One a
 
 -- | The class of types that can be generically hashed.
 class GHashable arity f where
-    ghashWithSalt :: ToHash arity a -> Int -> f a -> Int
+    ghashWithSalt :: HashArgs arity a -> Int -> f a -> Int
 
 #endif
 
@@ -219,7 +219,7 @@ class Hashable1 t where
     liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int
 #ifdef GENERICS
     default liftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int
-    liftHashWithSalt h salt = ghashWithSalt (ToHash1 h) salt . from1
+    liftHashWithSalt h salt = ghashWithSalt (HashArgs1 h) salt . from1
 #endif
 
 class Hashable2 t where
diff --git a/Data/Hashable/Generic.hs b/Data/Hashable/Generic.hs
index db1152c..113067a 100644
--- a/Data/Hashable/Generic.hs
+++ b/Data/Hashable/Generic.hs
@@ -44,13 +44,13 @@ instance Hashable a => GHashable arity (K1 i a) where
     ghashWithSalt _ = hashUsing unK1
 
 instance GHashable One Par1 where
-    ghashWithSalt (ToHash1 h) salt = h salt . unPar1
+    ghashWithSalt (HashArgs1 h) salt = h salt . unPar1
 
 instance Hashable1 f => GHashable One (Rec1 f) where
-    ghashWithSalt (ToHash1 h) salt = liftHashWithSalt h salt . unRec1
+    ghashWithSalt (HashArgs1 h) salt = liftHashWithSalt h salt . unRec1
 
 class GSum arity f where
-    hashSum :: ToHash arity a -> Int -> Int -> Int -> f a -> Int
+    hashSum :: HashArgs arity a -> Int -> Int -> Int -> f a -> Int
 
 instance (GSum arity a, GSum arity b, SumSize a, SumSize b) => GHashable arity (a :+: b) where
     ghashWithSalt toHash salt = hashSum toHash salt 0 size
@@ -70,7 +70,7 @@ instance GHashable arity a => GSum arity (C1 c a) where
     {-# INLINE hashSum #-}
 
 instance GSum One Par1 where
-    hashSum (ToHash1 h) !salt !code _ (Par1 x) =
+    hashSum (HashArgs1 h) !salt !code _ (Par1 x) =
       h (hashWithSalt salt code) x
     {-# INLINE hashSum #-}
 

From d84cfa5ddd997b7acc3bae5db1d2b6b26c642cea Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Wed, 19 Oct 2016 14:24:02 -0400
Subject: [PATCH 05/17] add composition instance, remove Par1 GSum instance

---
 Data/Hashable/Generic.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/Data/Hashable/Generic.hs b/Data/Hashable/Generic.hs
index 113067a..1e8d05b 100644
--- a/Data/Hashable/Generic.hs
+++ b/Data/Hashable/Generic.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures,
              ScopedTypeVariables, TypeOperators,
-             MultiParamTypeClasses, GADTs #-}
+             MultiParamTypeClasses, GADTs, FlexibleContexts #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 ------------------------------------------------------------------------
@@ -49,6 +49,9 @@ instance GHashable One Par1 where
 instance Hashable1 f => GHashable One (Rec1 f) where
     ghashWithSalt (HashArgs1 h) salt = liftHashWithSalt h salt . unRec1
 
+instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where
+    ghashWithSalt targs salt = liftHashWithSalt (ghashWithSalt targs) salt . unComp1
+
 class GSum arity f where
     hashSum :: HashArgs arity a -> Int -> Int -> Int -> f a -> Int
 
@@ -69,11 +72,6 @@ instance GHashable arity a => GSum arity (C1 c a) where
     hashSum toHash !salt !code _ (M1 x) = ghashWithSalt toHash (hashWithSalt salt code) x
     {-# INLINE hashSum #-}
 
-instance GSum One Par1 where
-    hashSum (HashArgs1 h) !salt !code _ (Par1 x) =
-      h (hashWithSalt salt code) x
-    {-# INLINE hashSum #-}
-
 class SumSize f where
     sumSize :: Tagged f
 

From 833efbfefbaf9230bab3f75a5daf8d5072af1e3c Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Wed, 19 Oct 2016 14:50:40 -0400
Subject: [PATCH 06/17] added more instances for Hashable1

---
 Data/Hashable/Class.hs | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs
index d634ae2..0624a86 100644
--- a/Data/Hashable/Class.hs
+++ b/Data/Hashable/Class.hs
@@ -144,6 +144,10 @@ import GHC.Exts (Word(..))
 #if MIN_VERSION_base(4,9,0)
 import qualified Data.List.NonEmpty as NE
 import Data.Semigroup
+
+import Data.Functor.Compose (Compose(..))
+import qualified Data.Functor.Product as FP
+import qualified Data.Functor.Sum as FS
 #endif
 
 #include "MachDeps.h"
@@ -687,6 +691,13 @@ instance Hashable a => Hashable1 (Const a) where
 instance Hashable2 Const where
     liftHashWithSalt2 f _ salt (Const x) = f salt x
 
+instance Hashable (Proxy a) where
+    hash _ = 0
+    hashWithSalt s _ = s
+
+instance Hashable1 Proxy where
+    liftHashWithSalt _ s _ = s
+
 -- instances formerly provided by 'semigroups' package
 #if MIN_VERSION_base(4,9,0)
 instance Hashable a => Hashable (NE.NonEmpty a) where
@@ -713,3 +724,24 @@ instance Hashable a => Hashable (WrappedMonoid a) where
 instance Hashable a => Hashable (Option a) where
     hashWithSalt p (Option a) = hashWithSalt p a
 #endif
+
+-- instances for @Data.Functor.{Product,Sum,Compose}@, present
+-- in base-4.9 and onward.
+#if MIN_VERSION_base(4,9,0)
+-- | In general, @hash (Compose x) ≠ hash x@. However, @hashWithSalt@ satisfies
+-- its variant of this equivalence.
+instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (Compose f g a) where
+    hashWithSalt s (Compose v) = liftHashWithSalt (liftHashWithSalt hashWithSalt) s v
+
+instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FP.Product f g a) where
+    hashWithSalt s (FP.Pair a b) = liftHashWithSalt
+      hashWithSalt
+      (liftHashWithSalt hashWithSalt s a)
+      b
+
+instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where
+    hashWithSalt s (FS.InL a) = liftHashWithSalt hashWithSalt (s `combine` 0) a
+    hashWithSalt s (FS.InR a) = liftHashWithSalt hashWithSalt (s `combine` distinguisher) a
+#endif
+
+

From aae100ea34fd6f4db9126801c1c3eb13005f36f5 Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Wed, 19 Oct 2016 16:16:48 -0400
Subject: [PATCH 07/17] add Hashable1 instance for Hashed. Add test that it
 abides by laws

---
 Data/Hashable.hs    |  6 ++++++
 tests/Properties.hs | 14 +++++++++++++-
 2 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/Data/Hashable.hs b/Data/Hashable.hs
index 5bb4a90..02518ac 100644
--- a/Data/Hashable.hs
+++ b/Data/Hashable.hs
@@ -235,6 +235,12 @@ instance Hashable a => Hashable (Hashed a) where
   hashWithSalt = defaultHashWithSalt
   hash (Hashed _ h) = h
 
+-- This instance is a little unsettling. It is unusal for
+-- 'liftHashWithSalt' to ignore its first argument when a
+-- value is actually available for it to work on.
+instance Hashable1 Hashed where
+  liftHashWithSalt _ s (Hashed _ h) = defaultHashWithSalt s h
+
 instance (IsString a, Hashable a) => IsString (Hashed a) where
   fromString s = let r = fromString s in Hashed r (hash r)
 
diff --git a/tests/Properties.hs b/tests/Properties.hs
index bb15f48..7a63cc4 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -9,7 +9,9 @@
 
 module Properties (properties) where
 
-import Data.Hashable (Hashable, hash, hashByteArray, hashPtr)
+import Data.Hashable (Hashable, hash, hashByteArray, hashPtr,
+         Hashed, hashed, unhashed, hashWithSalt)
+import Data.Hashable.Lifted (hashWithSalt1)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
@@ -208,6 +210,13 @@ pSum3_differ x = nub hs == hs
 
 #endif
 
+instance (Arbitrary a, Hashable a) => Arbitrary (Hashed a) where
+  arbitrary = fmap hashed arbitrary
+  shrink xs = map hashed $ shrink $ unhashed xs
+
+pLiftedHashed :: Int -> Hashed (Either Int String) -> Bool
+pLiftedHashed s h = hashWithSalt s h == hashWithSalt1 s h
+
 properties :: [Test]
 properties =
     [ testProperty "bernstein" pHash
@@ -239,6 +248,9 @@ properties =
       , testProperty "sum3_differ" pSum3_differ
       ]
 #endif
+    , testGroup "lifted law"
+      [ testProperty "Hashed" pLiftedHashed
+      ]
     ]
 
 ------------------------------------------------------------------------

From 0c090552fc6b6982d686a81a041a4aabc85bb1da Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Wed, 19 Oct 2016 17:18:51 -0400
Subject: [PATCH 08/17] Add Hashable1 instances for Compose,Product,Sum

---
 Data/Hashable/Class.hs | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs
index 0624a86..2e11225 100644
--- a/Data/Hashable/Class.hs
+++ b/Data/Hashable/Class.hs
@@ -731,17 +731,23 @@ instance Hashable a => Hashable (Option a) where
 -- | In general, @hash (Compose x) ≠ hash x@. However, @hashWithSalt@ satisfies
 -- its variant of this equivalence.
 instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (Compose f g a) where
-    hashWithSalt s (Compose v) = liftHashWithSalt (liftHashWithSalt hashWithSalt) s v
+    hashWithSalt = hashWithSalt1
+
+instance (Hashable1 f, Hashable1 g) => Hashable1 (Compose f g) where
+    liftHashWithSalt h s = liftHashWithSalt (liftHashWithSalt h) s . getCompose
+
+instance (Hashable1 f, Hashable1 g) => Hashable1 (FP.Product f g) where
+    liftHashWithSalt h s (FP.Pair a b) = liftHashWithSalt h (liftHashWithSalt h s a) b
 
 instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FP.Product f g a) where
-    hashWithSalt s (FP.Pair a b) = liftHashWithSalt
-      hashWithSalt
-      (liftHashWithSalt hashWithSalt s a)
-      b
+    hashWithSalt = hashWithSalt1
+
+instance (Hashable1 f, Hashable1 g) => Hashable1 (FS.Sum f g) where
+    liftHashWithSalt h s (FS.InL a) = liftHashWithSalt h (s `combine` 0) a
+    liftHashWithSalt h s (FS.InR a) = liftHashWithSalt h (s `combine` distinguisher) a
 
 instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where
-    hashWithSalt s (FS.InL a) = liftHashWithSalt hashWithSalt (s `combine` 0) a
-    hashWithSalt s (FS.InR a) = liftHashWithSalt hashWithSalt (s `combine` distinguisher) a
+    hashWithSalt = hashWithSalt1
 #endif
 
 

From ded8c87b6e8145d3da5765806fde0edcf12d39aa Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Thu, 20 Oct 2016 08:26:58 -0400
Subject: [PATCH 09/17] improve warnings for old GHCs

---
 Data/Hashable.hs       |  6 +++++-
 Data/Hashable/Class.hs | 10 +++++++---
 2 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/Data/Hashable.hs b/Data/Hashable.hs
index 02518ac..a288478 100644
--- a/Data/Hashable.hs
+++ b/Data/Hashable.hs
@@ -72,8 +72,12 @@ module Data.Hashable
 
 import Data.String (IsString(..))
 import Data.Typeable (Typeable)
-import Data.Foldable (Foldable(foldr))
 import Data.Hashable.Class
+
+#if !(MIN_VERSION_base(4,8,0))
+import Data.Foldable (Foldable(foldr))
+#endif
+
 #ifdef GENERICS
 import Data.Hashable.Generic ()
 #endif
diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs
index 2e11225..633029c 100644
--- a/Data/Hashable/Class.hs
+++ b/Data/Hashable/Class.hs
@@ -2,7 +2,7 @@
              ScopedTypeVariables, UnliftedFFITypes #-}
 #ifdef GENERICS
 {-# LANGUAGE DefaultSignatures, FlexibleContexts, GADTs,
-    MultiParamTypeClasses #-}
+    MultiParamTypeClasses, EmptyDataDecls #-}
 #endif
 
 ------------------------------------------------------------------------
@@ -76,6 +76,10 @@ import System.IO.Unsafe (unsafePerformIO)
 import System.Mem.StableName
 import Data.Unique (Unique, hashUnique)
 
+#if !(MIN_VERSION_base(4,7,0))
+import Data.Proxy (Proxy)
+#endif
+
 #if MIN_VERSION_base(4,7,0)
 import Data.Fixed (Fixed(..))
 #endif
@@ -205,8 +209,8 @@ class Hashable a where
     default hashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int
     hashWithSalt salt = ghashWithSalt HashArgs0 salt . from
 
-data Zero = Zero
-data One = One
+data Zero
+data One
 
 data HashArgs arity a where
     HashArgs0 :: HashArgs Zero a

From 7cd9bb47c59e31f8e406f6cbe8bcb1ddcb5d6cc0 Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Thu, 20 Oct 2016 09:02:13 -0400
Subject: [PATCH 10/17] add Eq1,Ord1,Show1 instances for Hashed, correct Show
 instance

---
 Data/Hashable.hs | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/Data/Hashable.hs b/Data/Hashable.hs
index a288478..1aff8b3 100644
--- a/Data/Hashable.hs
+++ b/Data/Hashable.hs
@@ -78,6 +78,10 @@ import Data.Hashable.Class
 import Data.Foldable (Foldable(foldr))
 #endif
 
+#if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..))
+#endif
+
 #ifdef GENERICS
 import Data.Hashable.Generic ()
 #endif
@@ -218,7 +222,7 @@ import Data.Hashable.Generic ()
 
 -- | A hashable value along with the result of the 'hash' function.
 data Hashed a = Hashed a {-# UNPACK #-} !Int
-  deriving (Typeable,Show)
+  deriving (Typeable)
 
 -- | Wrap a hashable value, caching the 'hash' function result.
 hashed :: Hashable a => a -> Hashed a
@@ -235,6 +239,9 @@ instance Eq a => Eq (Hashed a) where
 instance Ord a => Ord (Hashed a) where
   Hashed a _ `compare` Hashed b _ = a `compare` b
 
+instance Show a => Show (Hashed a) where
+  showsPrec d (Hashed a _) = showsUnaryWith showsPrec "hashed" d a
+
 instance Hashable a => Hashable (Hashed a) where
   hashWithSalt = defaultHashWithSalt
   hash (Hashed _ h) = h
@@ -251,3 +258,23 @@ instance (IsString a, Hashable a) => IsString (Hashed a) where
 instance Foldable Hashed where
   foldr f acc (Hashed a _) = f a acc
 
+-- instances for @Data.Functor.Classes@ higher rank typeclasses
+-- in base-4.9 and onward.
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 Hashed where
+  liftEq f (Hashed a ha) (Hashed b hb) = ha == hb && f a b
+
+instance Ord1 Hashed where
+  liftCompare f (Hashed a _) (Hashed b _) = f a b
+
+instance Show1 Hashed where
+  liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a
+#endif
+
+-- This function is copied from Data.Functor.Classes, which does
+-- not export it.
+showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
+showsUnaryWith sp name d x = showParen (d > 10) $
+    showString name . showChar ' ' . sp 11 x
+
+

From 088d7252e69ae9d777347b74d5b0ddff3fbab0cf Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Thu, 20 Oct 2016 09:11:20 -0400
Subject: [PATCH 11/17] remove unneeded constraint from Hashable Hashed
 instance

---
 Data/Hashable.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Data/Hashable.hs b/Data/Hashable.hs
index 1aff8b3..c2a48cd 100644
--- a/Data/Hashable.hs
+++ b/Data/Hashable.hs
@@ -242,7 +242,7 @@ instance Ord a => Ord (Hashed a) where
 instance Show a => Show (Hashed a) where
   showsPrec d (Hashed a _) = showsUnaryWith showsPrec "hashed" d a
 
-instance Hashable a => Hashable (Hashed a) where
+instance Hashable (Hashed a) where
   hashWithSalt = defaultHashWithSalt
   hash (Hashed _ h) = h
 

From acb9379417cb0ffdd444de1842319ba8ab7b5a79 Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Thu, 20 Oct 2016 09:15:46 -0400
Subject: [PATCH 12/17] use showsUnaryWith instead of redefining it

---
 Data/Hashable.hs | 12 +++---------
 1 file changed, 3 insertions(+), 9 deletions(-)

diff --git a/Data/Hashable.hs b/Data/Hashable.hs
index c2a48cd..52443cf 100644
--- a/Data/Hashable.hs
+++ b/Data/Hashable.hs
@@ -79,7 +79,7 @@ import Data.Foldable (Foldable(foldr))
 #endif
 
 #if MIN_VERSION_base(4,9,0)
-import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..))
+import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),showsUnaryWith)
 #endif
 
 #ifdef GENERICS
@@ -240,7 +240,8 @@ instance Ord a => Ord (Hashed a) where
   Hashed a _ `compare` Hashed b _ = a `compare` b
 
 instance Show a => Show (Hashed a) where
-  showsPrec d (Hashed a _) = showsUnaryWith showsPrec "hashed" d a
+  showsPrec d (Hashed a _) = showParen (d > 10) $
+    showString "hashed" . showChar ' ' . showsPrec 11 a
 
 instance Hashable (Hashed a) where
   hashWithSalt = defaultHashWithSalt
@@ -271,10 +272,3 @@ instance Show1 Hashed where
   liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a
 #endif
 
--- This function is copied from Data.Functor.Classes, which does
--- not export it.
-showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
-showsUnaryWith sp name d x = showParen (d > 10) $
-    showString name . showChar ' ' . sp 11 x
-
-

From 39d5b29ddd9c6e8b7e395fb481538b7de77e2559 Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Fri, 21 Oct 2016 15:54:00 -0400
Subject: [PATCH 13/17] add higher rank tuple instances, similar to grind in
 MMORPG

---
 Data/Hashable/Class.hs | 67 +++++++++++++++++++++++++++++++++++-------
 1 file changed, 56 insertions(+), 11 deletions(-)

diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs
index 633029c..5deaf7c 100644
--- a/Data/Hashable/Class.hs
+++ b/Data/Hashable/Class.hs
@@ -471,37 +471,73 @@ instance Hashable2 Either where
 
 instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where
     hash (a1, a2) = hash a1 `hashWithSalt` a2
-    hashWithSalt s (a1, a2) = s `hashWithSalt` a1 `hashWithSalt` a2
+    hashWithSalt = hashWithSalt1
+
+instance Hashable a1 => Hashable1 ((,) a1) where
+    liftHashWithSalt = defaultLiftHashWithSalt
+
+instance Hashable2 (,) where
+    liftHashWithSalt2 h1 h2 s (a1, a2) = s `h1` a1 `h2` a2
 
 instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where
     hash (a1, a2, a3) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3
-    hashWithSalt s (a1, a2, a3) = s `hashWithSalt` a1 `hashWithSalt` a2
-                        `hashWithSalt` a3
+    hashWithSalt = hashWithSalt1
+
+instance (Hashable a1, Hashable a2) => Hashable1 ((,,) a1 a2) where
+    liftHashWithSalt = defaultLiftHashWithSalt
+
+instance Hashable a1 => Hashable2 ((,,) a1) where
+    liftHashWithSalt2 h1 h2 s (a1, a2, a3) =
+      (s `hashWithSalt` a1) `h1` a2 `h2` a3
 
 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) =>
          Hashable (a1, a2, a3, a4) where
     hash (a1, a2, a3, a4) = hash a1 `hashWithSalt` a2
                             `hashWithSalt` a3 `hashWithSalt` a4
-    hashWithSalt s (a1, a2, a3, a4) = s `hashWithSalt` a1 `hashWithSalt` a2
-                            `hashWithSalt` a3 `hashWithSalt` a4
+    hashWithSalt = hashWithSalt1
+
+instance (Hashable a1, Hashable a2, Hashable a3) => Hashable1 ((,,,) a1 a2 a3) where
+    liftHashWithSalt = defaultLiftHashWithSalt
+
+instance (Hashable a1, Hashable a2) => Hashable2 ((,,,) a1 a2) where
+    liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4) =
+      (s `hashWithSalt` a1 `hashWithSalt` a2) `h1` a3 `h2` a4
 
 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5)
       => Hashable (a1, a2, a3, a4, a5) where
     hash (a1, a2, a3, a4, a5) =
         hash a1 `hashWithSalt` a2 `hashWithSalt` a3
         `hashWithSalt` a4 `hashWithSalt` a5
-    hashWithSalt s (a1, a2, a3, a4, a5) =
-        s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3
-        `hashWithSalt` a4 `hashWithSalt` a5
+    hashWithSalt = hashWithSalt1
+
+instance (Hashable a1, Hashable a2, Hashable a3,
+          Hashable a4) => Hashable1 ((,,,,) a1 a2 a3 a4) where
+    liftHashWithSalt = defaultLiftHashWithSalt
+
+instance (Hashable a1, Hashable a2, Hashable a3)
+      => Hashable2 ((,,,,) a1 a2 a3) where
+    liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5) =
+      (s `hashWithSalt` a1 `hashWithSalt` a2
+         `hashWithSalt` a3) `h1` a4 `h2` a5
+
 
 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5,
           Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6) where
     hash (a1, a2, a3, a4, a5, a6) =
         hash a1 `hashWithSalt` a2 `hashWithSalt` a3
         `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6
-    hashWithSalt s (a1, a2, a3, a4, a5, a6) =
-        s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3
-        `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6
+    hashWithSalt = hashWithSalt1
+
+instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4,
+          Hashable a5) => Hashable1 ((,,,,,) a1 a2 a3 a4 a5) where
+    liftHashWithSalt = defaultLiftHashWithSalt
+
+instance (Hashable a1, Hashable a2, Hashable a3,
+          Hashable a4) => Hashable2 ((,,,,,) a1 a2 a3 a4) where
+    liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6) =
+      (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3
+         `hashWithSalt` a4) `h1` a5 `h2` a6
+
 
 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5,
           Hashable a6, Hashable a7) =>
@@ -513,6 +549,15 @@ instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5,
         s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3
         `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7
 
+instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable1 ((,,,,,,) a1 a2 a3 a4 a5 a6) where
+    liftHashWithSalt = defaultLiftHashWithSalt
+
+instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4,
+          Hashable a5) => Hashable2 ((,,,,,,) a1 a2 a3 a4 a5) where
+    liftHashWithSalt2 h1 h2 s (a1, a2, a3, a4, a5, a6, a7) =
+      (s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3
+         `hashWithSalt` a4 `hashWithSalt` a5) `h1` a6 `h2` a7
+
 instance Hashable (StableName a) where
     hash = hashStableName
     hashWithSalt = defaultHashWithSalt

From fb9616be85feeb46fe0cadbcf920d73f9f89ad7c Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Sat, 22 Oct 2016 13:16:24 -0400
Subject: [PATCH 14/17] Added examples for testing that hashes have not changed

---
 examples/Main.hs | 27 +++++++++++++++++++++++++++
 hashable.cabal   | 14 ++++++++++++++
 2 files changed, 41 insertions(+)
 create mode 100644 examples/Main.hs

diff --git a/examples/Main.hs b/examples/Main.hs
new file mode 100644
index 0000000..10f79ab
--- /dev/null
+++ b/examples/Main.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE DeriveGeneric #-}
+import Data.Hashable
+import GHC.Generics (Generic)
+
+data Foo
+  = Foo1 Int Char Bool
+  | Foo2 String ()
+  deriving (Generic)
+
+instance Hashable Foo
+
+data Bar = Bar Double Float
+  deriving (Generic)
+
+instance Hashable Bar
+
+-- printHash :: (Hashable a, Show a) => a -> IO ()
+-- printHash = print . hash
+
+main :: IO ()
+main = do
+  putStrLn "Hashing Foo1"
+  print . hash $ Foo1 22 'y' True
+  putStrLn "Hashing Foo2"
+  print . hash $ Foo2 "hello" ()
+  putStrLn "Hashing Bar"
+  print . hash $ Bar 55.50 9.125
diff --git a/hashable.cabal b/hashable.cabal
index 046f93f..d3c6705 100644
--- a/hashable.cabal
+++ b/hashable.cabal
@@ -37,6 +37,11 @@ Flag sse41
   Default: False
   Manual: True
 
+Flag examples
+  Description: Build example modules
+  Default: False
+  Manual: True
+
 Library
   Exposed-modules:   Data.Hashable
                      Data.Hashable.Lifted
@@ -148,6 +153,15 @@ benchmark benchmarks
     if os(windows)
       extra-libraries: advapi32
 
+
+Executable hashable-examples
+  if flag(examples)
+    build-depends: base, hashable
+  else
+    buildable: False
+  hs-source-dirs: examples
+  main-is: Main.hs
+
 source-repository head
   type:     git
   location: https://github.com/tibbe/hashable.git

From 77fd41a95e9fc74fc6d1ea53311b084d0f909215 Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Sat, 22 Oct 2016 13:46:04 -0400
Subject: [PATCH 15/17] make generic hashable of sums same as before

---
 Data/Hashable/Generic.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/Data/Hashable/Generic.hs b/Data/Hashable/Generic.hs
index 1e8d05b..55ca2cc 100644
--- a/Data/Hashable/Generic.hs
+++ b/Data/Hashable/Generic.hs
@@ -69,7 +69,8 @@ instance (GSum arity a, GSum arity b) => GSum arity (a :+: b) where
     {-# INLINE hashSum #-}
 
 instance GHashable arity a => GSum arity (C1 c a) where
-    hashSum toHash !salt !code _ (M1 x) = ghashWithSalt toHash (hashWithSalt salt code) x
+    -- hashSum toHash !salt !code _ (M1 x) = ghashWithSalt toHash (hashWithSalt salt code) x
+    hashSum toHash !salt !code _ (M1 x) = hashWithSalt salt (ghashWithSalt toHash code x)
     {-# INLINE hashSum #-}
 
 class SumSize f where

From a7f702b8f2f343f6c87c20ac308aa34ad03f042f Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Sat, 22 Oct 2016 15:04:10 -0400
Subject: [PATCH 16/17] add benchmarks for generics

---
 benchmarks/Benchmarks.hs | 29 ++++++++++++++++++++++++++++-
 hashable.cabal           |  3 +++
 2 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/benchmarks/Benchmarks.hs b/benchmarks/Benchmarks.hs
index 4f81718..331642e 100644
--- a/benchmarks/Benchmarks.hs
+++ b/benchmarks/Benchmarks.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,
-    UnboxedTuples #-}
+    UnboxedTuples, DeriveGeneric #-}
 
 module Main (main) where
 
@@ -15,6 +15,7 @@ import Data.Word
 import Foreign.C.Types (CInt(..), CLong(..), CSize(..))
 import Foreign.Ptr
 import Data.ByteString.Internal
+import GHC.Generics (Generic)
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
@@ -35,6 +36,10 @@ main = do
     let !mb = 2^(20 :: Int)  -- 1 Mb
     fp1Mb <- mallocForeignPtrBytes mb
 
+    let exP = P 22.0203 234.19 'x' 6424
+        exS = S3
+        exPS = PS3 'z' 7715
+
     -- We don't care about the contents of these either.
     let !ba5 = new 5;     !ba8 = new 8;     !ba11 = new 11; !ba40 = new 40
         !ba128 = new 128; !ba512 = new 512; !ba1Mb = new mb
@@ -251,6 +256,11 @@ main = do
           , bench "jenkins32a" $ whnf hash_jenkins_32a 0xdeadbeef
           , bench "jenkins32b" $ whnf hash_jenkins_32b 0xdeadbeef
           ]
+        , bgroup "Generic"
+          [ bench "product" $ whnf hash exP
+          , bench "sum" $ whnf hash exS
+          , bench "product and sum" $ whnf hash exPS
+          ]
         ]
 
 data ByteArray = BA { unBA :: !ByteArray# }
@@ -285,3 +295,20 @@ foreign import ccall unsafe "hash_jenkins_32a" hash_jenkins_32a
     :: Word32 -> Word32
 foreign import ccall unsafe "hash_jenkins_32b" hash_jenkins_32b
     :: Word32 -> Word32
+
+data PS
+  = PS1 Int Char Bool
+  | PS2 String ()
+  | PS3 Char Int
+  deriving (Generic)
+
+data P = P Double Float Char Int
+  deriving (Generic)
+
+data S = S1 | S2 | S3 | S4 | S5
+  deriving (Generic)
+
+instance Hashable PS
+instance Hashable P
+instance Hashable S
+
diff --git a/hashable.cabal b/hashable.cabal
index d3c6705..633cfbd 100644
--- a/hashable.cabal
+++ b/hashable.cabal
@@ -122,6 +122,9 @@ benchmark benchmarks
   if impl(ghc) && flag(integer-gmp)
     Build-depends:   integer-gmp >= 0.2
 
+  if impl(ghc >= 7.2.1)
+    CPP-Options:     -DGENERICS
+
   include-dirs:
     benchmarks/cbits
 

From b6b9f6d6e26abab0ea81867c3cef762f160a1eac Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Sat, 22 Oct 2016 15:41:10 -0400
Subject: [PATCH 17/17] moved Hashed into Class module

---
 Data/Hashable.hs       | 62 ------------------------------------------
 Data/Hashable/Class.hs | 59 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+), 62 deletions(-)

diff --git a/Data/Hashable.hs b/Data/Hashable.hs
index 52443cf..5dcdd97 100644
--- a/Data/Hashable.hs
+++ b/Data/Hashable.hs
@@ -70,18 +70,8 @@ module Data.Hashable
     , unhashed
     ) where
 
-import Data.String (IsString(..))
-import Data.Typeable (Typeable)
 import Data.Hashable.Class
 
-#if !(MIN_VERSION_base(4,8,0))
-import Data.Foldable (Foldable(foldr))
-#endif
-
-#if MIN_VERSION_base(4,9,0)
-import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),showsUnaryWith)
-#endif
-
 #ifdef GENERICS
 import Data.Hashable.Generic ()
 #endif
@@ -220,55 +210,3 @@ import Data.Hashable.Generic ()
 -- >     hashWithSalt s (Months n) = s `hashWithSalt`
 -- >                                 (2::Int) `hashWithSalt` n
 
--- | A hashable value along with the result of the 'hash' function.
-data Hashed a = Hashed a {-# UNPACK #-} !Int
-  deriving (Typeable)
-
--- | Wrap a hashable value, caching the 'hash' function result.
-hashed :: Hashable a => a -> Hashed a
-hashed a = Hashed a (hash a)
-
--- | Unwrap hashed value.
-unhashed :: Hashed a -> a
-unhashed (Hashed a _) = a
-
--- | Uses precomputed hash to detect inequality faster
-instance Eq a => Eq (Hashed a) where
-  Hashed a ha == Hashed b hb = ha == hb && a == b
-
-instance Ord a => Ord (Hashed a) where
-  Hashed a _ `compare` Hashed b _ = a `compare` b
-
-instance Show a => Show (Hashed a) where
-  showsPrec d (Hashed a _) = showParen (d > 10) $
-    showString "hashed" . showChar ' ' . showsPrec 11 a
-
-instance Hashable (Hashed a) where
-  hashWithSalt = defaultHashWithSalt
-  hash (Hashed _ h) = h
-
--- This instance is a little unsettling. It is unusal for
--- 'liftHashWithSalt' to ignore its first argument when a
--- value is actually available for it to work on.
-instance Hashable1 Hashed where
-  liftHashWithSalt _ s (Hashed _ h) = defaultHashWithSalt s h
-
-instance (IsString a, Hashable a) => IsString (Hashed a) where
-  fromString s = let r = fromString s in Hashed r (hash r)
-
-instance Foldable Hashed where
-  foldr f acc (Hashed a _) = f a acc
-
--- instances for @Data.Functor.Classes@ higher rank typeclasses
--- in base-4.9 and onward.
-#if MIN_VERSION_base(4,9,0)
-instance Eq1 Hashed where
-  liftEq f (Hashed a ha) (Hashed b hb) = ha == hb && f a b
-
-instance Ord1 Hashed where
-  liftCompare f (Hashed a _) (Hashed b _) = f a b
-
-instance Show1 Hashed where
-  liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a
-#endif
-
diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs
index 5deaf7c..698ceb3 100644
--- a/Data/Hashable/Class.hs
+++ b/Data/Hashable/Class.hs
@@ -46,6 +46,10 @@ module Data.Hashable.Class
     , hashWithSalt1
     , hashWithSalt2
     , defaultLiftHashWithSalt
+    -- * Caching hashes
+    , Hashed
+    , hashed
+    , unhashed
     ) where
 
 import Control.Applicative (Const(..))
@@ -148,12 +152,15 @@ import GHC.Exts (Word(..))
 #if MIN_VERSION_base(4,9,0)
 import qualified Data.List.NonEmpty as NE
 import Data.Semigroup
+import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),showsUnaryWith)
 
 import Data.Functor.Compose (Compose(..))
 import qualified Data.Functor.Product as FP
 import qualified Data.Functor.Sum as FS
 #endif
 
+import Data.String (IsString(..))
+
 #include "MachDeps.h"
 
 infixl 0 `hashWithSalt`
@@ -799,4 +806,56 @@ instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where
     hashWithSalt = hashWithSalt1
 #endif
 
+-- | A hashable value along with the result of the 'hash' function.
+data Hashed a = Hashed a {-# UNPACK #-} !Int
+  deriving (Typeable)
+
+-- | Wrap a hashable value, caching the 'hash' function result.
+hashed :: Hashable a => a -> Hashed a
+hashed a = Hashed a (hash a)
+
+-- | Unwrap hashed value.
+unhashed :: Hashed a -> a
+unhashed (Hashed a _) = a
+
+-- | Uses precomputed hash to detect inequality faster
+instance Eq a => Eq (Hashed a) where
+  Hashed a ha == Hashed b hb = ha == hb && a == b
+
+instance Ord a => Ord (Hashed a) where
+  Hashed a _ `compare` Hashed b _ = a `compare` b
+
+instance Show a => Show (Hashed a) where
+  showsPrec d (Hashed a _) = showParen (d > 10) $
+    showString "hashed" . showChar ' ' . showsPrec 11 a
+
+instance Hashable (Hashed a) where
+  hashWithSalt = defaultHashWithSalt
+  hash (Hashed _ h) = h
+
+-- This instance is a little unsettling. It is unusal for
+-- 'liftHashWithSalt' to ignore its first argument when a
+-- value is actually available for it to work on.
+instance Hashable1 Hashed where
+  liftHashWithSalt _ s (Hashed _ h) = defaultHashWithSalt s h
+
+instance (IsString a, Hashable a) => IsString (Hashed a) where
+  fromString s = let r = fromString s in Hashed r (hash r)
+
+instance Foldable Hashed where
+  foldr f acc (Hashed a _) = f a acc
+
+-- instances for @Data.Functor.Classes@ higher rank typeclasses
+-- in base-4.9 and onward.
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 Hashed where
+  liftEq f (Hashed a ha) (Hashed b hb) = ha == hb && f a b
+
+instance Ord1 Hashed where
+  liftCompare f (Hashed a _) (Hashed b _) = f a b
+
+instance Show1 Hashed where
+  liftShowsPrec sp _ d (Hashed a _) = showsUnaryWith sp "hashed" d a
+#endif
+