{-# LINE 1 "src/Data/Digest/XXHash.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Digest.XXHash (xxhash) where
import Data.ByteString (ByteString, useAsCStringLen)
import Data.ByteString.Builder (toLazyByteString, word64LE)
import Data.ByteString.Lazy (toStrict)
import Foreign
import Foreign.C.String
import Foreign.C.Types
import System.IO.Unsafe (unsafePerformIO)
foreign import ccall unsafe "xxhash.h XXH64"
c_XXH64 :: CString -> CSize -> CUInt -> IO Word64
xxhash_64 :: CUInt -> ByteString -> Word64
xxhash_64 :: CUInt -> ByteString -> Word64
xxhash_64 CUInt
seed = IO Word64 -> Word64
forall a. IO a -> a
unsafePerformIO (IO Word64 -> Word64)
-> (ByteString -> IO Word64) -> ByteString -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (CStringLen -> IO Word64) -> IO Word64)
-> (CStringLen -> IO Word64) -> ByteString -> IO Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> (CStringLen -> IO Word64) -> IO Word64
forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen
(\(Ptr CChar
str, Int
len) -> Ptr CChar -> CSize -> CUInt -> IO Word64
c_XXH64 Ptr CChar
str (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) CUInt
seed)
xxhash :: Integral bitLength
=> bitLength
-> ByteString
-> ByteString
xxhash :: bitLength -> ByteString -> ByteString
xxhash bitLength
bitLength ByteString
input = ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Word64 -> Builder
word64LE (CUInt -> ByteString -> Word64
xxhash_64 CUInt
seed ByteString
input) | CUInt
seed <- [CUInt
0 .. (CUInt
iterations CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
- CUInt
1)]]
where
iterations :: CUInt
iterations = Double -> CUInt
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (bitLength -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral bitLength
bitLength Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
64)