{-# LANGUAGE FlexibleInstances, BangPatterns #-}
{-|
Module      : Data.Digest.Murmur32
Copyright   : (c) Thomas Schilling 2010
License     : BSD-style

Maintainer  : nominolo@gmail.com
Stability   : experimental
Portability : portable

Type class and primitives for constructing 32 bit hashes using the
MurmurHash2 algorithm.  See <http://murmurhash.googlepages.com> for
details on MurmurHash2.
-}
module Data.Digest.Murmur32
  ( Hash32, asWord32,
    Hashable32(..),
    hash32AddWord32, hash32AddInt, hash32, hash32WithSeed
  )
where

import Data.Word ( Word32 )
import Numeric ( showHex )
import Data.Bits ( Bits(xor, shiftR), FiniteBits(finiteBitSize) )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Char ( ord )
import Data.Foldable ( Foldable(foldl') )
import Data.List ( unfoldr )

-- | A 32 bit hash.
newtype Hash32 = Hash32 Word32
  deriving (Hash32 -> Hash32 -> Bool
(Hash32 -> Hash32 -> Bool)
-> (Hash32 -> Hash32 -> Bool) -> Eq Hash32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hash32 -> Hash32 -> Bool
$c/= :: Hash32 -> Hash32 -> Bool
== :: Hash32 -> Hash32 -> Bool
$c== :: Hash32 -> Hash32 -> Bool
Eq, Eq Hash32
Eq Hash32
-> (Hash32 -> Hash32 -> Ordering)
-> (Hash32 -> Hash32 -> Bool)
-> (Hash32 -> Hash32 -> Bool)
-> (Hash32 -> Hash32 -> Bool)
-> (Hash32 -> Hash32 -> Bool)
-> (Hash32 -> Hash32 -> Hash32)
-> (Hash32 -> Hash32 -> Hash32)
-> Ord Hash32
Hash32 -> Hash32 -> Bool
Hash32 -> Hash32 -> Ordering
Hash32 -> Hash32 -> Hash32
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hash32 -> Hash32 -> Hash32
$cmin :: Hash32 -> Hash32 -> Hash32
max :: Hash32 -> Hash32 -> Hash32
$cmax :: Hash32 -> Hash32 -> Hash32
>= :: Hash32 -> Hash32 -> Bool
$c>= :: Hash32 -> Hash32 -> Bool
> :: Hash32 -> Hash32 -> Bool
$c> :: Hash32 -> Hash32 -> Bool
<= :: Hash32 -> Hash32 -> Bool
$c<= :: Hash32 -> Hash32 -> Bool
< :: Hash32 -> Hash32 -> Bool
$c< :: Hash32 -> Hash32 -> Bool
compare :: Hash32 -> Hash32 -> Ordering
$ccompare :: Hash32 -> Hash32 -> Ordering
$cp1Ord :: Eq Hash32
Ord, Hash32
Hash32 -> Hash32 -> Bounded Hash32
forall a. a -> a -> Bounded a
maxBound :: Hash32
$cmaxBound :: Hash32
minBound :: Hash32
$cminBound :: Hash32
Bounded)

instance Show Hash32 where
  showsPrec :: Int -> Hash32 -> ShowS
showsPrec Int
_ (Hash32 Word32
w) = String -> ShowS
showString String
"Hash32 0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
w

-- | Extract 32 bit word from hash.
asWord32 :: Hash32 -> Word32
asWord32 :: Hash32 -> Word32
asWord32 (Hash32 Word32
w) = Word32
w

class Hashable32 a where
  hash32Add :: a -> Hash32 -> Hash32

murmur_m :: Word32
murmur_m :: Word32
murmur_m = Word32
0x5bd1e995

murmur_r :: Int
murmur_r :: Int
murmur_r = Int
24

hash32AddWord32 :: Word32 -> Hash32 -> Hash32
hash32AddWord32 :: Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
k (Hash32 Word32
h) =
  let k1 :: Word32
k1 = Word32
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
murmur_m
      k2 :: Word32
k2 = Word32
k1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
k1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
murmur_r)
      k3 :: Word32
k3 = Word32
k2 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
murmur_m
      h1 :: Word32
h1 = Word32
h Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
murmur_m
      h2 :: Word32
h2 = Word32
h1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
k3
  in Word32 -> Hash32
Hash32 Word32
h2

hash32AddInt :: Int -> Hash32 -> Hash32
hash32AddInt :: Int -> Hash32 -> Hash32
hash32AddInt !Int
k0
  | Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
forall a. HasCallStack => a
undefined :: Int) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32     -- Int is 32 bits
    = Word32 -> Hash32 -> Hash32
hash32AddWord32 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0)
  | Bool
