Hello community,
here is the log from the commit of package ghc-hashable for openSUSE:Factory checked in at 2017-03-14 10:04:46
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hashable (Old)
and /work/SRC/openSUSE:Factory/.ghc-hashable.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hashable"
Tue Mar 14 10:04:46 2017 rev:10 rq:461632 version:1.2.5.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-hashable/ghc-hashable.changes 2016-07-21 08:12:13.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-hashable.new/ghc-hashable.changes 2017-03-14 10:04:49.079067071 +0100
@@ -1,0 +2,5 @@
+Sun Feb 12 14:20:09 UTC 2017 - psimons@suse.com
+
+- Update to version 1.2.5.0 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
hashable-1.2.4.0.tar.gz
New:
----
hashable-1.2.5.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hashable.spec ++++++
--- /var/tmp/diff_new_pack.qHrcHi/_old 2017-03-14 10:04:49.806964001 +0100
+++ /var/tmp/diff_new_pack.qHrcHi/_new 2017-03-14 10:04:49.810963435 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-hashable
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,15 +19,14 @@
%global pkg_name hashable
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 1.2.4.0
+Version: 1.2.5.0
Release: 0
Summary: A class for types that can be converted to a hash value
License: BSD-3-Clause
-Group: System/Libraries
+Group: Development/Languages/Other
Url: https://hackage.haskell.org/package/%{pkg_name}
Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
-# Begin cabal-rpm deps:
BuildRequires: ghc-bytestring-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-text-devel
@@ -41,7 +40,6 @@
BuildRequires: ghc-test-framework-quickcheck2-devel
BuildRequires: ghc-unix-devel
%endif
-# End cabal-rpm deps
%description
This package defines a class, 'Hashable', for types that can be converted to a
@@ -63,23 +61,17 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-
%build
%ifarch i586
%define cabal_configure_options -f"-sse2"
%endif
%ghc_lib_build
-
%install
%ghc_lib_install
-
%check
-%if %{with tests}
-%{cabal} test
-%endif
-
+%cabal_test
%post devel
%ghc_pkg_recache
@@ -93,6 +85,6 @@
%files devel -f %{name}-devel.files
%defattr(-,root,root,-)
-%doc README.md
+%doc CHANGES.md README.md examples
%changelog
++++++ hashable-1.2.4.0.tar.gz -> hashable-1.2.5.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/CHANGES.md new/hashable-1.2.5.0/CHANGES.md
--- old/hashable-1.2.4.0/CHANGES.md 2016-01-14 20:32:59.000000000 +0100
+++ new/hashable-1.2.5.0/CHANGES.md 2017-01-02 09:44:38.000000000 +0100
@@ -1,3 +1,11 @@
+## Version 1.2.5.0
+
+ * Add `Hashable1` and `Hashable2`
+
+ * Add instances for: `Eq1`, `Ord1`, `Show1`, `Ptr`, `FunPtr`, `IntPtr`, `WordPtr`
+
+ * Add `Hashed` type for caching the `hash` function result.
+
## Version 1.2.4.0
* Add instances for: Unique, Version, Fixed, NonEmpty, Min, Max, Arg,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/Data/Hashable/Class.hs new/hashable-1.2.5.0/Data/Hashable/Class.hs
--- old/hashable-1.2.4.0/Data/Hashable/Class.hs 2016-01-14 20:32:59.000000000 +0100
+++ new/hashable-1.2.5.0/Data/Hashable/Class.hs 2017-01-02 09:44:38.000000000 +0100
@@ -1,7 +1,8 @@
{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,
- ScopedTypeVariables, UnliftedFFITypes #-}
+ ScopedTypeVariables, UnliftedFFITypes, DeriveDataTypeable #-}
#ifdef GENERICS
-{-# LANGUAGE DefaultSignatures, FlexibleContexts #-}
+{-# LANGUAGE DefaultSignatures, FlexibleContexts, GADTs,
+ MultiParamTypeClasses, EmptyDataDecls #-}
#endif
------------------------------------------------------------------------
@@ -24,9 +25,14 @@
(
-- * Computing hash values
Hashable(..)
+ , Hashable1(..)
+ , Hashable2(..)
#ifdef GENERICS
-- ** Support for generics
, GHashable(..)
+ , HashArgs(..)
+ , Zero
+ , One
#endif
-- * Creating new instances
@@ -35,8 +41,20 @@
, hashPtrWithSalt
, hashByteArray
, hashByteArrayWithSalt
+ , defaultHashWithSalt
+ -- * Higher Rank Functions
+ , hashWithSalt1
+ , hashWithSalt2
+ , defaultLiftHashWithSalt
+ -- * Caching hashes
+ , Hashed
+ , hashed
+ , unhashed
+ , mapHashed
+ , traverseHashed
) where
+import Control.Applicative (Const(..))
import Control.Exception (assert)
import Data.Bits (shiftL, shiftR, xor)
import qualified Data.ByteString as B
@@ -50,12 +68,12 @@
import qualified Data.Text.Array as TA
import qualified Data.Text.Internal as T
import qualified Data.Text.Lazy as TL
-import Data.Typeable
+import Data.Typeable (Typeable, TypeRep)
import Data.Version (Version(..))
import Data.Word (Word8, Word16, Word32, Word64)
import Foreign.C (CString)
import Foreign.Marshal.Utils (with)
-import Foreign.Ptr (Ptr, castPtr)
+import Foreign.Ptr (Ptr, FunPtr, IntPtr, WordPtr, castPtr, castFunPtrToPtr, ptrToIntPtr)
import Foreign.Storable (alignment, peek, sizeOf)
import GHC.Base (ByteArray#)
import GHC.Conc (ThreadId(..))
@@ -64,19 +82,33 @@
import System.Mem.StableName
import Data.Unique (Unique, hashUnique)
+-- As we use qualified F.Foldable, we don't get warnings with newer base
+import qualified Data.Foldable as F
+
+#if MIN_VERSION_base(4,7,0)
+import Data.Proxy (Proxy)
+#endif
+
#if MIN_VERSION_base(4,7,0)
import Data.Fixed (Fixed(..))
#endif
+#if MIN_VERSION_base(4,8,0)
+import Data.Functor.Identity (Identity(..))
+#endif
+
#ifdef GENERICS
import GHC.Generics
#endif
#if __GLASGOW_HASKELL__ >= 710
+import Data.Typeable (typeRepFingerprint)
import GHC.Fingerprint.Type(Fingerprint(..))
#elif __GLASGOW_HASKELL__ >= 702
-import Data.Typeable.Internal(TypeRep(..))
+import Data.Typeable.Internal (TypeRep (..))
import GHC.Fingerprint.Type(Fingerprint(..))
+#elif __GLASGOW_HASKELL__ >= 606
+import Data.Typeable (typeRepKey)
#endif
#if __GLASGOW_HASKELL__ >= 703
@@ -128,8 +160,15 @@
#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`
@@ -182,14 +221,52 @@
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 HashArgs0 salt . from
+
+data Zero
+data One
+
+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 f where
- ghashWithSalt :: Int -> f a -> Int
+class GHashable arity f where
+ ghashWithSalt :: HashArgs 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 (HashArgs1 h) salt . from1
#endif
+class Hashable2 t where
+ -- | 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
+
+-- | 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
@@ -389,48 +466,93 @@
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
- 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) =>
@@ -442,6 +564,15 @@
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
@@ -451,10 +582,13 @@
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)
+ step (SP s l) x = SP (h s x) (l + 1)
instance Hashable B.ByteString where
hashWithSalt salt bs = B.inlinePerformIO $
@@ -493,6 +627,20 @@
hash = hashThreadId
hashWithSalt = defaultHashWithSalt
+instance Hashable (Ptr a) where
+ hashWithSalt salt p = hashWithSalt salt $ ptrToIntPtr p
+
+instance Hashable (FunPtr a) where
+ hashWithSalt salt p = hashWithSalt salt $ castFunPtrToPtr p
+
+instance Hashable IntPtr where
+ hash n = fromIntegral n
+ hashWithSalt = defaultHashWithSalt
+
+instance Hashable WordPtr where
+ hash n = fromIntegral n
+ hashWithSalt = defaultHashWithSalt
+
-- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly.
hashTypeRep :: TypeRep -> Int
{-# INLINE hashTypeRep #-}
@@ -583,8 +731,37 @@
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 = 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
+
+#if MIN_VERSION_base(4,7,0)
+instance Hashable (Proxy a) where
+ hash _ = 0
+ hashWithSalt s _ = s
+
+instance Hashable1 Proxy where
+ liftHashWithSalt _ s _ = s
#endif
-- instances formerly provided by 'semigroups' package
@@ -613,3 +790,90 @@
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 = 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 = 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 = 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 F.Foldable Hashed where
+ foldr f acc (Hashed a _) = f a acc
+
+-- | 'Hashed' cannot be 'Functor'
+mapHashed :: Hashable b => (a -> b) -> Hashed a -> Hashed b
+mapHashed f (Hashed a _) = hashed (f a)
+
+-- | 'Hashed' cannot be 'Traversable'
+traverseHashed :: (Hashable b, Functor f) => (a -> f b) -> Hashed a -> f (Hashed b)
+traverseHashed f (Hashed a _) = fmap hashed (f a)
+
+-- 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/Data/Hashable/Generic.hs new/hashable-1.2.5.0/Data/Hashable/Generic.hs
--- old/hashable-1.2.4.0/Data/Hashable/Generic.hs 2016-01-14 20:32:59.000000000 +0100
+++ new/hashable-1.2.5.0/Data/Hashable/Generic.hs 2017-01-02 09:44:38.000000000 +0100
@@ -1,5 +1,6 @@
{-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures,
- ScopedTypeVariables, TypeOperators #-}
+ ScopedTypeVariables, TypeOperators,
+ MultiParamTypeClasses, GADTs, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
------------------------------------------------------------------------
@@ -21,43 +22,55 @@
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 (HashArgs1 h) salt = h salt . unPar1
+
+instance Hashable1 f => GHashable One (Rec1 f) where
+ ghashWithSalt (HashArgs1 h) salt = liftHashWithSalt h salt . unRec1
-class GSum f where
- hashSum :: Int -> Int -> Int -> f a -> Int
+instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where
+ ghashWithSalt targs salt = liftHashWithSalt (ghashWithSalt targs) salt . unComp1
-instance (GSum a, GSum b, SumSize a, SumSize b) => GHashable (a :+: b) where
- ghashWithSalt salt = hashSum salt 0 size
+class GSum arity f where
+ 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
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
+ hashSum toHash !salt !code _ (M1 x) = hashWithSalt salt (ghashWithSalt toHash code x)
{-# INLINE hashSum #-}
class SumSize f where
@@ -71,3 +84,4 @@
instance SumSize (C1 c a) where
sumSize = Tagged 1
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/Data/Hashable/Lifted.hs new/hashable-1.2.5.0/Data/Hashable/Lifted.hs
--- old/hashable-1.2.4.0/Data/Hashable/Lifted.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/hashable-1.2.5.0/Data/Hashable/Lifted.hs 2017-01-02 09:44:38.000000000 +0100
@@ -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 => Hashable1 (Free f) where
+-- > liftHashWithSalt h = go where
+-- > go s x = case x of
+-- > Pure a -> h s a
+-- > Free p -> liftHashWithSalt go s 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) => Hashable (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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/Data/Hashable.hs new/hashable-1.2.5.0/Data/Hashable.hs
--- old/hashable-1.2.4.0/Data/Hashable.hs 2016-01-14 20:32:59.000000000 +0100
+++ new/hashable-1.2.5.0/Data/Hashable.hs 2017-01-02 09:44:38.000000000 +0100
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
@@ -63,9 +64,16 @@
, hashByteArray
, hashByteArrayWithSalt
#endif
+ -- * Caching hashes
+ , Hashed
+ , hashed
+ , unhashed
+ , mapHashed
+ , traverseHashed
) where
import Data.Hashable.Class
+
#ifdef GENERICS
import Data.Hashable.Generic ()
#endif
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/benchmarks/Benchmarks.hs new/hashable-1.2.5.0/benchmarks/Benchmarks.hs
--- old/hashable-1.2.4.0/benchmarks/Benchmarks.hs 2016-01-14 20:32:59.000000000 +0100
+++ new/hashable-1.2.5.0/benchmarks/Benchmarks.hs 2017-01-02 09:44:38.000000000 +0100
@@ -1,5 +1,5 @@
{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,
- UnboxedTuples #-}
+ UnboxedTuples, DeriveGeneric #-}
module Main (main) where
@@ -15,6 +15,7 @@
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 @@
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 @@
, 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 @@
:: 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hashable-1.2.4.0/benchmarks/cbits/siphash.h new/hashable-1.2.5.0/benchmarks/cbits/siphash.h
--- old/hashable-1.2.4.0/benchmarks/cbits/siphash.h 1970-01-01 01:00:00.000000000 +0100
+++ new/hashable-1.2.5.0/benchmarks/cbits/siphash.h 2017-01-02 09:44:38.000000000 +0100
@@ -0,0 +1,68 @@
+#ifndef _hashable_siphash_h
+#define _hashable_siphash_h
+
+#include