-- |
-- Module      : Foundation.Hashing.Hashable
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : good
--
-- provide the SipHash algorithm.
-- reference: <http://131002.net/siphash/siphash.pdf>
--
module Foundation.Hashing.Hashable
    ( Hashable(..)
    ) where

import           Basement.Imports
import           Basement.Cast (cast)
import           Basement.Compat.Natural
import           Basement.Types.Word128
import           Basement.Types.Word256
import           Basement.IntegralConv
import           Basement.Numerical.Multiplicative
import qualified Basement.BoxedArray as A
import           Foundation.Tuple
import           Foundation.String
import           Foundation.Collection.Foldable
import           Foundation.Hashing.Hasher

-- | Type with the ability to be hashed
--
-- Hashable doesn't have any specific rules, and it's
-- made for raw speed. More specifically don't expect different
-- type representing the same data to hash to the same value
--
-- > hashMix (1 :: Integer) /= hashMix (1 :: Word8)
-- True
class Hashable a where
    hashMix :: Hasher st => a -> st -> st

-- specific type instances
instance Hashable Word8 where
    hashMix :: Word8 -> st -> st
hashMix Word8
w = Word8 -> st -> st
forall st. Hasher st => Word8 -> st -> st
hashMix8 Word8
w
instance Hashable Word16 where
    hashMix :: Word16 -> st -> st
hashMix Word16
w = Word16 -> st -> st
forall st. Hasher st => Word16 -> st -> st
hashMix16 Word16
w
instance Hashable Word32 where
    hashMix :: Word32 -> st -> st
hashMix Word32
w = Word32 -> st -> st
forall st. Hasher st => Word32 -> st -> st
hashMix32 Word32
w
instance Hashable Word64 where
    hashMix :: Word64 -> st -> st
hashMix Word64
w = Word64 -> st -> st
forall st. Hasher st => Word64 -> st -> st
hashMix64 Word64
w
instance Hashable Word128 where
    hashMix :: Word128 -> st -> st