otherwise                            -- Int is 64 bits
    = Word32 -> Hash32 -> Hash32
hash32AddWord32 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k0) (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine`
      Word32 -> Hash32 -> Hash32
hash32AddWord32 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
k0 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
32))

hash32AddFoldable :: (Hashable32 a, Foldable c) => c a -> Hash32 -> Hash32
hash32AddFoldable :: c a -> Hash32 -> Hash32
hash32AddFoldable c a
c !Hash32
h0 = (Hash32 -> a -> Hash32) -> Hash32 -> c a -> Hash32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Hash32 -> a -> Hash32
forall a. Hashable32 a => Hash32 -> a -> Hash32
f Hash32
h0 c a
c
  where f :: Hash32 -> a -> Hash32
f Hash32
h a
a = a -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add a
a Hash32
h

-- | Create a hash using a custom seed.
--
-- The seed should be non-zero, but other than that can be an
-- arbitrary number.  Different seeds will give different hashes, and
-- thus (most likely) different hash collisions.
hash32WithSeed :: Hashable32 a => Word32 -> a -> Hash32
hash32WithSeed :: Word32 -> a -> Hash32
hash32WithSeed Word32
seed a
a = Hash32 -> Hash32
hash32End (a -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add a
a (Word32 -> Hash32
Hash32 Word32
seed))

-- | Create a hash using the default seed.
hash32 :: Hashable32 a => a -> Hash32
hash32 :: a -> Hash32
hash32 = Word32 -> a -> Hash32
forall a. Hashable32 a => Word32 -> a -> Hash32
hash32WithSeed Word32
defaultSeed

-- | Combine two hash generators.  E.g.,
--
-- @
--   hashFoo (Foo a) = hash32AddInt 1 `combine` hash32Add a
-- @
combine :: (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> (Hash32 -> Hash32)
combine :: (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
combine Hash32 -> Hash32
x Hash32 -> Hash32
y = Hash32 -> Hash32
y (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash32 -> Hash32
x

hash32End :: Hash32 -> Hash32
hash32End :: Hash32 -> Hash32
hash32End (Hash32 Word32
h) =
  let h1 :: Word32
h1 = Word32
h Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
h Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
13)
      h2 :: Word32
h2 = Word32
h1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
murmur_m
      h3 :: Word32
h3 = Word32
h2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
h2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
15)
  in Word32 -> Hash32
Hash32 Word32
h3

defaultSeed :: Word32
defaultSeed :: Word32
defaultSeed = Word32
0xdeadbeef -- not 0, otherwise hash32 [0] == hash32 []

{-

On a CPU with two multipliers and two ALUs, Murmur2 can process one
word in every two cycles + set up (2 cycles) and finish (3 cycles).

Here's the data flow graph:

@
     h    k1   k2  k3  ...
     |    |     |   |
     |    * m   |   |
     |    |\    |   |
     |    | >> r    |
     |    | /   |   |
     |   xor    *   |
     |    |     |\  |
     * m  * m   | >> r
      \  /      |/  |
       xor     xor  * m
         \     /    |\
          * m * m   | >> r
           \ /      |/
           xor     xor
             \     /
              * m * m
               \ /
               xor
                 \
                  ...
@
-}

-- -------------------------------------------------------------------
-- Instances

instance Hashable32 Char where
  hash32Add :: Char -> Hash32 -> Hash32
hash32Add Char
c = Int -> Hash32 -> Hash32
hash32AddInt (Char -> Int
ord Char
c)

instance Hashable32 Int where
  hash32Add :: Int -> Hash32 -> Hash32
hash32Add = Int -> Hash32 -> Hash32
hash32AddInt

instance Hashable32 Word32 where
  hash32Add :: Word32 -> Hash32 -> Hash32
hash32Add = Word32 -> Hash32 -> Hash32
hash32AddWord32

instance Hashable32 a => Hashable32 [a] where
  hash32Add :: [a] -> Hash32 -> Hash32
hash32Add = [a] -> Hash32 -> Hash32
forall a (c :: * -> *).
(Hashable32 a, Foldable c) =>
c a -> Hash32 -> Hash32
hash32AddFoldable

instance Hashable32 Integer where
  -- Within Int range, make sure they hash to exactly the same value
  hash32Add :: Integer -> Hash32 -> Hash32
hash32Add Integer
i0
   | Integer
i0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
minBound :: Int) Bool -> Bool -> Bool
&&
      Integer
i0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
   = Int -> Hash32 -> Hash32
hash32AddInt (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i0)
   | Bool
otherwise
   -- Prefix by sign, then hash the raw data words, starting with LSB
   = Bool -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add (Integer -> Integer
forall a. Num a => a -> a
signum Integer
i0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine`
     [Word32] -> Hash32 -> Hash32
forall a (c :: * -> *).
(Hashable32 a, Foldable c) =>
c a -> Hash32 -> Hash32
hash32AddFoldable ((Integer -> Maybe (Word32, Integer)) -> Integer -> [Word32]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Integer -> Maybe (Word32, Integer)
forall a. Num a => Integer -> Maybe (a, Integer)
f (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i0) :: [Word32])
    where
      f :: Integer -> Maybe (a, Integer)
f Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Maybe (a, Integer)
forall a. Maybe a
Nothing
      f Integer
i =
        let (Integer
i', Integer
a) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
i Integer
maxWord in
        (a, Integer) -> Maybe (a, Integer)
forall a. a -> Maybe a
Just (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a, Integer
i')
      maxWord :: Integer
maxWord = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 :: Integer

instance Hashable32 Bool where
  hash32Add :: Bool -> Hash32 -> Hash32
hash32Add Bool
False = Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
1
  hash32Add Bool
True = Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
2

instance Hashable32 a => Hashable32 (Maybe a) where
  hash32Add :: Maybe a -> Hash32 -> Hash32
hash32Add Maybe a
Nothing = Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
3
  hash32Add (Just a
a) = Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
4 (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` a -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add a
a

instance (Hashable32 a, Hashable32 b) => Hashable32 (Either a b) where
  hash32Add :: Either a b -> Hash32 -> Hash32
hash32Add (Left a
a) = Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
5 (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` a -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add a
a
  hash32Add (Right b
b) = Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
6 (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` b -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add b
b

instance Hashable32 () where
  hash32Add :: () -> Hash32 -> Hash32
hash32Add () = Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
7

instance (Hashable32 a, Hashable32 b) => Hashable32 (a, b) where
  hash32Add :: (a, b) -> Hash32 -> Hash32
hash32Add (a
a, b
b) = a -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add a
a (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` b -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add b
b

instance (Hashable32 a, Hashable32 b, Hashable32 c)
    => Hashable32 (a, b, c) where
  hash32Add :: (a, b, c) -> Hash32 -> Hash32
hash32Add (a
a, b
b, c
c) =
    a -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add a
a (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` b -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add b
b (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` c -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add c
c

instance (Hashable32 a, Hashable32 b, Hashable32 c, Hashable32 d)
    => Hashable32 (a, b, c, d) where
  hash32Add :: (a, b, c, d) -> Hash32 -> Hash32
hash32Add (a
a, b
b, c
c, d
d) =
    a -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add a
a (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` b -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add b
b (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine`
    c -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add c
c (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` d -> Hash32 -> Hash32
forall a. Hashable32 a => a -> Hash32 -> Hash32
hash32Add d
d

instance Hashable32 B.ByteString where
  hash32Add :: ByteString -> Hash32 -> Hash32
hash32Add = ((Hash32 -> Hash32) -> Word8 -> Hash32 -> Hash32)
-> (Hash32 -> Hash32) -> ByteString -> Hash32 -> Hash32
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl (Hash32 -> Hash32) -> Word8 -> Hash32 -> Hash32
forall a. Integral a => (Hash32 -> Hash32) -> a -> Hash32 -> Hash32
go (Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
8)
    where go :: (Hash32 -> Hash32) -> a -> Hash32 -> Hash32
go Hash32 -> Hash32
acc a
b = Hash32 -> Hash32
acc (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` Word32 -> Hash32 -> Hash32
hash32AddWord32 (a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b)

instance Hashable32 L.ByteString where
  hash32Add :: ByteString -> Hash32 -> Hash32
hash32Add = ((Hash32 -> Hash32) -> Word8 -> Hash32 -> Hash32)
-> (Hash32 -> Hash32) -> ByteString -> Hash32 -> Hash32
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
L.foldl (Hash32 -> Hash32) -> Word8 -> Hash32 -> Hash32
forall a. Integral a => (Hash32 -> Hash32) -> a -> Hash32 -> Hash32
go (Word32 -> Hash32 -> Hash32
hash32AddWord32 Word32
9)
    where go :: (Hash32 -> Hash32) -> a -> Hash32 -> Hash32
go Hash32 -> Hash32
acc a
b = Hash32 -> Hash32
acc (Hash32 -> Hash32) -> (Hash32 -> Hash32) -> Hash32 -> Hash32
`combine` Word32 -> Hash32 -> Hash32
hash32AddWord32 (a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b)