hashable-1.4.4.0/0000755000000000000000000000000007346545000011616 5ustar0000000000000000hashable-1.4.4.0/CHANGES.md0000644000000000000000000002050507346545000013212 0ustar0000000000000000See also https://pvp.haskell.org/faq ## Version 1.4.4.0 * Depend on `os-string-2` for GHC-9.2+ * Support `filepath-1.5` ## Version 1.4.3.0 * Export `defaultHashWithSalt` and `defaultHash`. * Fix issue of tuples with 0 first component causing all-zero state. * Change `hashInt` to mix bits more. ## Version 1.4.2.0 * Fix the foreign signature of `getThreadId` https://github.com/haskell-unordered-containers/hashable/pull/263 * Drop support for GHCs prior GHC-8.2 The recent `unordered-containers` releases support only GHC-8.2+ * Add instance for `OsString`, `PosixString`, `WindowsString` from `filepath-1.4.100.1` * Add `Hashable ByteArray` instance using `data-array-byte` compat package ## Version 1.4.1.0 * Add instance for `Data.Array.Byte.ByteArray`. ## Version 1.4.0.2 * Restore older GHC support * Support GHC-9.0.2 ## Version 1.4.0.1 * `text-2.0` compatibility ## Version 1.4.0.0 * `Eq` is now a superclass of `Hashable`. Also `Eq1` is a superclass of `Hashable1` and `Eq2` is a superclass of `Hashable2` when exists. * Remove `Hashable1 Fixed` instance * Remove `Hashable1 Semi.Min/Max/...` instances as they don't have `Eq1` instance. ## Version 1.3.5.0 * Add `Solo` instance (base-4.15+, GHC-9+) ## Version 1.3.4.1 * Fix compilation on 32 bit platforms * Fix `Tree` instance ## Version 1.3.4.0 * `Text` and `ByteString` hashes include length. This fixes a variant of https://github.com/haskell-unordered-containers/hashable/issues/74 for texts and bytestrings. https://github.com/haskell-unordered-containers/hashable/pull/223 * Use correct prime in `combine`. This should improve the hash quality of compound structures on 64bit systems. https://github.com/haskell-unordered-containers/hashable/pull/224 * Add instance for types in `containers` package https://github.com/haskell-unordered-containers/hashable/pull/226 * Change `Int`, `Int64` and `Word64` `hashWithSalt` slightly. https://github.com/haskell-unordered-containers/hashable/pull/227 ## Version 1.3.3.0 * `Text` hashing uses 64-bit FNV prime * Don't truncate Text hashvalues on 64bit Windows: https://github.com/haskell-unordered-containers/hashable/pull/211 ## Version 1.3.2.0 * Add `Hashable (Fixed a)` for `base <4.7` versions. * Add documentation: - `hashable` is not a stable hash - `hashWithSalt` may return negative values - there is `time-compat` with `Hashable` instances for `time` types. * Add `random-initial-seed` flag causing the initial seed to be randomized on each start of an executable using `hashable`. ## Version 1.3.1.0 * Add `Hashable1` instances to `semigroups` types. * Use `ghc-bignum` with GHC-9.0 * Use FNV-1 constants. * Make `hashable-examples` a test-suite ## Version 1.3.0.0 * Semantic change of `Hashable Arg` instance to *not* hash the second argument of `Arg` in order to be consistent with `Eq Arg` (#171) * Semantic change of `Hashable Float` and `Hashable Double` instances to hash `-0.0` and `0.0` to the same value (#173) * Add `Hashable` instance for `Fingerprint` (#156) * Add new `Data.Hashable.Generic` module providing the default implementations `genericHashWithSalt` and `genericLiftHashWithSalt` together with other Generics support helpers (#148, #178) * Bump minimum version requirement of `base` to `base-4.5` (i.e. GHC >= 7.4) ---- ## Version 1.2.7.0 * Add `Hashable` and `Hashable1` instances for `Complex` * Fix undefined behavior in `hashable_fn_hash()` implementation due to signed integer overflow (#152) * Mark `Data.Hashable.Lifted` as `Trustworthy` (re SafeHaskell) * Support GHC 8.4 ## Version 1.2.6.1 * Use typeRepFingerprint from Type.Reflection.Unsafe * Bump minimum version of base to 4.4. ## Version 1.2.6.0 * Add support for type-indexed `Typeable`. * Rework the `Generic` hashable for sums. ## 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, First, Last, WrappedMonoid, Option * Support GHC 8.0 ## Version 1.2.3.3 * Support integer-simple. ## Version 1.2.3.2 * Add support for GHC 7.10 typeRepFingerprint ## Version 1.2.3.1 * Added support for random 1.1.*. ## Version 1.2.3.0 * Silence integer literal overflow warning * Add support for GHC 7.10 `integer-gmp2` & `Natural` * Add instance for Data.Void * Make the SSE .cabal flags manual * Add an upper bound on bytestring ## Version 1.2.2.0 * Add instances for `Data.ByteString.Short` * Use a 32-bit default salt on 32-bit archs. ## Version 1.2.1.0 * Revert instances to their 1.1 implementations to regain the performance we had then. * Remove use of random salt altogether. Without using SipHash the benefit is unclear (i.e. collision attacks still work) and the complexity is no longer worth it. * Documentation improvements. ## Version 1.2.0.10 * Fix for GHC 7.0. ## Version 1.2.0.9 * Stop using SipHash. The current implementation still has segfault causing bugs that we won't be able to fix soon. * Stop using Wang hash. It degrades performance of fixed-size integer hashing too much. ## Version 1.2.0.8 * Fix linking issue when SSE was disabled. * Hash small signed Integers correctly. ## Version 1.2.0.7 * Add flags to control usage of SSE. ## Version 1.2.0.6 * Fix another segfault caused by SSE2 code. ## Version 1.2.0.5 * More portability fixes. * Force stack alignment to 16 bytes everywhere. Fixes a segfault. * Fix bug where code relied on rewrite rules firing for correctness. ## Version 1.2.0.4 * Update docs to match code. * Work around bug in GHCi runtime linker, which never call static initializers. ## Version 1.2.0.3 * Make building of SSE 4.1 code conditional, as it doesn't work on all platforms. * Use a fixed salt, but allow random salting. Random salting by default broke people's code. ## Version 1.2.0.2 * Work around ghci linker bug on Windows. ## Version 1.2.0.1 * Fix performance bug in SSE implementation of SipHash. * Fix segfault due to incorrect stack alignment on Windows. ## Version 1.2.0.0 * Switch string hashing from FNV-1 to SipHash, in an effort to prevent collision attacks. * Switch fixed-size integer hashing to Wang hash. * The default salt now switched on every program run, in an effort to prevent collision attacks. * Move hash method out of Hashable type class. * Add support for generic instance deriving. * Add instance for Ordering. ---- ## Version 1.1.2.5 * Bug fix for bytestring < 0.10.0. ## Version 1.1.2.4 * Switch string hashing from Bernstein to FNV-1 * Faster instance for Integer. * Update dependency on base, ghc-prim * Now works with GHC 7.6. ## Version 1.1.2.3 * Add instance for TypeRep. * Update dependency on test-framework. ## Version 1.1.2.2 * Bug fix for GHC 7.4 ## Version 1.1.2.1 * Update dependency on test-framework. * Improve documentation of combine. ## Version 1.1.2.0 * Fix hash collision issues for lists and tuples when using a user-specified salt. * Add instances for `Integer`, `Ratio`, `Float`, `Double`, and `StableName`. * Improved instances for tuples and lists. ## Version 1.1.1.0 * Add `hashWithSalt`, which allows the user to create different hash values for the same input by providing different seeds. This is useful for application like Cuckoo hashing which need a family of hash functions. * Fix a bug in the `Hashable` instance for `Int64`/`Word64` on 32-bit platforms. * Improved resilience to leading zero in the input being hashed. ## Version 1.1.0.0 * Add instance for: strict and lazy Texts, ThreadId * Add hashPtrWithSalt and hashByteArrayWithSalt. * Faster ByteArray# hashing. * Fix a signedness bug that affected ByteString. * Fix ByteString hashing to work correctly on both 32 and 64-bit platforms. ## Version 1.0.1.1 * Fix bug in Hashable instance for lazy ByteStrings where differences in the internal structure of the ByteString could cause different hash values for ByteStrings that are equal according to ==. ## Version 1.0.1.0 * Add two helpers for creating Hashable instances: hashPtr and hashByteArray. ---- ## Version 1.0.0 * Separate Hashable class to its own package from hashmap 1.0.0.3. hashable-1.4.4.0/LICENSE0000644000000000000000000000275507346545000012634 0ustar0000000000000000Copyright Milan Straka 2010 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Milan Straka nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hashable-1.4.4.0/README.md0000644000000000000000000000043507346545000013077 0ustar0000000000000000The hashable package ==================== This package defines a class, `Hashable`, for types that can be converted to a hash value. This class exists for the benefit of hashing-based data structures. The package provides instances for basic types and a way to combine hash values. hashable-1.4.4.0/Setup.hs0000644000000000000000000000011007346545000013242 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain hashable-1.4.4.0/cbits-unix/0000755000000000000000000000000007346545000013703 5ustar0000000000000000hashable-1.4.4.0/cbits-unix/init.c0000644000000000000000000000154407346545000015016 0ustar0000000000000000#include #include #include #include #include #include uint64_t hs_hashable_init() { /* if there is /dev/urandom, read from it */ FILE *urandom = fopen("/dev/urandom", "r"); if (urandom) { uint64_t result = 0; size_t r = fread(&result, sizeof(uint64_t), 1, urandom); fclose(urandom); if (r == 1) { return result; } else { return 0xfeed1000; } } else { /* time of day */ struct timeval tp = {0, 0}; gettimeofday(&tp, NULL); /* cputime */ clock_t c = clock(); /* process id */ pid_t p = getpid(); return ((uint64_t) tp.tv_sec) ^ ((uint64_t) tp.tv_usec) ^ ((uint64_t) c << 16) ^ ((uint64_t) p << 32); } } hashable-1.4.4.0/cbits-win/0000755000000000000000000000000007346545000013515 5ustar0000000000000000hashable-1.4.4.0/cbits-win/init.c0000644000000000000000000000151007346545000014621 0ustar0000000000000000#include #include uint64_t hs_hashable_init() { /* Handy list at https://stackoverflow.com/a/3487338/1308058 */ uint64_t a = GetCurrentProcessId(); /* DWORD */ uint64_t b = GetCurrentThreadId(); /* DWORD */ uint64_t c = GetTickCount(); /* DWORD */ SYSTEMTIME t = {0,0,0,0,0,0,0,0}; GetSystemTime(&t); LARGE_INTEGER i; QueryPerformanceCounter(&i); return a ^ (b << 32) ^ (c << 16) ^ ((uint64_t) t.wYear << 56) ^ ((uint64_t) t.wMonth << 48) ^ ((uint64_t) t.wDayOfWeek << 40) ^ ((uint64_t) t.wDay << 32) ^ ((uint64_t) t.wHour << 24) ^ ((uint64_t) t.wMinute << 16) ^ ((uint64_t) t.wSecond << 8) ^ ((uint64_t) t.wMilliseconds << 0) ^ ((uint64_t) i.QuadPart); } hashable-1.4.4.0/cbits/0000755000000000000000000000000007346545000012722 5ustar0000000000000000hashable-1.4.4.0/cbits/fnv.c0000644000000000000000000000426107346545000013662 0ustar0000000000000000/* Copyright Johan Tibell 2011 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Johan Tibell nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include "HsHashable.h" /* FNV-1 hash * * The FNV-1 hash description: http://isthe.com/chongo/tech/comp/fnv/ * The FNV-1 hash is public domain: http://isthe.com/chongo/tech/comp/fnv/#public_domain */ FNV_UNSIGNED hashable_fnv_hash(const unsigned char* str, FNV_SIGNED len, FNV_UNSIGNED salt) { FNV_UNSIGNED hash = salt; while (len--) { hash = (hash * FNV_PRIME) ^ *str++; } return hash; } /* Used for ByteArray#s. We can't treat them like pointers in native Haskell, but we can in unsafe FFI calls. */ FNV_UNSIGNED hashable_fnv_hash_offset(const unsigned char* str, FNV_SIGNED offset, FNV_SIGNED len, FNV_UNSIGNED salt) { return hashable_fnv_hash(str + offset, len, salt); } hashable-1.4.4.0/examples/0000755000000000000000000000000007346545000013434 5ustar0000000000000000hashable-1.4.4.0/examples/Main.hs0000644000000000000000000000252407346545000014657 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} import Data.Hashable import Data.Hashable.Lifted import GHC.Generics (Generic) data Foo = Foo1 Int Char Bool | Foo2 String () deriving (Eq, Generic) instance Hashable Foo data Bar = Bar Double Float deriving (Eq, 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 ----------------------------------- -- Higher Rank Hashable Examples -- ----------------------------------- {- TODO: newtype WriterT w m a = WriterT { runWriterT :: m (a, w) } data Free f a = Pure a | Free (f (Free f a)) 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 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 -} hashable-1.4.4.0/hashable.cabal0000644000000000000000000001207307346545000014354 0ustar0000000000000000cabal-version: 1.12 name: hashable version: 1.4.4.0 synopsis: A class for types that can be converted to a hash value description: This package defines a class, 'Hashable', for types that can be converted to a hash value. This class exists for the benefit of hashing-based data structures. The package provides instances for basic types and a way to combine hash values. . The 'Hashable' 'hash' values are not guaranteed to be stable across library versions, operating systems or architectures. For stable hashing use named hashes: SHA256, CRC32 etc. homepage: http://github.com/haskell-unordered-containers/hashable -- SPDX-License-Identifier : BSD-3-Clause license: BSD3 license-file: LICENSE author: Milan Straka Johan Tibell maintainer: Oleg Grenrus bug-reports: https://github.com/haskell-unordered-containers/hashable/issues stability: Provisional category: Data build-type: Simple tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.3 || ==8.10.4 || ==8.10.7 || ==9.0.1 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.4 || ==9.8.2 extra-source-files: CHANGES.md include/HsHashable.h README.md flag integer-gmp description: Are we using @integer-gmp@ to provide fast Integer instances? No effect on GHC-9.0 or later. manual: False default: True flag random-initial-seed description: Randomly initialize the initial seed on each final executable invocation This is useful for catching cases when you rely on (non-existent) stability of hashable's hash functions. This is not a security feature. manual: True default: False library exposed-modules: Data.Hashable Data.Hashable.Generic Data.Hashable.Lifted other-modules: Data.Hashable.Class Data.Hashable.Generic.Instances Data.Hashable.Imports Data.Hashable.LowLevel c-sources: cbits/fnv.c include-dirs: include hs-source-dirs: src build-depends: base >=4.10.1.0 && <4.20 , bytestring >=0.10.8.2 && <0.13 , containers >=0.5.10.2 && <0.7 , deepseq >=1.4.3.0 && <1.6 , ghc-prim , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2 if impl(ghc >=9.2) -- depend on os-string on newer GHCs only. -- os-string has tight lower bound on bytestring, which prevents -- using bundled version on older GHCs. build-depends: os-string >=2.0.2 -- we also ensure that we can get filepath-1.5 only with GHC-9.2 -- therefore there is else-branch with stricter upper bound. build-depends: filepath >=1.4.1.2 && <1.6 else build-depends: filepath >=1.4.1.2 && <1.5 if !impl(ghc >=9.2) build-depends: base-orphans >=0.8.6 && <0.10 if !impl(ghc >=9.4) build-depends: data-array-byte >=0.1.0.1 && <0.2 -- Integer internals if impl(ghc >=9) build-depends: ghc-bignum >=1.0 && <1.4 if !impl(ghc >=9.0.2) build-depends: ghc-bignum-orphans >=0.1 && <0.2 else if flag(integer-gmp) build-depends: integer-gmp >=0.4 && <1.1 else -- this is needed for the automatic flag to be well-balanced build-depends: integer-simple if (flag(random-initial-seed) && impl(ghc)) cpp-options: -DHASHABLE_RANDOM_SEED=1 if os(windows) c-sources: cbits-win/init.c else c-sources: cbits-unix/init.c default-language: Haskell2010 other-extensions: BangPatterns CPP DeriveDataTypeable FlexibleContexts FlexibleInstances GADTs KindSignatures MagicHash MultiParamTypeClasses ScopedTypeVariables Trustworthy TypeOperators UnliftedFFITypes ghc-options: -Wall -fwarn-tabs if impl(ghc >=9.0) -- these flags may abort compilation with GHC-8.10 -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295 ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode test-suite hashable-tests type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Main.hs other-modules: Properties Regress build-depends: base , bytestring , filepath , ghc-prim , hashable , HUnit , QuickCheck >=2.4.0.1 , random >=1.0 && <1.3 , test-framework >=0.3.3 , test-framework-hunit , test-framework-quickcheck2 >=0.2.9 , text >=0.11.0.5 if impl(ghc >=9.2) build-depends: os-string if !os(windows) build-depends: unix cpp-options: -DHAVE_MMAP other-modules: Regress.Mmap other-extensions: CApiFFI ghc-options: -Wall -fno-warn-orphans default-language: Haskell2010 test-suite hashable-examples type: exitcode-stdio-1.0 build-depends: base , ghc-prim , hashable hs-source-dirs: examples main-is: Main.hs default-language: Haskell2010 source-repository head type: git location: https://github.com/haskell-unordered-containers/hashable.git hashable-1.4.4.0/include/0000755000000000000000000000000007346545000013241 5ustar0000000000000000hashable-1.4.4.0/include/HsHashable.h0000644000000000000000000000105107346545000015411 0ustar0000000000000000#ifndef HS_HASHABLE_H #define HS_HASHABLE_H #include "MachDeps.h" #include #if WORD_SIZE_IN_BITS == 64 #define FNV_PRIME 1099511628211 #define FNV_SIGNED int64_t #define FNV_UNSIGNED uint64_t #else #define FNV_PRIME 16777619 #define FNV_SIGNED int32_t #define FNV_UNSIGNED uint32_t #endif uint64_t hs_hashable_init(); FNV_UNSIGNED hashable_fnv_hash(const unsigned char* str, FNV_SIGNED len, FNV_UNSIGNED salt); FNV_UNSIGNED hashable_fnv_hash_offset(const unsigned char* str, FNV_SIGNED offset, FNV_SIGNED len, FNV_UNSIGNED salt); #endif hashable-1.4.4.0/src/Data/0000755000000000000000000000000007346545000013256 5ustar0000000000000000hashable-1.4.4.0/src/Data/Hashable.hs0000644000000000000000000001541207346545000015324 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Safe #-} ------------------------------------------------------------------------ -- | -- Module : Data.Hashable -- Copyright : (c) Milan Straka 2010 -- (c) Johan Tibell 2011 -- (c) Bryan O'Sullivan 2011, 2012 -- SPDX-License-Identifier : BSD-3-Clause -- Maintainer : johan.tibell@gmail.com -- Stability : provisional -- Portability : portable -- -- This module defines a class, 'Hashable', for types that can be -- converted to a hash value. This class exists for the benefit of -- hashing-based data structures. The module provides instances for -- most standard types. Efficient instances for other types can be -- generated automatically and effortlessly using the generics support -- in GHC 7.4 and above. -- -- The easiest way to get started is to use the 'hash' function. Here -- is an example session with @ghci@. -- -- > ghci> import Data.Hashable -- > ghci> hash "foo" -- > 60853164 module Data.Hashable ( -- * Hashing and security -- $security -- * Computing hash values Hashable(..) -- * Creating new instances -- | There are two ways to create new instances: by deriving -- instances automatically using GHC's generic programming -- support or by writing instances manually. -- ** Generic instances -- $generics -- *** Understanding a compiler error -- $generic_err -- ** Writing instances by hand -- $blocks -- *** Hashing contructors with multiple fields -- $multiple-fields -- *** Hashing types with multiple constructors -- $multiple-ctors , hashUsing , hashPtr , hashPtrWithSalt , hashByteArray , hashByteArrayWithSalt , defaultHashWithSalt , defaultHash -- * Caching hashes , Hashed , hashed , hashedHash , unhashed , mapHashed , traverseHashed ) where import Data.Hashable.Class import Data.Hashable.Generic () -- $security -- #security# -- -- Applications that use hash-based data structures to store input -- from untrusted users can be susceptible to \"hash DoS\", a class of -- denial-of-service attack that uses deliberately chosen colliding -- inputs to force an application into unexpectedly behaving with -- quadratic time complexity. -- -- At this time, the string hashing functions used in this library are -- susceptible to such attacks and users are recommended to either use -- a 'Data.Map' to store keys derived from untrusted input or to use a -- hash function (e.g. SipHash) that's resistant to such attacks. A -- future version of this library might ship with such hash functions. -- $generics -- -- The recommended way to make instances of -- 'Hashable' for most types is to use the compiler's support for -- automatically generating default instances using "GHC.Generics". -- -- > {-# LANGUAGE DeriveGeneric #-} -- > -- > import GHC.Generics (Generic) -- > import Data.Hashable -- > -- > data Foo a = Foo a String -- > deriving (Eq, Generic) -- > -- > instance Hashable a => Hashable (Foo a) -- > -- > data Colour = Red | Green | Blue -- > deriving Generic -- > -- > instance Hashable Colour -- -- If you omit a body for the instance declaration, GHC will generate -- a default instance that correctly and efficiently hashes every -- constructor and parameter. -- -- The default implementations are provided by -- 'genericHashWithSalt' and 'genericLiftHashWithSalt'; those together with -- the generic type class 'GHashable' and auxiliary functions are exported -- from the "Data.Hashable.Generic" module. -- $generic_err -- -- Suppose you intend to use the generic machinery to automatically -- generate a 'Hashable' instance. -- -- > data Oops = Oops -- > -- forgot to add "deriving Generic" here! -- > -- > instance Hashable Oops -- -- And imagine that, as in the example above, you forget to add a -- \"@deriving 'Generic'@\" clause to your data type. At compile time, -- you will get an error message from GHC that begins roughly as -- follows: -- -- > No instance for (GHashable (Rep Oops)) -- -- This error can be confusing, as 'GHashable' is not exported (it is -- an internal typeclass used by this library's generics machinery). -- The correct fix is simply to add the missing \"@deriving -- 'Generic'@\". -- $blocks -- -- To maintain high quality hashes, new 'Hashable' instances should be -- built using existing 'Hashable' instances, combinators, and hash -- functions. -- -- The functions below can be used when creating new instances of -- 'Hashable'. For example, for many string-like types the -- 'hashWithSalt' method can be defined in terms of either -- 'hashPtrWithSalt' or 'hashByteArrayWithSalt'. Here's how you could -- implement an instance for the 'B.ByteString' data type, from the -- @bytestring@ package: -- -- > import qualified Data.ByteString as B -- > import qualified Data.ByteString.Internal as B -- > import qualified Data.ByteString.Unsafe as B -- > import Data.Hashable -- > import Foreign.Ptr (castPtr) -- > -- > instance Hashable B.ByteString where -- > hashWithSalt salt bs = B.inlinePerformIO $ -- > B.unsafeUseAsCStringLen bs $ \(p, len) -> -- > hashPtrWithSalt p (fromIntegral len) salt -- $multiple-fields -- -- Hash constructors with multiple fields by chaining 'hashWithSalt': -- -- > data Date = Date Int Int Int -- > -- > instance Hashable Date where -- > hashWithSalt s (Date yr mo dy) = -- > s `hashWithSalt` -- > yr `hashWithSalt` -- > mo `hashWithSalt` dy -- -- If you need to chain hashes together, use 'hashWithSalt' and follow -- this recipe: -- -- > combineTwo h1 h2 = h1 `hashWithSalt` h2 -- $multiple-ctors -- -- For a type with several value constructors, there are a few -- possible approaches to writing a 'Hashable' instance. -- -- If the type is an instance of 'Enum', the easiest path is to -- convert it to an 'Int', and use the existing 'Hashable' instance -- for 'Int'. -- -- > data Color = Red | Green | Blue -- > deriving Enum -- > -- > instance Hashable Color where -- > hashWithSalt = hashUsing fromEnum -- -- If the type's constructors accept parameters, it is important to -- distinguish the constructors. To distinguish the constructors, add -- a different integer to the hash computation of each constructor: -- -- > data Time = Days Int -- > | Weeks Int -- > | Months Int -- > -- > instance Hashable Time where -- > hashWithSalt s (Days n) = s `hashWithSalt` -- > (0::Int) `hashWithSalt` n -- > hashWithSalt s (Weeks n) = s `hashWithSalt` -- > (1::Int) `hashWithSalt` n -- > hashWithSalt s (Months n) = s `hashWithSalt` -- > (2::Int) `hashWithSalt` n hashable-1.4.4.0/src/Data/Hashable/0000755000000000000000000000000007346545000014765 5ustar0000000000000000hashable-1.4.4.0/src/Data/Hashable/Class.hs0000644000000000000000000011066607346545000016400 0ustar0000000000000000{-# LANGUAGE CApiFFI #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnliftedFFITypes #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} ------------------------------------------------------------------------ -- | -- Module : Data.Hashable.Class -- Copyright : (c) Milan Straka 2010 -- (c) Johan Tibell 2011 -- (c) Bryan O'Sullivan 2011, 2012 -- SPDX-License-Identifier : BSD-3-Clause -- Maintainer : johan.tibell@gmail.com -- Stability : provisional -- Portability : portable -- -- This module defines a class, 'Hashable', for types that can be -- converted to a hash value. This class exists for the benefit of -- hashing-based data structures. The module provides instances for -- most standard types. module Data.Hashable.Class ( -- * Computing hash values Hashable(..) , Hashable1(..) , Hashable2(..) -- ** Support for generics , genericHashWithSalt , genericLiftHashWithSalt , GHashable(..) , HashArgs(..) , Zero , One -- * Creating new instances , hashUsing , hashPtr , hashPtrWithSalt , hashByteArray , hashByteArrayWithSalt , defaultHashWithSalt , defaultHash -- * Higher Rank Functions , hashWithSalt1 , hashWithSalt2 , defaultLiftHashWithSalt -- * Caching hashes , Hashed , hashed , hashedHash , unhashed , mapHashed , traverseHashed ) where import Control.Applicative (Const (..)) import Control.DeepSeq (NFData (rnf)) import Control.Exception (assert) import Data.Complex (Complex (..)) import Data.Fixed (Fixed (..)) import Data.Functor.Classes (Eq1 (..), Eq2 (..), Ord1 (..), Show1 (..)) import Data.Functor.Compose (Compose (..)) import Data.Functor.Identity (Identity (..)) import Data.Int (Int16, Int8) import Data.Kind (Type) import Data.List (foldl') import Data.Proxy (Proxy) import Data.Ratio (Ratio, denominator, numerator) import Data.String (IsString (..)) import Data.Unique (Unique, hashUnique) import Data.Version (Version (..)) import Data.Void (Void, absurd) import Data.Word (Word16, Word8) import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr, castFunPtrToPtr, ptrToIntPtr) import Foreign.Storable (alignment, sizeOf) import GHC.Base (ByteArray#) import GHC.Conc (ThreadId (..)) import GHC.Fingerprint.Type (Fingerprint (..)) import GHC.Word (Word (..)) import System.IO.Unsafe (unsafeDupablePerformIO) import System.Mem.StableName (StableName, hashStableName) import Type.Reflection (SomeTypeRep (..), TypeRep) import Type.Reflection.Unsafe (typeRepFingerprint) import qualified Data.Array.Byte as AB import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Short.Internal as BSI import qualified Data.ByteString.Unsafe as B import qualified Data.Functor.Product as FP import qualified Data.Functor.Sum as FS import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Semigroup as Semi import qualified Data.Sequence as Seq import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Array as TA import qualified Data.Text.Internal as T import qualified Data.Text.Lazy as TL import qualified Data.Tree as Tree import GHC.Generics #if MIN_VERSION_base(4,19,0) import GHC.Conc.Sync (fromThreadId) #else import GHC.Prim (ThreadId#) #if __GLASGOW_HASKELL__ >= 904 import Foreign.C.Types (CULLong (..)) #elif __GLASGOW_HASKELL__ >= 900 import Foreign.C.Types (CLong (..)) #else import Foreign.C.Types (CInt (..)) #endif #endif #ifdef VERSION_ghc_bignum import GHC.Exts (Int (..), sizeofByteArray#) import GHC.Num.BigNat (BigNat (..)) import GHC.Num.Integer (Integer (..)) import GHC.Num.Natural (Natural (..)) #endif #ifdef VERSION_integer_gmp # if MIN_VERSION_integer_gmp(1,0,0) # define MIN_VERSION_integer_gmp_1_0_0 # endif import GHC.Exts (Int (..)) import GHC.Integer.GMP.Internals (Integer (..)) # if defined(MIN_VERSION_integer_gmp_1_0_0) import GHC.Exts (sizeofByteArray#) import GHC.Integer.GMP.Internals (BigNat (BN#)) # endif #endif #ifndef VERSION_ghc_bignum import GHC.Natural (Natural (..)) #endif #if MIN_VERSION_base(4,11,0) import GHC.Float (castDoubleToWord64, castFloatToWord32) #else import Foreign.Marshal.Utils (with) import Foreign.Ptr (castPtr) import Foreign.Storable (peek) #endif #if MIN_VERSION_base(4,16,0) import Data.Tuple (Solo (..)) #elif MIN_VERSION_base(4,15,0) import GHC.Tuple (Solo (..)) #endif -- filepath >=1.4.100 && <1.5 has System.OsString.Internal.Types module #if MIN_VERSION_filepath(1,4,100) && !(MIN_VERSION_filepath(1,5,0)) #define HAS_OS_STRING_filepath 1 #else #define HAS_OS_STRING_filepath 0 #endif -- if we depend on os_string module, then it has System.OsString.Internal.Types -- module as well #ifdef MIN_VERSION_os_string #define HAS_OS_STRING_os_string 1 #else #define HAS_OS_STRING_os_string 0 #endif #if HAS_OS_STRING_filepath && HAS_OS_STRING_os_string import "os-string" System.OsString.Internal.Types (OsString (..), PosixString (..), WindowsString (..)) import qualified "filepath" System.OsString.Internal.Types as FP (OsString (..), PosixString (..), WindowsString (..)) #elif HAS_OS_STRING_filepath || HAS_OS_STRING_os_string import System.OsString.Internal.Types (OsString (..), PosixString (..), WindowsString (..)) #endif #ifdef VERSION_base_orphans import Data.Orphans () #endif #ifdef VERSION_ghc_bignum_orphans import GHC.Num.Orphans () #endif import Data.Hashable.Imports import Data.Hashable.LowLevel #include "MachDeps.h" infixl 0 `hashWithSalt` ------------------------------------------------------------------------ -- * Computing hash values -- | The class of types that can be converted to a hash value. -- -- Minimal implementation: 'hashWithSalt'. -- -- /Note:/ the hash is not guaranteed to be stable across -- library versions, operating systems or architectures. -- For stable hashing use named hashes: SHA256, CRC32 etc. -- -- If you are looking for 'Hashable' instance in @time@ package, -- check [time-compat](https://hackage.haskell.org/package/time-compat) -- class Eq a => Hashable a where -- | Return a hash value for the argument, using the given salt. -- -- The general contract of 'hashWithSalt' is: -- -- * If two values are equal according to the '==' method, then -- applying the 'hashWithSalt' method on each of the two values -- /must/ produce the same integer result if the same salt is -- used in each case. -- -- * It is /not/ required that if two values are unequal -- according to the '==' method, then applying the -- 'hashWithSalt' method on each of the two values must produce -- distinct integer results. However, the programmer should be -- aware that producing distinct integer results for unequal -- values may improve the performance of hashing-based data -- structures. -- -- * This method can be used to compute different hash values for -- the same input by providing a different salt in each -- application of the method. This implies that any instance -- that defines 'hashWithSalt' /must/ make use of the salt in -- its implementation. -- -- * 'hashWithSalt' may return negative 'Int' values. -- hashWithSalt :: Int -> a -> Int -- | Like 'hashWithSalt', but no salt is used. The default -- implementation uses 'hashWithSalt' with some default salt. -- Instances might want to implement this method to provide a more -- efficient implementation than the default implementation. hash :: a -> Int hash = defaultHash default hashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int hashWithSalt = genericHashWithSalt {-# INLINE hashWithSalt #-} -- | Generic 'hashWithSalt'. -- -- @since 1.3.0.0 genericHashWithSalt :: (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int genericHashWithSalt = \salt -> ghashWithSalt HashArgs0 salt . from {-# INLINE genericHashWithSalt #-} data Zero data One data family HashArgs arity a :: Type data instance HashArgs Zero a = HashArgs0 newtype instance HashArgs One a = HashArgs1 (Int -> a -> Int) -- | The class of types that can be generically hashed. class GHashable arity f where ghashWithSalt :: HashArgs arity a -> Int -> f a -> Int class Eq1 t => Hashable1 t where -- | Lift a hashing function through the type constructor. liftHashWithSalt :: (Int -> a -> Int) -> Int -> t a -> Int default liftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int liftHashWithSalt = genericLiftHashWithSalt {-# INLINE liftHashWithSalt #-} -- | Generic 'liftHashWithSalt'. -- -- @since 1.3.0.0 genericLiftHashWithSalt :: (Generic1 t, GHashable One (Rep1 t)) => (Int -> a -> Int) -> Int -> t a -> Int genericLiftHashWithSalt = \h salt -> ghashWithSalt (HashArgs1 h) salt . from1 {-# INLINE genericLiftHashWithSalt #-} class Eq2 t => 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 -- 'defaultHashWith'. -- -- @since 1.4.3.0 -- defaultHashWithSalt :: Hashable a => Int -> a -> Int defaultHashWithSalt salt x = salt `hashInt` hash x -- | Default implementation of 'hash' based on 'hashWithSalt'. -- -- @since 1.4.3.0 -- defaultHash :: Hashable a => a -> Int defaultHash = hashWithSalt defaultSalt -- | Transform a value into a 'Hashable' value, then hash the -- transformed value using the given salt. -- -- This is a useful shorthand in cases where a type can easily be -- mapped to another type that is already an instance of 'Hashable'. -- Example: -- -- > data Foo = Foo | Bar -- > deriving (Enum) -- > -- > instance Hashable Foo where -- > hashWithSalt = hashUsing fromEnum -- -- @since 1.2.0.0 hashUsing :: (Hashable b) => (a -> b) -- ^ Transformation function. -> Int -- ^ Salt. -> a -- ^ Value to transform. -> Int hashUsing f salt x = hashWithSalt salt (f x) {-# INLINE hashUsing #-} instance Hashable Int where hash = id hashWithSalt = hashInt instance Hashable Int8 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Int16 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Int32 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Int64 where hash = fromIntegral hashWithSalt = hashInt64 instance Hashable Word where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Word8 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Word16 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Word32 where hash = fromIntegral hashWithSalt = defaultHashWithSalt instance Hashable Word64 where hashWithSalt = hashWord64 instance Hashable () where hash = fromEnum hashWithSalt = defaultHashWithSalt instance Hashable Bool where hash = fromEnum hashWithSalt = defaultHashWithSalt instance Hashable Ordering where hash = fromEnum hashWithSalt = defaultHashWithSalt instance Hashable Char where hash = fromEnum hashWithSalt = defaultHashWithSalt #if defined(MIN_VERSION_integer_gmp_1_0_0) || defined(VERSION_ghc_bignum) instance Hashable BigNat where hashWithSalt salt (BN# ba) = hashByteArrayWithSalt ba 0 numBytes salt `hashWithSalt` size where size = numBytes `quot` SIZEOF_HSWORD numBytes = I# (sizeofByteArray# ba) #endif instance Hashable Natural where #if defined(VERSION_ghc_bignum) hash (NS n) = hash (W# n) hash (NB bn) = hash (BN# bn) hashWithSalt salt (NS n) = hashWithSalt salt (W# n) hashWithSalt salt (NB bn) = hashWithSalt salt (BN# bn) #else #if defined(MIN_VERSION_integer_gmp_1_0_0) hash (NatS# n) = hash (W# n) hash (NatJ# bn) = hash bn hashWithSalt salt (NatS# n) = hashWithSalt salt (W# n) hashWithSalt salt (NatJ# bn) = hashWithSalt salt bn #else hash (Natural n) = hash n hashWithSalt salt (Natural n) = hashWithSalt salt n #endif #endif instance Hashable Integer where #if defined(VERSION_ghc_bignum) hash (IS n) = I# n hash (IP bn) = hash (BN# bn) hash (IN bn) = negate (hash (BN# bn)) hashWithSalt salt (IS n) = hashWithSalt salt (I# n) hashWithSalt salt (IP bn) = hashWithSalt salt (BN# bn) hashWithSalt salt (IN bn) = negate (hashWithSalt salt (BN# bn)) #else #if defined(VERSION_integer_gmp) # if defined(MIN_VERSION_integer_gmp_1_0_0) hash (S# n) = (I# n) hash (Jp# bn) = hash bn hash (Jn# bn) = negate (hash bn) hashWithSalt salt (S# n) = hashWithSalt salt (I# n) hashWithSalt salt (Jp# bn) = hashWithSalt salt bn hashWithSalt salt (Jn# bn) = negate (hashWithSalt salt bn) # else hash (S# int) = I# int hash n@(J# size# byteArray) | n >= minInt && n <= maxInt = fromInteger n :: Int | otherwise = let size = I# size# numBytes = SIZEOF_HSWORD * abs size in hashByteArrayWithSalt byteArray 0 numBytes defaultSalt `hashWithSalt` size where minInt = fromIntegral (minBound :: Int) maxInt = fromIntegral (maxBound :: Int) hashWithSalt salt (S# n) = hashWithSalt salt (I# n) hashWithSalt salt n@(J# size# byteArray) | n >= minInt && n <= maxInt = hashWithSalt salt (fromInteger n :: Int) | otherwise = let size = I# size# numBytes = SIZEOF_HSWORD * abs size in hashByteArrayWithSalt byteArray 0 numBytes salt `hashWithSalt` size where minInt = fromIntegral (minBound :: Int) maxInt = fromIntegral (maxBound :: Int) # endif #else hashWithSalt salt = foldl' hashWithSalt salt . go where go n | inBounds n = [fromIntegral n :: Int] | otherwise = fromIntegral n : go (n `shiftR` WORD_SIZE_IN_BITS) maxInt = fromIntegral (maxBound :: Int) inBounds x = x >= fromIntegral (minBound :: Int) && x <= maxInt #endif #endif instance Hashable a => Hashable (Complex a) where {-# SPECIALIZE instance Hashable (Complex Double) #-} {-# SPECIALIZE instance Hashable (Complex Float) #-} hash (r :+ i) = hash r `hashWithSalt` i hashWithSalt = hashWithSalt1 instance Hashable1 Complex where liftHashWithSalt h s (r :+ i) = s `h` r `h` i instance Hashable a => Hashable (Ratio a) where {-# SPECIALIZE instance Hashable (Ratio Integer) #-} hash a = hash (numerator a) `hashWithSalt` denominator a hashWithSalt s a = s `hashWithSalt` numerator a `hashWithSalt` denominator a -- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@ -- -- The 'hash' of NaN is not well defined. -- -- @since 1.3.0.0 instance Hashable Float where hash x | x == -0.0 || x == 0.0 = 0 -- see note in 'Hashable Double' | isIEEE x = assert (sizeOf x >= sizeOf (0::Word32) && alignment x >= alignment (0::Word32)) $ #if MIN_VERSION_base(4,11,0) hash (castFloatToWord32 x) #else hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word32) #endif | otherwise = hash (show x) hashWithSalt = defaultHashWithSalt -- | __Note__: prior to @hashable-1.3.0.0@, @hash 0.0 /= hash (-0.0)@ -- -- The 'hash' of NaN is not well defined. -- -- @since 1.3.0.0 instance Hashable Double where hash x | x == -0.0 || x == 0.0 = 0 -- s.t. @hash -0.0 == hash 0.0@ ; see #173 | isIEEE x = assert (sizeOf x >= sizeOf (0::Word64) && alignment x >= alignment (0::Word64)) $ #if MIN_VERSION_base(4,11,0) hash (castDoubleToWord64 x) #else hash ((unsafeDupablePerformIO $ with x $ peek . castPtr) :: Word64) #endif | otherwise = hash (show x) hashWithSalt = defaultHashWithSalt -- | A value with bit pattern (01)* (or 5* in hexa), for any size of Int. -- It is used as data constructor distinguisher. GHC computes its value during -- compilation. distinguisher :: Int distinguisher = fromIntegral $ (maxBound :: Word) `quot` 3 {-# INLINE distinguisher #-} instance Hashable a => Hashable (Maybe a) where hash Nothing = 0 hash (Just a) = distinguisher `hashWithSalt` a hashWithSalt = hashWithSalt1 instance Hashable1 Maybe where liftHashWithSalt _ s Nothing = s `hashInt` 0 liftHashWithSalt h s (Just a) = s `hashInt` 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 = hashWithSalt1 instance Hashable a => Hashable1 (Either a) where liftHashWithSalt = defaultLiftHashWithSalt instance Hashable2 Either where liftHashWithSalt2 h _ s (Left a) = s `hashInt` 0 `h` a liftHashWithSalt2 _ h s (Right b) = s `hashInt` distinguisher `h` b instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where 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 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 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 hashWithSalt s (a1, a2, a3, a4, a5) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 {- 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 hashWithSalt s (a1, a2, a3, a4, a5, a6) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 {- 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) => Hashable (a1, a2, a3, a4, a5, a6, a7) where hashWithSalt s (a1, a2, a3, a4, a5, a6, a7) = 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 -- Auxiliary type for Hashable [a] definition data SPInt = SP !Int !Int instance Hashable a => Hashable [a] where {-# SPECIALIZE instance Hashable [Char] #-} 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 (h s x) (l + 1) instance Hashable B.ByteString where hashWithSalt salt bs = unsafeDupablePerformIO $ B.unsafeUseAsCStringLen bs $ \(p, len) -> hashPtrWithSalt p (fromIntegral len) (hashWithSalt salt len) instance Hashable BL.ByteString where hashWithSalt salt = finalise . BL.foldlChunks step (SP salt 0) where finalise (SP s l) = hashWithSalt s l step (SP s l) bs = unsafeDupablePerformIO $ B.unsafeUseAsCStringLen bs $ \(p, len) -> do s' <- hashPtrWithSalt p (fromIntegral len) s return (SP s' (l + len)) instance Hashable BSI.ShortByteString where hashWithSalt salt sbs@(BSI.SBS ba) = hashByteArrayWithSalt ba 0 (BSI.length sbs) (hashWithSalt salt (BSI.length sbs)) #if HAS_OS_STRING_filepath || HAS_OS_STRING_os_string -- | @since 1.4.2.0 instance Hashable PosixString where hashWithSalt salt (PosixString s) = hashWithSalt salt s -- | @since 1.4.2.0 instance Hashable WindowsString where hashWithSalt salt (WindowsString s) = hashWithSalt salt s -- | @since 1.4.2.0 instance Hashable OsString where hashWithSalt salt (OsString s) = hashWithSalt salt s #endif #if HAS_OS_STRING_filepath && HAS_OS_STRING_os_string instance Hashable FP.PosixString where hashWithSalt salt (FP.PosixString s) = hashWithSalt salt s instance Hashable FP.WindowsString where hashWithSalt salt (FP.WindowsString s) = hashWithSalt salt s instance Hashable FP.OsString where hashWithSalt salt (FP.OsString s) = hashWithSalt salt s #endif #if MIN_VERSION_text(2,0,0) instance Hashable T.Text where hashWithSalt salt (T.Text (TA.ByteArray arr) off len) = hashByteArrayWithSalt arr off len (hashWithSalt salt len) instance Hashable TL.Text where hashWithSalt salt = finalise . TL.foldlChunks step (SP salt 0) where finalise (SP s l) = hashWithSalt s l step (SP s l) (T.Text (TA.ByteArray arr) off len) = SP (hashByteArrayWithSalt arr off len s) (l + len) #else instance Hashable T.Text where hashWithSalt salt (T.Text arr off len) = hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1) (hashWithSalt salt len) instance Hashable TL.Text where hashWithSalt salt = finalise . TL.foldlChunks step (SP salt 0) where finalise (SP s l) = hashWithSalt s l step (SP s l) (T.Text arr off len) = SP (hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1) s) (l + len) #endif #if !MIN_VERSION_base(4,19,0) fromThreadId :: ThreadId -> Word64 fromThreadId (ThreadId t) = fromIntegral (getThreadId t) -- this cannot be capi, as GHC panics. foreign import ccall unsafe "rts_getThreadId" getThreadId #if __GLASGOW_HASKELL__ >= 904 -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6163 :: ThreadId# -> CULLong #elif __GLASGOW_HASKELL__ >= 900 -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1254 :: ThreadId# -> CLong #else :: ThreadId# -> CInt #endif #endif instance Hashable ThreadId where hash = hash . fromThreadId 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 ---------------------------------------------------------------------------- -- Fingerprint & TypeRep instances -- | @since 1.3.0.0 instance Hashable Fingerprint where hash (Fingerprint x _) = fromIntegral x hashWithSalt = defaultHashWithSalt {-# INLINE hash #-} hashTypeRep :: Type.Reflection.TypeRep a -> Int hashTypeRep tr = let Fingerprint x _ = typeRepFingerprint tr in fromIntegral x instance Hashable Type.Reflection.SomeTypeRep where hash (Type.Reflection.SomeTypeRep r) = hashTypeRep r hashWithSalt = defaultHashWithSalt {-# INLINE hash #-} instance Hashable (Type.Reflection.TypeRep a) where hash = hashTypeRep hashWithSalt = defaultHashWithSalt {-# INLINE hash #-} ---------------------------------------------------------------------------- instance Hashable Void where hashWithSalt _ = absurd -- | Compute a hash value for the content of this pointer. hashPtr :: Ptr a -- ^ pointer to the data to hash -> Int -- ^ length, in bytes -> IO Int -- ^ hash value hashPtr p len = hashPtrWithSalt p len defaultSalt -- | Compute a hash value for the content of this 'ByteArray#', -- beginning at the specified offset, using specified number of bytes. hashByteArray :: ByteArray# -- ^ data to hash -> Int -- ^ offset, in bytes -> Int -- ^ length, in bytes -> Int -- ^ hash value hashByteArray ba0 off len = hashByteArrayWithSalt ba0 off len defaultSalt {-# INLINE hashByteArray #-} instance Hashable Unique where hash = hashUnique hashWithSalt = defaultHashWithSalt instance Hashable Version where hashWithSalt salt (Version branch tags) = salt `hashWithSalt` branch `hashWithSalt` tags instance Hashable (Fixed a) where hashWithSalt salt (MkFixed i) = hashWithSalt salt i instance Hashable a => Hashable (Identity a) where hashWithSalt = hashWithSalt1 instance Hashable1 Identity where liftHashWithSalt h salt (Identity x) = h salt x -- 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 instance Hashable (Proxy a) where hash _ = 0 hashWithSalt s _ = s instance Hashable1 Proxy where liftHashWithSalt _ s _ = s instance Hashable a => Hashable (NE.NonEmpty a) where hashWithSalt p (a NE.:| as) = p `hashWithSalt` a `hashWithSalt` as -- | @since 1.3.1.0 instance Hashable1 NE.NonEmpty where liftHashWithSalt h salt (a NE.:| as) = liftHashWithSalt h (h salt a) as instance Hashable a => Hashable (Semi.Min a) where hashWithSalt p (Semi.Min a) = hashWithSalt p a instance Hashable a => Hashable (Semi.Max a) where hashWithSalt p (Semi.Max a) = hashWithSalt p a -- | __Note__: Prior to @hashable-1.3.0.0@ the hash computation included the second argument of 'Arg' which wasn't consistent with its 'Eq' instance. -- -- @since 1.3.0.0 instance Hashable a => Hashable (Semi.Arg a b) where hashWithSalt p (Semi.Arg a _) = hashWithSalt p a instance Hashable a => Hashable (Semi.First a) where hashWithSalt p (Semi.First a) = hashWithSalt p a instance Hashable a => Hashable (Semi.Last a) where hashWithSalt p (Semi.Last a) = hashWithSalt p a instance Hashable a => Hashable (Semi.WrappedMonoid a) where hashWithSalt p (Semi.WrapMonoid a) = hashWithSalt p a #if !MIN_VERSION_base(4,16,0) instance Hashable a => Hashable (Semi.Option a) where hashWithSalt p (Semi.Option a) = hashWithSalt p a #endif -- TODO: this instance is removed as there isn't Eq1 Min/Max, ... #if 0 -- | @since 1.3.1.0 -- instance Hashable1 Min where liftHashWithSalt h salt (Min a) = h salt a -- | @since 1.3.1.0 -- instance Hashable1 Max where liftHashWithSalt h salt (Max a) = h salt a -- | @since 1.3.1.0 -- instance Hashable1 First where liftHashWithSalt h salt (First a) = h salt a -- | @since 1.3.1.0 -- instance Hashable1 Last where liftHashWithSalt h salt (Last a) = h salt a -- | @since 1.3.1.0 -- instance Hashable1 WrappedMonoid where liftHashWithSalt h salt (WrapMonoid a) = h salt a -- | @since 1.3.1.0 -- instance Hashable1 Option where liftHashWithSalt h salt (Option a) = liftHashWithSalt h salt a #endif -- | 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 `hashInt` 0) a liftHashWithSalt h s (FS.InR a) = liftHashWithSalt h (s `hashInt` distinguisher) a instance (Hashable1 f, Hashable1 g, Hashable a) => Hashable (FS.Sum f g a) where hashWithSalt = hashWithSalt1 -- | This instance was available since 1.4.1.0 only for GHC-9.4+ -- -- @since 1.4.2.0 -- instance Hashable AB.ByteArray where hashWithSalt salt (AB.ByteArray ba) = hashByteArrayWithSalt ba 0 numBytes salt `hashWithSalt` size where size = numBytes `quot` SIZEOF_HSWORD numBytes = I# (sizeofByteArray# ba) ------------------------------------------------------------------------------- -- Hashed ------------------------------------------------------------------------------- -- | A hashable value along with the result of the 'hash' function. data Hashed a = Hashed a {-# UNPACK #-} !Int -- | 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 -- | 'hash' has 'Eq' requirement. -- -- @since 1.4.0.0 hashedHash :: Hashed a -> Int hashedHash (Hashed _ h) = h -- | 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 Eq a => Hashable (Hashed a) where hashWithSalt = defaultHashWithSalt hash = hashedHash -- 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 foldMap f (Hashed a _) = f a foldr f acc (Hashed a _) = f a acc instance NFData a => NFData (Hashed a) where rnf = rnf . unhashed -- | '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. 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 _) = showParen (d > 10) $ showString "hashed " . sp 11 a ------------------------------------------------------------------------------- -- containers ------------------------------------------------------------------------------- -- | @since 1.3.4.0 instance Hashable2 Map.Map where liftHashWithSalt2 hk hv s m = Map.foldlWithKey' (\s' k v -> hv (hk s' k) v) (hashWithSalt s (Map.size m)) m -- | @since 1.3.4.0 instance Hashable k => Hashable1 (Map.Map k) where liftHashWithSalt h s m = Map.foldlWithKey' (\s' k v -> h (hashWithSalt s' k) v) (hashWithSalt s (Map.size m)) m -- | @since 1.3.4.0 instance (Hashable k, Hashable v) => Hashable (Map.Map k v) where hashWithSalt = hashWithSalt2 -- | @since 1.3.4.0 instance Hashable1 IntMap.IntMap where liftHashWithSalt h s m = IntMap.foldlWithKey' (\s' k v -> h (hashWithSalt s' k) v) (hashWithSalt s (IntMap.size m)) m -- | @since 1.3.4.0 instance Hashable v => Hashable (IntMap.IntMap v) where hashWithSalt = hashWithSalt1 -- | @since 1.3.4.0 instance Hashable1 Set.Set where liftHashWithSalt h s x = Set.foldl' h (hashWithSalt s (Set.size x)) x -- | @since 1.3.4.0 instance Hashable v => Hashable (Set.Set v) where hashWithSalt = hashWithSalt1 -- | @since 1.3.4.0 instance Hashable IntSet.IntSet where hashWithSalt salt x = IntSet.foldl' hashWithSalt (hashWithSalt salt (IntSet.size x)) x -- | @since 1.3.4.0 instance Hashable1 Seq.Seq where liftHashWithSalt h s x = foldl' h (hashWithSalt s (Seq.length x)) x -- | @since 1.3.4.0 instance Hashable v => Hashable (Seq.Seq v) where hashWithSalt = hashWithSalt1 -- | @since 1.3.4.0 instance Hashable1 Tree.Tree where liftHashWithSalt h = go where go s (Tree.Node x xs) = liftHashWithSalt go (h s x) xs -- | @since 1.3.4.0 instance Hashable v => Hashable (Tree.Tree v) where hashWithSalt = hashWithSalt1 ------------------------------------------------------------------------------- -- Solo ------------------------------------------------------------------------------- #if MIN_VERSION_base(4,15,0) instance Hashable a => Hashable (Solo a) where hashWithSalt = hashWithSalt1 instance Hashable1 Solo where liftHashWithSalt h salt (Solo x) = h salt x #endif hashable-1.4.4.0/src/Data/Hashable/Generic.hs0000644000000000000000000000101707346545000016674 0ustar0000000000000000{-# LANGUAGE Safe #-} -- | -- Module : Data.Hashable.Generic -- SPDX-License-Identifier : BSD-3-Clause -- Stability : provisional -- Portability : GHC >= 7.4 -- -- Hashable support for GHC generics. -- -- @since 1.3.0.0 module Data.Hashable.Generic ( -- * Implementation using Generics. genericHashWithSalt , genericLiftHashWithSalt -- * Constraints , GHashable (..) , One , Zero , HashArgs (..) ) where import Data.Hashable.Generic.Instances () import Data.Hashable.Class hashable-1.4.4.0/src/Data/Hashable/Generic/0000755000000000000000000000000007346545000016341 5ustar0000000000000000hashable-1.4.4.0/src/Data/Hashable/Generic/Instances.hs0000644000000000000000000001041307346545000020623 0ustar0000000000000000{-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures, ScopedTypeVariables, TypeOperators, MultiParamTypeClasses, GADTs, FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE Trustworthy #-} ------------------------------------------------------------------------ -- | -- Module : Data.Hashable.Generic.Instances -- Copyright : (c) Bryan O'Sullivan 2012 -- SPDX-License-Identifier : BSD-3-Clause -- Maintainer : bos@serpentine.com -- Stability : provisional -- Portability : GHC >= 7.4 -- -- Internal module defining orphan instances for "GHC.Generics" -- module Data.Hashable.Generic.Instances () where import Data.Hashable.Class import GHC.Generics import Data.Kind (Type) -- Type without constructors instance GHashable arity V1 where ghashWithSalt _ salt _ = hashWithSalt salt () -- Constructor without arguments instance GHashable arity U1 where ghashWithSalt _ salt U1 = hashWithSalt salt () 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 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 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 instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where ghashWithSalt targs salt = liftHashWithSalt (ghashWithSalt targs) salt . unComp1 class SumSize f => GSum arity f where hashSum :: HashArgs arity a -> Int -> Int -> f a -> Int -- hashSum args salt index value = ... -- [Note: Hashing a sum type] -- -- The tree structure is used in GHC.Generics to represent the sum (and -- product) part of the generic representation of the type, e.g.: -- -- (C0 ... :+: C1 ...) :+: (C2 ... :+: (C3 ... :+: C4 ...)) -- -- The value constructed with C2 constructor is represented as (R1 (L1 ...)). -- Yet, if we think that this tree is a flat (heterogeneous) list: -- -- [C0 ..., C1 ..., C2 ..., C3 ..., C4... ] -- -- then the value constructed with C2 is a (dependent) pair (2, ...), and -- hashing it is simple: -- -- salt `hashWithSalt` (2 :: Int) `hashWithSalt` ... -- -- This is what we do below. When drilling down the tree, we count how many -- leafs are to the left (`index` variable). At the leaf case C1, we'll have an -- actual index into the sum. -- -- This works well for balanced data. However for recursive types like: -- -- data Nat = Z | S Nat -- -- the `hashWithSalt salt (S (S (S Z)))` is -- -- salt `hashWithSalt` (1 :: Int) -- first S -- `hashWithSalt` (1 :: Int) -- second S -- `hashWithSalt` (1 :: Int) -- third S -- `hashWithSalt` (0 :: Int) -- Z -- `hashWithSalt` () -- U1 -- -- For that type the manual implementation: -- -- instance Hashable Nat where -- hashWithSalt salt n = hashWithSalt salt (natToInteger n) -- -- would be better performing CPU and hash-quality wise (assuming that -- Integer's Hashable is of high quality). -- instance (GSum arity a, GSum arity b) => GHashable arity (a :+: b) where ghashWithSalt toHash salt = hashSum toHash salt 0 instance (GSum arity a, GSum arity b) => GSum arity (a :+: b) where hashSum toHash !salt !index s = case s of L1 x -> hashSum toHash salt index x R1 x -> hashSum toHash salt (index + sizeL) x where sizeL = unTagged (sumSize :: Tagged a) {-# INLINE hashSum #-} instance GHashable arity a => GSum arity (C1 c a) where hashSum toHash !salt !index (M1 x) = ghashWithSalt toHash (hashWithSalt salt index) x {-# INLINE hashSum #-} class SumSize f where sumSize :: Tagged f newtype Tagged (s :: Type -> Type) = Tagged {unTagged :: Int} instance (SumSize a, SumSize b) => SumSize (a :+: b) where sumSize = Tagged $ unTagged (sumSize :: Tagged a) + unTagged (sumSize :: Tagged b) instance SumSize (C1 c a) where sumSize = Tagged 1 hashable-1.4.4.0/src/Data/Hashable/Imports.hs0000644000000000000000000000053507346545000016761 0ustar0000000000000000-- | This module exists to avoid conditional imports -- and unused import warnings. {-# LANGUAGE Safe #-} module Data.Hashable.Imports ( Int64, Int32, Word64, Word32, xor, shiftR, shiftL, (.&.), ) where import Prelude () import Data.Int (Int64, Int32) import Data.Word (Word64, Word32) import Data.Bits (xor, shiftR, shiftL, (.&.)) hashable-1.4.4.0/src/Data/Hashable/Lifted.hs0000644000000000000000000000735707346545000016544 0ustar0000000000000000{-# LANGUAGE Safe #-} ------------------------------------------------------------------------ -- | -- Module : Data.Hashable.Lifted -- Copyright : (c) Milan Straka 2010 -- (c) Johan Tibell 2011 -- (c) Bryan O'Sullivan 2011, 2012 -- SPDX-License-Identifier : BSD-3-Clause -- 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 :: (a -> Int) -> 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. hashable-1.4.4.0/src/Data/Hashable/LowLevel.hs0000644000000000000000000001140007346545000017046 0ustar0000000000000000{-# LANGUAGE CPP, BangPatterns, MagicHash, CApiFFI, UnliftedFFITypes #-} {-# LANGUAGE Trustworthy #-} -- | A module containing low-level hash primitives. module Data.Hashable.LowLevel ( Salt, defaultSalt, hashInt, hashInt64, hashWord64, hashPtrWithSalt, hashByteArrayWithSalt, ) where #include "MachDeps.h" import Foreign.C (CString) import Foreign.Ptr (Ptr, castPtr) import GHC.Base (ByteArray#) #ifdef HASHABLE_RANDOM_SEED import System.IO.Unsafe (unsafePerformIO) #endif import Data.Hashable.Imports ------------------------------------------------------------------------------- -- Initial seed ------------------------------------------------------------------------------- type Salt = Int #ifdef HASHABLE_RANDOM_SEED initialSeed :: Word64 initialSeed = unsafePerformIO initialSeedC {-# NOINLINE initialSeed #-} foreign import capi "HsHashable.h hs_hashable_init" initialSeedC :: IO Word64 #endif -- | A default salt used in the implementation of 'hash'. defaultSalt :: Salt #ifdef HASHABLE_RANDOM_SEED defaultSalt = hashInt defaultSalt' (fromIntegral initialSeed) #else defaultSalt = defaultSalt' #endif {-# INLINE defaultSalt #-} defaultSalt' :: Salt #if WORD_SIZE_IN_BITS == 64 defaultSalt' = -3750763034362895579 -- 14695981039346656037 :: Int64 #else defaultSalt' = -2128831035 -- 2166136261 :: Int32 #endif {-# INLINE defaultSalt' #-} ------------------------------------------------------------------------------- -- Hash primitives ------------------------------------------------------------------------------- -- | Hash 'Int'. First argument is a salt, second argument is an 'Int'. -- The result is new salt / hash value. hashInt :: Salt -> Int -> Salt hashInt s x = s `rnd` x1 `rnd` x2 `rnd` x3 `rnd` x4 where {-# INLINE rnd #-} {-# INLINE x1 #-} {-# INLINE x2 #-} {-# INLINE x3 #-} {-# INLINE x4 #-} #if WORD_SIZE_IN_BITS == 64 -- See https://github.com/haskell-unordered-containers/hashable/issues/270 -- FNV-1 is defined to hash byte at the time. -- We used to hash whole Int at once, which provided very bad mixing. -- Current is a performance-quality compromise, we do four rounds per Int (instead of 8 for FNV-1 or 1 for previous hashable). rnd a b = (a * 1099511628211) `xor` b x1 = shiftR x 48 .&. 0xffff x2 = shiftR x 32 .&. 0xffff x3 = shiftR x 16 .&. 0xffff x4 = x .&. 0xffff #else rnd a b = (a * 16777619) `xor` b x1 = shiftR x 24 .&. 0xff x2 = shiftR x 16 .&. 0xff x3 = shiftR x 8 .&. 0xff x4 = x .&. 0xff #endif -- Note: FNV-1 hash takes a byte of data at once, here we take an 'Int', -- which is 4 or 8 bytes. Whether that's bad or not, I don't know. hashInt64 :: Salt -> Int64 -> Salt hashWord64 :: Salt -> Word64 -> Salt #if WORD_SIZE_IN_BITS == 64 hashInt64 s x = hashInt s (fromIntegral x) hashWord64 s x = hashInt s (fromIntegral x) #else hashInt64 s x = hashInt (hashInt s (fromIntegral x)) (fromIntegral (x `shiftR` 32)) hashWord64 s x = hashInt (hashInt s (fromIntegral x)) (fromIntegral (x `shiftR` 32)) #endif -- | Compute a hash value for the content of this pointer, using an -- initial salt. -- -- This function can for example be used to hash non-contiguous -- segments of memory as if they were one contiguous segment, by using -- the output of one hash as the salt for the next. hashPtrWithSalt :: Ptr a -- ^ pointer to the data to hash -> Int -- ^ length, in bytes -> Salt -- ^ salt -> IO Salt -- ^ hash value hashPtrWithSalt p len salt = fromIntegral `fmap` c_hashCString (castPtr p) (fromIntegral len) (fromIntegral salt) -- | Compute a hash value for the content of this 'ByteArray#', using -- an initial salt. -- -- This function can for example be used to hash non-contiguous -- segments of memory as if they were one contiguous segment, by using -- the output of one hash as the salt for the next. hashByteArrayWithSalt :: ByteArray# -- ^ data to hash -> Int -- ^ offset, in bytes -> Int -- ^ length, in bytes -> Salt -- ^ salt -> Salt -- ^ hash value hashByteArrayWithSalt ba !off !len !h = fromIntegral $ c_hashByteArray ba (fromIntegral off) (fromIntegral len) (fromIntegral h) foreign import capi unsafe "HsHashable.h hashable_fnv_hash" c_hashCString #if WORD_SIZE_IN_BITS == 64 :: CString -> Int64 -> Int64 -> IO Word64 #else :: CString -> Int32 -> Int32 -> IO Word32 #endif #if __GLASGOW_HASKELL__ >= 802 foreign import capi unsafe "HsHashable.h hashable_fnv_hash_offset" c_hashByteArray #else foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray #endif #if WORD_SIZE_IN_BITS == 64 :: ByteArray# -> Int64 -> Int64 -> Int64 -> Word64 #else :: ByteArray# -> Int32 -> Int32 -> Int32 -> Word32 #endif hashable-1.4.4.0/tests/0000755000000000000000000000000007346545000012760 5ustar0000000000000000hashable-1.4.4.0/tests/Main.hs0000644000000000000000000000057407346545000014206 0ustar0000000000000000-- | Tests for the 'Data.Hashable' module. We test functions by -- comparing the C and Haskell implementations. module Main (main) where import Properties (properties) import Regress (regressions) import Test.Framework (defaultMain, testGroup) main :: IO () main = defaultMain [ testGroup "properties" properties , testGroup "regressions" regressions ] hashable-1.4.4.0/tests/Properties.hs0000644000000000000000000002352407346545000015456 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash, Rank2Types, UnboxedTuples #-} {-# LANGUAGE DeriveGeneric, ScopedTypeVariables, PackageImports #-} -- | QuickCheck tests for the 'Data.Hashable' module. We test -- functions by comparing the C and Haskell implementations. module Properties (properties) where import Data.Hashable (Hashable, hash, hashByteArray, hashPtr, Hashed, hashed, unhashed, hashWithSalt) import Data.Hashable.Generic (genericHashWithSalt) import Data.Hashable.Lifted (hashWithSalt1) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.List (nub) import Control.Monad (ap, liftM) import System.IO.Unsafe (unsafePerformIO) import Foreign.Marshal.Array (withArray) import GHC.Base (ByteArray#, Int(..), newByteArray#, writeWord8Array#) import GHC.Exts (unsafeCoerce#) import GHC.ST (ST(..), runST) import GHC.Word (Word8(..)) import Test.QuickCheck hiding ((.&.)) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import GHC.Generics import qualified Data.ByteString.Short as BS #if MIN_VERSION_filepath(1,4,100) && !(MIN_VERSION_filepath(1,5,0)) import qualified "filepath" System.OsString.Internal.Types as FP #endif #ifdef MIN_VERSION_os_string import qualified "os-string" System.OsString.Internal.Types as OS #endif ------------------------------------------------------------------------ -- * Properties instance Arbitrary T.Text where arbitrary = T.pack `fmap` arbitrary instance Arbitrary TL.Text where arbitrary = TL.pack `fmap` arbitrary instance Arbitrary B.ByteString where arbitrary = B.pack `fmap` arbitrary instance Arbitrary BL.ByteString where arbitrary = sized $ \n -> resize (round (sqrt (toEnum n :: Double))) ((BL.fromChunks . map (B.pack . nonEmpty)) `fmap` arbitrary) where nonEmpty (NonEmpty a) = a instance Arbitrary BS.ShortByteString where arbitrary = BS.pack `fmap` arbitrary -- | Validate the implementation by comparing the C and Haskell -- versions. pHash :: [Word8] -> Bool pHash xs = unsafePerformIO $ withArray xs $ \ p -> (hashByteArray (fromList xs) 0 len ==) `fmap` hashPtr p len where len = length xs -- | Content equality implies hash equality. pText :: T.Text -> T.Text -> Bool pText a b = if (a == b) then (hash a == hash b) else True -- | Content equality implies hash equality. pTextLazy :: TL.Text -> TL.Text -> Bool pTextLazy a b = if (a == b) then (hash a == hash b) else True -- | A small positive integer. newtype ChunkSize = ChunkSize { unCS :: Int } deriving (Eq, Ord, Num, Integral, Real, Enum) instance Show ChunkSize where show = show . unCS instance Arbitrary ChunkSize where arbitrary = (ChunkSize . (`mod` maxChunkSize)) `fmap` (arbitrary `suchThat` ((/=0) . (`mod` maxChunkSize))) where maxChunkSize = 16 -- | Ensure that the rechunk function causes a rechunked string to -- still match its original form. pTextRechunk :: T.Text -> NonEmptyList ChunkSize -> Bool pTextRechunk t cs = TL.fromStrict t == rechunkText t cs -- | Lazy strings must hash to the same value no matter how they are -- chunked. pTextLazyRechunked :: T.Text -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Bool pTextLazyRechunked t cs0 cs1 = hash (rechunkText t cs0) == hash (rechunkText t cs1) -- | Break up a string into chunks of different sizes. rechunkText :: T.Text -> NonEmptyList ChunkSize -> TL.Text rechunkText t0 (NonEmpty cs0) = TL.fromChunks . go t0 . cycle $ cs0 where go t _ | T.null t = [] go t (c:cs) = a : go b cs where (a,b) = T.splitAt (unCS c) t go _ [] = error "Properties.rechunk - The 'impossible' happened!" -- | Content equality implies hash equality. pBSShort :: BS.ShortByteString -> BS.ShortByteString -> Bool pBSShort a b = if (a == b) then (hash a == hash b) else True -- | Content equality implies hash equality. pBS :: B.ByteString -> B.ByteString -> Bool pBS a b = if (a == b) then (hash a == hash b) else True -- | Content equality implies hash equality. pBSLazy :: BL.ByteString -> BL.ByteString -> Bool pBSLazy a b = if (a == b) then (hash a == hash b) else True -- | Break up a string into chunks of different sizes. rechunkBS :: B.ByteString -> NonEmptyList ChunkSize -> BL.ByteString rechunkBS t0 (NonEmpty cs0) = BL.fromChunks . go t0 . cycle $ cs0 where go t _ | B.null t = [] go t (c:cs) = a : go b cs where (a,b) = B.splitAt (unCS c) t go _ [] = error "Properties.rechunkBS - The 'impossible' happened!" -- | Ensure that the rechunk function causes a rechunked string to -- still match its original form. pBSRechunk :: B.ByteString -> NonEmptyList ChunkSize -> Bool pBSRechunk t cs = fromStrict t == rechunkBS t cs -- | Lazy bytestrings must hash to the same value no matter how they -- are chunked. pBSLazyRechunked :: B.ByteString -> NonEmptyList ChunkSize -> NonEmptyList ChunkSize -> Bool pBSLazyRechunked t cs1 cs2 = hash (rechunkBS t cs1) == hash (rechunkBS t cs2) -- This wrapper is required by 'runST'. data ByteArray = BA { unBA :: ByteArray# } -- | Create a 'ByteArray#' from a list of 'Word8' values. fromList :: [Word8] -> ByteArray# fromList xs0 = unBA (runST $ ST $ \ s1# -> case newByteArray# len# s1# of (# s2#, marr# #) -> case go s2# 0 marr# xs0 of s3# -> (# s3#, BA (unsafeCoerce# marr#) #)) where !(I# len#) = length xs0 go s# _ _ [] = s# go s# i@(I# i#) marr# ((W8# x):xs) = case writeWord8Array# marr# i# x s# of s2# -> go s2# (i + 1) marr# xs -- Generics data Product2 a b = Product2 a b deriving (Eq, Generic) instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where arbitrary = Product2 `liftM` arbitrary `ap` arbitrary instance (Hashable a, Hashable b) => Hashable (Product2 a b) data Product3 a b c = Product3 a b c deriving (Eq, Generic) instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Product3 a b c) where arbitrary = Product3 `liftM` arbitrary `ap` arbitrary `ap` arbitrary instance (Hashable a, Hashable b, Hashable c) => Hashable (Product3 a b c) -- Hashes of all product types of the same shapes should be the same. pProduct2 :: Int -> String -> Bool pProduct2 x y = hash (x, y) == hash (Product2 x y) pProduct3 :: Double -> Maybe Bool -> (Int, String) -> Bool pProduct3 x y z = hash (x, y, z) == hash (Product3 x y z) data Sum2 a b = S2a a | S2b b deriving (Eq, Ord, Show, Generic) instance (Hashable a, Hashable b) => Hashable (Sum2 a b) data Sum3 a b c = S3a a | S3b b | S3c c deriving (Eq, Ord, Show, Generic) instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Sum3 a b c) where arbitrary = oneof [ fmap S3a arbitrary , fmap S3b arbitrary , fmap S3c arbitrary ] instance (Hashable a, Hashable b, Hashable c) => Hashable (Sum3 a b c) -- Hashes of the same parameter, but with different sum constructors, -- should differ. (They might legitimately collide, but that's -- vanishingly unlikely.) pSum2_differ :: Int -> Bool pSum2_differ x = nub hs == hs where hs = [ hash (S2a x :: Sum2 Int Int) , hash (S2b x :: Sum2 Int Int) ] pSum3_differ :: Int -> Bool pSum3_differ x = nub hs == hs where hs = [ hash (S3a x :: Sum3 Int Int Int) , hash (S3b x :: Sum3 Int Int Int) , hash (S3c x :: Sum3 Int Int Int) ] pGeneric :: Sum3 Int Bool String -> Int -> Bool pGeneric x salt = hashWithSalt salt x == genericHashWithSalt salt x 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 , testGroup "text" [ testProperty "text/strict" pText , testProperty "text/lazy" pTextLazy , testProperty "text/rechunk" pTextRechunk , testProperty "text/rechunked" pTextLazyRechunked ] , testGroup "bytestring" [ testProperty "bytestring/strict" pBS , testProperty "bytestring/lazy" pBSLazy , testProperty "bytestring/short" pBSShort , testProperty "bytestring/rechunk" pBSRechunk , testProperty "bytestring/rechunked" pBSLazyRechunked ] , testGroup "generics" [ -- Note: "product2" and "product3" have been temporarily -- disabled until we have added a 'hash' method to the GHashable -- class. Until then (a,b) hashes to a different value than (a -- :*: b). While this is not incorrect, it would be nicer if -- they didn't. testProperty "product2" pProduct2 , testProperty -- "product3" pProduct3 testProperty "sum2_differ" pSum2_differ , testProperty "sum3_differ" pSum3_differ , testProperty "genericHashWithSalt" pGeneric ] , testGroup "lifted law" [ testProperty "Hashed" pLiftedHashed ] ] ------------------------------------------------------------------------ -- Utilities fromStrict :: B.ByteString -> BL.ByteString fromStrict = BL.fromStrict ------------------------------------------------------------------------ -- test that instances exist instanceExists :: Hashable a => a -> () instanceExists _ = () #if MIN_VERSION_filepath(1,4,100) && !(MIN_VERSION_filepath(1,5,0)) _fp1, _fp2, _fp3 :: () _fp1 = instanceExists (undefined :: FP.OsString) _fp2 = instanceExists (undefined :: FP.WindowsString) _fp3 = instanceExists (undefined :: FP.PosixString) #endif #ifdef MIN_VERSION_os_string _os1, _os2, _os3 :: () _os1 = instanceExists (undefined :: OS.OsString) _os2 = instanceExists (undefined :: OS.WindowsString) _os3 = instanceExists (undefined :: OS.PosixString) #endif hashable-1.4.4.0/tests/Regress.hs0000644000000000000000000000771407346545000014737 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module Regress (regressions) where import qualified Test.Framework as F import Control.Monad (when) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (Assertion, assertFailure, (@?=)) import Test.Framework.Providers.QuickCheck2 (testProperty) import GHC.Generics (Generic) import Data.List (nub) import Data.Fixed (Pico) import Data.Text (Text) import Data.ByteString (ByteString) import qualified Data.Text.Lazy as TL import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as BSL8 #ifdef HAVE_MMAP import qualified Regress.Mmap as Mmap #endif import Data.Hashable #include "MachDeps.h" assertInequal :: Eq a => String -> a -> a -> Assertion assertInequal msg x y | x == y = assertFailure msg | otherwise = return () regressions :: [F.Test] regressions = [] ++ #ifdef HAVE_MMAP Mmap.regressions ++ [ testCase "Fixed" $ do (hash (1 :: Pico) == hash (2 :: Pico)) @?= False ] ++ #endif [ F.testGroup "Generic: sum of nullary constructors" [ testCase "0" $ nullaryCase 0 S0 , testCase "1" $ nullaryCase 1 S1 , testCase "2" $ nullaryCase 2 S2 , testCase "3" $ nullaryCase 3 S3 , testCase "4" $ nullaryCase 4 S4 ] , testCase "Zero tuples: issue 271" $ do assertInequal "Hash of (0,0) != 0" (hash (0 :: Int, 0 :: Int)) 0 assertInequal "Hash of (0,0,0) != 0" (hash (0 :: Int, 0 :: Int, 0 :: Int)) 0 , testProperty "odd, odd: issue 271" $ \x' y' -> let x = if odd x' then x' else x' + 1 :: Int y = if odd y' then y' else y' + 1 :: Int in hash (x, y) /= hash (negate x, negate y) , testCase "Generic: Peano https://github.com/tibbe/hashable/issues/135" $ do let ns = take 20 $ iterate S Z let hs = map hash ns hs @?= nub hs #if WORD_SIZE_IN_BITS == 64 , testCase "64 bit Text" $ do hash ("hello world" :: Text) @?= #if MIN_VERSION_text(2,0,0) 2589482369471999198 #else -1955893671357159554 #endif #endif , F.testGroup "concatenation" [ testCase "String" $ do let lhs, rhs :: (String, String) lhs = ("foo", "bar") rhs = ("foobar", "") when (hash lhs == hash rhs) $ do assertFailure "Should have different hashes" , testCase "Text" $ do let lhs, rhs :: (Text, Text) lhs = ("foo", "bar") rhs = ("foobar", "") when (hash lhs == hash rhs) $ do assertFailure "Should have different hashes" , testCase "Lazy Text" $ do let lhs, rhs :: (TL.Text, TL.Text) lhs = ("foo", "bar") rhs = ("foobar", "") when (hash lhs == hash rhs) $ do assertFailure "Should have different hashes" , testCase "ByteString" $ do let lhs, rhs :: (ByteString, ByteString) lhs = (BS8.pack "foo", BS8.pack "bar") rhs = (BS8.pack "foobar", BS8.empty) when (hash lhs == hash rhs) $ do assertFailure "Should have different hashes" , testCase "Lazy ByteString" $ do let lhs, rhs :: (BSL.ByteString, BSL.ByteString) lhs = (BSL8.pack "foo", BSL8.pack "bar") rhs = (BSL8.pack "foobar", BSL.empty) when (hash lhs == hash rhs) $ do assertFailure "Should have different hashes" ] ] where nullaryCase :: Int -> SumOfNullary -> IO () nullaryCase n s = do let salt = 42 let expected = salt `hashWithSalt` n `hashWithSalt` () let actual = hashWithSalt salt s actual @?= expected data SumOfNullary = S0 | S1 | S2 | S3 | S4 deriving (Eq, Generic) instance Hashable SumOfNullary data Nat = Z | S Nat deriving (Eq, Generic) instance Hashable Nat hashable-1.4.4.0/tests/Regress/0000755000000000000000000000000007346545000014372 5ustar0000000000000000hashable-1.4.4.0/tests/Regress/Mmap.hsc0000644000000000000000000000453307346545000015770 0ustar0000000000000000{-# LANGUAGE CApiFFI #-} module Regress.Mmap (regressions) where #include import Control.Exception (bracket, evaluate) import Control.Monad (forM_) import Data.Bits ((.|.)) import Data.ByteString.Internal (ByteString(..)) import Data.Hashable (hash) import Foreign.C.Error (throwErrnoIf, throwErrnoIfMinus1, throwErrnoIfMinus1_) import Foreign.C.Types (CInt(..), CSize(..)) import Foreign.Ptr (Ptr, intPtrToPtr, nullPtr, plusPtr) import GHC.ForeignPtr (newForeignPtr_) import System.Posix.Types (COff(..)) import Test.Framework (Test) import Test.Framework.Providers.HUnit (testCase) import qualified Data.ByteString as B withMapping :: (Ptr a -> Int -> IO ()) -> IO () withMapping go = do pageSize <- fromIntegral `fmap` getPageSize let mappingSize = pageSize * 2 bracket (mmap nullPtr mappingSize ((#const PROT_READ) .|. (#const PROT_WRITE)) ((#const MAP_ANON) .|. (#const MAP_PRIVATE)) (-1) 0) (flip munmap mappingSize) $ \mappingPtr -> do go mappingPtr (fromIntegral pageSize) mprotect (mappingPtr `plusPtr` fromIntegral pageSize) pageSize (#const PROT_NONE) hashNearPageBoundary :: IO () hashNearPageBoundary = withMapping $ \ptr pageSize -> do let initialSize = 16 fp <- newForeignPtr_ (ptr `plusPtr` (pageSize - initialSize)) let bs0 = PS fp 0 initialSize forM_ (B.tails bs0) $ \bs -> do evaluate (hash bs) regressions :: [Test] regressions = [ testCase "hashNearPageBoundary" hashNearPageBoundary ] mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a) mmap addr len prot flags fd offset = throwErrnoIf (== intPtrToPtr (#const MAP_FAILED)) "mmap" $ c_mmap addr len prot flags fd offset munmap :: Ptr a -> CSize -> IO CInt munmap addr len = throwErrnoIfMinus1 "munmap" $ c_munmap addr len mprotect :: Ptr a -> CSize -> CInt -> IO () mprotect addr len prot = throwErrnoIfMinus1_ "mprotect" $ c_mprotect addr len prot foreign import capi unsafe "sys/mman.h mmap" c_mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a) foreign import capi unsafe "sys/mman.h munmap" c_munmap :: Ptr a -> CSize -> IO CInt foreign import capi unsafe "sys/mman.h mprotect" c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt foreign import capi unsafe "unistd.h getpagesize" getPageSize :: IO CInt