hashMix (Word128 Word64
w1 Word64
w2) = Word64 -> st -> st
forall st. Hasher st => Word64 -> st -> st
hashMix64 Word64
w2 (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> st -> st
forall st. Hasher st => Word64 -> st -> st
hashMix64 Word64
w1
instance Hashable Word256 where
    hashMix :: Word256 -> st -> st
hashMix (Word256 Word64
w1 Word64
w2 Word64
w3 Word64
w4) = Word64 -> st -> st
forall st. Hasher st => Word64 -> st -> st
hashMix64 Word64
w4 (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> st -> st
forall st. Hasher st => Word64 -> st -> st
hashMix64 Word64
w3 (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> st -> st
forall st. Hasher st => Word64 -> st -> st
hashMix64 Word64
w2 (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> st -> st
forall st. Hasher st => Word64 -> st -> st
hashMix64 Word64
w1
instance Hashable Natural where
    hashMix :: Natural -> st -> st
hashMix Natural
n st
iacc
        | Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0    = Word8 -> st -> st
forall st. Hasher st => Word8 -> st -> st
hashMix8 Word8
0 st
iacc
        | Bool
otherwise = Natural -> st -> st
forall st. Hasher st => Natural -> st -> st
loop Natural
n st
iacc
      where
        loop :: Natural -> t -> t
loop Natural
0 t
acc = t
acc
        loop Natural
w t
acc =
            let b :: Word8
b = Natural -> Word8
forall a b. IntegralDownsize a b => a -> b
integralDownsize (Natural
w :: Natural) :: Word8
             in Natural -> t -> t
loop (Natural
w Natural -> Natural -> Natural
forall a. IDivisible a => a -> a -> a
`div` Natural
256) (Word8 -> t -> t
forall st. Hasher st => Word8 -> st -> st
hashMix8 Word8
b t
acc)
instance Hashable Int8 where
    hashMix :: Int8 -> st -> st
hashMix Int8
w = Word8 -> st -> st
forall st. Hasher st => Word8 -> st -> st
hashMix8 (Int8 -> Word8
forall source destination.
Cast source destination =>
source -> destination
cast Int8
w)
instance Hashable Int16 where
    hashMix :: Int16 -> st -> st
hashMix Int16
w = Word16 -> st -> st
forall st. Hasher st => Word16 -> st -> st
hashMix16 (Int16 -> Word16
forall source destination.
Cast source destination =>
source -> destination
cast Int16
w)
instance Hashable Int32 where
    hashMix :: Int32 -> st -> st
hashMix Int32
w = Word32 -> st -> st
forall st. Hasher st => Word32 -> st -> st
hashMix32 (Int32 -> Word32
forall source destination.
Cast source destination =>
source -> destination
cast Int32
w)
instance Hashable Int64 where
    hashMix :: Int64 -> st -> st
hashMix Int64
w = Word64 -> st -> st
forall st. Hasher st => Word64 -> st -> st
hashMix64 (Int64 -> Word64
forall source destination.
Cast source destination =>
source -> destination
cast Int64
w)
instance Hashable Integer where
    hashMix :: Integer -> st -> st
hashMix Integer
i st
iacc
        | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0    = Word8 -> st -> st
forall st. Hasher st => Word8 -> st -> st
hashMix8 Word8
0 st
iacc
        | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     = Natural -> st -> st
forall st. Hasher st => Natural -> st -> st
loop (Integer -> Natural
integerToNatural Integer
i) (Word8 -> st -> st
forall st. Hasher st => Word8 -> st -> st
hashMix8 Word8
1 st
iacc)
        | Bool
otherwise = Natural -> st -> st
forall st. Hasher st => Natural -> st -> st
loop (Integer -> Natural
integerToNatural Integer
i) (Word8 -> st -> st
forall st. Hasher st => Word8 -> st -> st
hashMix8 Word8
0 st
iacc)
      where
        loop :: Hasher st => Natural -> st -> st
        loop :: Natural -> st -> st
loop Natural
0 st
acc = st
acc
        loop Natural
w st
acc =
            let b :: Word8
b = Natural -> Word8
forall a b. IntegralDownsize a b => a -> b
integralDownsize Natural
w :: Word8
             in Natural -> st -> st
forall st. Hasher st => Natural -> st -> st
loop (Natural
w Natural -> Natural -> Natural
forall a. IDivisible a => a -> a -> a
`div` Natural
256) (Word8 -> st -> st
forall st. Hasher st => Word8 -> st -> st
hashMix8 Word8
b st
acc)

instance Hashable String where
    hashMix :: String -> st -> st
hashMix String
s = UArray Word8 -> st -> st
forall st e. (Hasher st, PrimType e) => UArray e -> st -> st
hashMixBytes (Encoding -> String -> UArray Word8
toBytes Encoding
UTF8 String
s)

-- collection type instances
instance PrimType a => Hashable (UArray a) where
    hashMix :: UArray a -> st -> st
hashMix UArray a
ba = UArray a -> st -> st
forall st e. (Hasher st, PrimType e) => UArray e -> st -> st
hashMixBytes UArray a
ba
instance Hashable a => Hashable (A.Array a) where
    hashMix :: Array a -> st -> st
hashMix Array a
arr st
st = (st -> a -> st) -> st -> Array a -> st
forall a ty. (a -> ty -> a) -> a -> Array ty -> a
A.foldl' ((a -> st -> st) -> st -> a -> st
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix) st
st Array a
arr

-- combined instances
instance Hashable a => Hashable [a] where
    hashMix :: [a] -> st -> st
hashMix [a]
ba st
st = (st -> Element [a] -> st) -> st -> [a] -> st
forall collection a.
Foldable collection =>
(a -> Element collection -> a) -> a -> collection -> a
foldl' ((a -> st -> st) -> st -> a -> st
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix) st
st [a]
ba

instance (Hashable a, Hashable b) => Hashable (a,b) where
    hashMix :: (a, b) -> st -> st
hashMix (a
a,b
b) = b -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix b
b (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix a
a
instance (Hashable a, Hashable b, Hashable c) => Hashable (a,b,c) where
    hashMix :: (a, b, c) -> st -> st
hashMix (a
a,b
b,c
c) = c -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix c
c (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix b
b (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix a
a
instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (a,b,c,d) where
    hashMix :: (a, b, c, d) -> st -> st
hashMix (a
a,b
b,c
c,d
d) = d -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix d
d (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix c
c (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix b
b (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix a
a
instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) => Hashable (a,b,c,d,e) where
    hashMix :: (a, b, c, d, e) -> st -> st
hashMix (a
a,b
b,c
c,d
d,e
e) = e -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix e
e (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. d -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix d
d (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix c
c (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix b
b (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix a
a
instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e, Hashable f) => Hashable (a,b,c,d,e,f) where
    hashMix :: (a, b, c, d, e, f) -> st -> st
hashMix (a
a,b
b,c
c,d
d,e
e,f
f) = f -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix f
f (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix e
e (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. d -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix d
d (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix c
c (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix b
b (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix a
a
instance (Hashable a, Hashable b) => Hashable (Tuple2 a b) where
    hashMix :: Tuple2 a b -> st -> st
hashMix (Tuple2 a
a b
b) = b -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix b
b (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix a
a
instance (Hashable a, Hashable b, Hashable c) => Hashable (Tuple3 a b c) where
    hashMix :: Tuple3 a b c -> st -> st
hashMix (Tuple3 a
a b
b c
c) = c -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix c
c (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix b
b (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix a
a
instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (Tuple4 a b c d) where
    hashMix :: Tuple4 a b c d -> st -> st
hashMix (Tuple4 a
a b
b c
c d
d) = d -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix d
d (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix c
c (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix b
b (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix a
a
{-
instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) => Hashable (Tuple5 a b c d e) where
    hashMix (Tuple5 a b c d e) = hashMix e . hashMix d . hashMix c . hashMix b . hashMix a
instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e, Hashable f) => Hashable (Tuple6 a b c d e f) where
    hashMix (Tuple6 a b c d e f) = hashMix f . hashMix e . hashMix d . hashMix c . hashMix b . hashMix a
-}