{-# LANGUAGE BangPatterns #-}

module Data.Hash.Murmur (murmur3) where

import Control.Monad (replicateM )

import Data.Serialize.Get 
    ( runGet
    , getWord32le
    )
import Data.Bits 
    ( shiftR
    , rotateL
    , xor
    )
import qualified Data.ByteString as BS 
    ( ByteString 
    , length 
    , drop
    , append
    , replicate
    )
import Data.List (foldl')
import Data.Word (Word32)

-- | MurmurHash3 (x86_32). For more details, see
-- <http://code.google.com/p/smhasher/source/browse/trunk/MurmurHash3.cpp>
murmur3 :: Word32         -- ^ Seed value
        -> BS.ByteString  -- ^ Strict bytestring data to hash
        -> Word32         -- ^ MurmurHash3 result
murmur3 :: Word32 -> ByteString -> Word32
murmur3 nHashSeed :: Word32
nHashSeed bs :: ByteString
bs = 
    Word32
h8
  where
    -- Block and tail sizes
    !nBlocks :: Int
nBlocks = ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 4
    !nTail :: Int
nTail   = ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` 4
    -- Data objects
    Right blocks :: [Word32]
blocks  = Get [Word32] -> ByteString -> Either String [Word32]
forall a. Get a -> ByteString -> Either String a
runGet (Int -> Get Word32 -> Get [Word32]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nBlocks Get Word32
getWord32le) ByteString
bs
    bsTail :: ByteString
bsTail  = Int -> ByteString -> ByteString
BS.drop (Int
nBlocksInt -> Int -> Int
forall a. Num a => a -> a -> a
*4) ByteString
bs ByteString -> ByteString -> ByteString
`BS.append` Int -> Word8 -> ByteString
BS.replicate (4Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nTail) 0
    -- Body
    !h1 :: Word32
h1   = (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> Word32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Word32 -> Word32 -> Word32
mix Word32
nHashSeed [Word32]
blocks
    -- Tail
    Right !Word32
t1   = Get Word32 -> ByteString -> Either String Word32
forall a. Get a -> ByteString -> Either String a
runGet Get Word32
getWord32le ByteString
bsTail
    !t2 :: Word32
t2   = Word32
t1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
c1
    !t3 :: Word32
t3   = Word32
t2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` 15
    !t4 :: Word32
t4   = Word32
t3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
c2
    !h2 :: Word32
h2   = Word32
h1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
t4
    -- Finalization
    !h3 :: Word32
h3   = Word32
h2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)
    !h4 :: Word32
h4   = Word32
h3 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
h3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 16) 
    !h5 :: Word32
h5   = Word32
h4 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* 0x85ebca6b
    !h6 :: Word32
h6   = Word32
h5 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
h5 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 13)
    !h7 :: Word32
h7   = Word32
h6 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* 0xc2b2ae35
    !h8 :: Word32
h8   = Word32
h7 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
h7 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 16)
    -- Mix function
    mix :: Word32 -> Word32 -> Word32
mix !Word32
r1 !Word32
k1 = Word32
r4
      where
        !k2 :: Word32
k2 = Word32
k1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
c1
        !k3 :: Word32
k3 = Word32
k2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` 15
        !k4 :: Word32
k4 = Word32
k3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
c2
        !r2 :: Word32
r2 = Word32
r1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
k4
        !r3 :: Word32
r3 = Word32
r2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` 13
        !r4 :: Word32
r4 = Word32
r3Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
*5 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 0xe6546b64
    -- Constants
    c1 :: Word32
c1 = 0xcc9e2d51 
    c2 :: Word32
c2 = 0x1b873593