{-# OPTIONS_HADDOCK prune #-}

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE Safe                 #-}


-- | Implements the specialized hash function for
-- this perfect hashing algorithm.
--
-- C code that makes use of the perfect hash table output must exactly
-- re-implement this 'hash' function.
module Data.PerfectHash.Hashing where

import           Data.Binary          (encode)
import           Data.Bits            (xor, (.&.))
import qualified Data.ByteString.Lazy as B (unpack)
import           Data.Char            (ord)
import           Data.Foldable        (foldl')
import           Data.Text            (Text)
import qualified Data.Text            as T
import qualified Data.PerfectHash.Types.Nonces as Nonces
import Data.PerfectHash.Types.Nonces (Nonce)

-- Types

newtype SlotIndex = SlotIndex {SlotIndex -> Int
getIndex :: Int}

newtype Hash = Hash {Hash -> Int
getHash :: Int}
  deriving (Hash -> Hash -> Bool
(Hash -> Hash -> Bool) -> (Hash -> Hash -> Bool) -> Eq Hash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hash -> Hash -> Bool
$c/= :: Hash -> Hash -> Bool
== :: Hash -> Hash -> Bool
$c== :: Hash -> Hash -> Bool
Eq, Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
(Int -> Hash -> ShowS)
-> (Hash -> String) -> ([Hash] -> ShowS) -> Show Hash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hash] -> ShowS
$cshowList :: [Hash] -> ShowS
show :: Hash -> String
$cshow :: Hash -> String
showsPrec :: Int -> Hash -> ShowS
$cshowsPrec :: Int -> Hash -> ShowS
Show)

newtype ArraySize = ArraySize Int
  deriving Int -> ArraySize -> ShowS
[ArraySize] -> ShowS
ArraySize -> String
(Int -> ArraySize -> ShowS)
-> (ArraySize -> String)
-> ([ArraySize] -> ShowS)
-> Show ArraySize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArraySize] -> ShowS
$cshowList :: [ArraySize] -> ShowS
show :: ArraySize -> String
$cshow :: ArraySize -> String
showsPrec :: Int -> ArraySize -> ShowS
$cshowsPrec :: Int -> ArraySize -> ShowS
Show


-- * Constants

-- | This choice of prime number @0x01000193@ was taken from the Python implementation
-- on <http://stevehanov.ca/blog/index.php?id=119 Steve Hanov's page>.
primeFNV :: Int
primeFNV :: Int
primeFNV = Int
0x01000193


mask32bits :: Int
mask32bits :: Int
mask32bits = Int
0xffffffff


-- * Class instances

-- | Mechanism for a key to be decomposed into units processable by the
-- <http://isthe.com/chongo/tech/comp/fnv/#FNV-1a FNV-1a> hashing algorithm.
class ToHashableChunks a where
  toHashableChunks :: a -> [Hash]

instance ToHashableChunks Int where
  toHashableChunks :: Int -> [Hash]
toHashableChunks = (Word8 -> Hash) -> [Word8] -> [Hash]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Hash
Hash(Int -> Hash) -> (Word8 -> Int) -> Word8 -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> [Hash]) -> (Int -> [Word8]) -> Int -> [Hash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack (ByteString -> [Word8]) -> (Int -> ByteString) -> Int -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
forall a. Binary a => a -> ByteString
encode

instance ToHashableChunks String where
  toHashableChunks :: String -> [Hash]
toHashableChunks = (Char -> Hash) -> String -> [Hash]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Hash) -> String -> [Hash])
-> (Char -> Hash) -> String -> [Hash]
forall a b. (a -> b) -> a -> b
$ Int -> Hash
Hash (Int -> Hash) -> (Char -> Int) -> Char -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

instance ToHashableChunks Text where
  toHashableChunks :: Text -> [Hash]
toHashableChunks = String -> [Hash]
forall a. ToHashableChunks a => a -> [Hash]
toHashableChunks (String -> [Hash]) -> (Text -> String) -> Text -> [Hash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- Utilities

generateArrayIndices :: ArraySize -> [SlotIndex]
generateArrayIndices :: ArraySize -> [SlotIndex]
generateArrayIndices (ArraySize Int
size) = (Int -> SlotIndex) -> [Int] -> [SlotIndex]
forall a b. (a -> b) -> [a] -> [b]
map Int -> SlotIndex
SlotIndex [Int
0..(Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]


-- * Main functions

hashToSlot :: ToHashableChunks a =>
     Nonce
  -> ArraySize
  -> a -- ^ key
  -> SlotIndex
hashToSlot :: Nonce -> ArraySize -> a -> SlotIndex
hashToSlot Nonce
nonce (ArraySize Int
size) a
key =
  Int -> SlotIndex
SlotIndex (Int -> SlotIndex) -> Int -> SlotIndex
forall a b. (a -> b) -> a -> b
$ Hash -> Int
getHash (Nonce -> a -> Hash
forall a. ToHashableChunks a => Nonce -> a -> Hash
hash Nonce
nonce a
key) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
size


-- Used in the 'hash' function
getNonzeroNonceVal :: Nonce -> Int
getNonzeroNonceVal :: Nonce -> Int
getNonzeroNonceVal (Nonces.Nonce Int
nonce) =
  if Int
nonce Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Int
primeFNV
    else Int
nonce


-- | The interface is comparable to the
-- <https://hackage.haskell.org/package/hashable-1.2.6.1/docs/Data-Hashable.html#v:hashWithSalt hashWithSalt>
-- function from the @hashable@ package.
--
-- Uses the \"FNV-1a\" algorithm from the
-- <http://isthe.com/chongo/tech/comp/fnv/#FNV-1a FNV website>:
--
-- > hash = offset_basis
-- > for each octet_of_data to be hashed
-- >         hash = hash xor octet_of_data
-- >         hash = hash * FNV_prime
-- > return hash
hash :: ToHashableChunks a =>
     Nonce -- ^ nonce
  -> a -- ^ key
  -> Hash
hash :: Nonce -> a -> Hash
hash Nonce
nonce =

  -- NOTE: This must be 'foldl', not 'foldr'
  Int -> Hash
Hash (Int -> Hash) -> (a -> Int) -> a -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Hash -> Int) -> Int -> [Hash] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Hash -> Int
combine Int
d ([Hash] -> Int) -> (a -> [Hash]) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Hash]
forall a. ToHashableChunks a => a -> [Hash]
toHashableChunks
  where
    d :: Int
d = Nonce -> Int
getNonzeroNonceVal Nonce
nonce

    combine :: Int -> Hash -> Int
combine Int
acc = (Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
mask32bits) (Int -> Int) -> (Hash -> Int) -> Hash -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
primeFNV) (Int -> Int) -> (Hash -> Int) -> Hash -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor Int
acc (Int -> Int) -> (Hash -> Int) -> Hash -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Int
getHash