Murmur32.hs

-- | An implementation of MurmurHash3_x86_32 supporting incremental addition
module Mini.Hash.Murmur32 (
  -- * Type
  Hash32,

  -- * Construction
  seed,

  -- * Operations
  add,
  digest,
) where

import Data.Bits (
  rotateL,
  shiftL,
  shiftR,
  xor,
 )
import Data.Function (
  on,
 )
import Data.Word (
  Word32,
  Word8,
 )
import Mini.Data.Recursion (
  bool,
  uncurry3,
 )
import Mini.Hash.Class (
  Hashable,
  toBytes,
 )
import Numeric (
  showHex,
 )
import Prelude (
  Eq,
  Ord,
  Show,
  compare,
  foldr,
  fromIntegral,
  null,
  showsPrec,
  ($),
  (*),
  (+),
  (.),
  (<>),
  (==),
 )

-- Type

-- | Abstract representation of a 32-bit hash value
data Hash32 = Hash32 Word32 Word32 [Word8]

instance Eq Hash32 where
  (==) = (==) `on` digest

instance Ord Hash32 where
  compare = compare `on` digest

instance Show Hash32 where
  showsPrec _ = showHex . digest

-- Construction

-- | Make a hash from a seed
seed :: Word32 -> Hash32
seed s = Hash32 s 0 []

-- Operations

-- | Add a hashable type to a hash
add :: (Hashable a) => a -> Hash32 -> Hash32
add a = addBytes $ toBytes a

-- | Get the digest of a hash
digest :: Hash32 -> Word32
digest (Hash32 h1 len t) =
  let (k0, tlen) =
        foldr
          (\a (b, n) -> (fromIntegral a `xor` (b `shiftL` 8), n + 1))
          (0, 0)
          t
      len' = len + tlen
      k1 = k0 * 0xcc9e2d51
      k2 = k1 `rotateL` 15
      k3 = k2 * 0x1b873593
      h2 = h1 `xor` k3
   in mix
        . bool
          (h2 `xor` len')
          (h1 `xor` len)
        $ null t

-- Helpers

addBytes :: [Word8] -> Hash32 -> Hash32
addBytes new (Hash32 h0 len0 old) = uncurry3 Hash32 $ go h0 len0 (old <> new)
 where
  go h len (a : b : c : d : rest) =
    let d' = fromIntegral d `shiftL` 24
        c' = fromIntegral c `shiftL` 16
        b' = fromIntegral b `shiftL` 8
        a' = fromIntegral a
        w = a' `xor` b' `xor` c' `xor` d'
        h' = murmur w h
        len' = len + 4
     in go h' len' rest
  go h len bs = (h, len, bs)

murmur :: Word32 -> Word32 -> Word32
murmur k1 h1 =
  let c1 = 0xcc9e2d51
      c2 = 0x1b873593
      c3 = 0xe6546b64
      k2 = k1 * c1
      k3 = k2 `rotateL` 15
      k4 = k3 * c2
      h2 = h1 `xor` k4
      h3 = h2 `rotateL` 13
      h4 = h3 * 5 + c3
   in h4

mix :: Word32 -> Word32
mix h1 =
  let h2 = h1 `xor` (h1 `shiftR` 16)
      h3 = h2 * 0x85ebca6b
      h4 = h3 `xor` (h3 `shiftR` 13)
      h5 = h4 * 0xc2b2ae35
      h6 = h5 `xor` (h5 `shiftR` 16)
   in h6