{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

-- |
-- Copyright:   (c) 2017 Henri Verroken
-- Licence:     BSD3
--
-- This module provides high-level helpers for the xxHash library,
-- see <https://xxhash.com>.
module Data.Digest.XXHash.FFI (
  -- * XXH3 interface
  XXH3 (..),

  -- * Deprecated interface
  XXHash (..),
) where

import Data.Digest.XXHash.FFI.C

import qualified Data.Array.Byte as A
import qualified Data.ByteString as BS
import Data.ByteString.Internal (accursedUnutterablePerformIO)
import qualified Data.ByteString.Lazy as BL
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.Digest.XXHash.Internal
import Data.Hashable
import qualified Data.Text.Array as TA
import qualified Data.Text.Internal as TS
import qualified Data.Text.Lazy as TL
import Data.Word (Word32, Word64)
import Foreign.C
import Foreign.Ptr (plusPtr)
import GHC.Exts (ByteArray#, Int (..), Ptr (..), byteArrayContents#, isByteArrayPinned#, isTrue#, sizeofByteArray#)
import GHC.IO

{-# INLINE useBS' #-}
useBS' :: BS.ByteString -> (CString -> CSize -> IO a) -> IO a
useBS' :: forall a. ByteString -> (CString -> CSize -> IO a) -> IO a
useBS' ByteString
bs CString -> CSize -> IO a
k = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) -> CString -> CSize -> IO a
k CString
ptr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

{-# INLINE useBS #-}
useBS :: BS.ByteString -> (CString -> Int -> IO a) -> IO a
useBS :: forall a. ByteString -> (CString -> Int -> IO a) -> IO a
useBS ByteString
bs CString -> Int -> IO a
k = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) -> CString -> Int -> IO a
k CString
ptr Int
len

{-# INLINE useBA #-}
useBA :: A.ByteArray -> (CString -> Int -> IO a) -> IO a
useBA :: forall a. ByteArray -> (CString -> Int -> IO a) -> IO a
useBA (A.ByteArray ByteArray#
ba#) CString -> Int -> IO a
k = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 -> ByteArray#
-> State# RealWorld
-> (State# RealWorld -> (# State# RealWorld, a #))
-> (# State# RealWorld, a #)
forall (a :: UnliftedType) b.
a
-> State# RealWorld
-> (State# RealWorld -> (# State# RealWorld, b #))
-> (# State# RealWorld, b #)
keepAliveUnlifted# ByteArray#
ba# State# RealWorld
s0 ((State# RealWorld -> (# State# RealWorld, a #))
 -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
-> (# State# RealWorld, a #)
forall a b. (a -> b) -> a -> b
$ IO a -> State# RealWorld -> (# State# RealWorld, a #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IO a -> State# RealWorld -> (# State# RealWorld, a #))
-> IO a -> State# RealWorld -> (# State# RealWorld, a #)
forall a b. (a -> b) -> a -> b
$ CString -> Int -> IO a
k (Addr# -> CString
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba#)) (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#))

{-# INLINE isPinnedBA #-}
isPinnedBA :: A.ByteArray -> Bool
isPinnedBA :: ByteArray -> Bool
isPinnedBA (A.ByteArray ByteArray#
ba#) = Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
ba#)

{-# INLINE useTS #-}
useTS :: TS.Text -> (CString -> Int -> IO a) -> IO a
useTS :: forall a. Text -> (CString -> Int -> IO a) -> IO a
useTS ts :: Text
ts@(TS.Text ByteArray
ba Int
off Int
len) CString -> Int -> IO a
k = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
  ByteArray
-> State# RealWorld
-> (State# RealWorld -> (# State# RealWorld, a #))
-> (# State# RealWorld, a #)
forall a b.
a
-> State# RealWorld
-> (State# RealWorld -> (# State# RealWorld, b #))
-> (# State# RealWorld, b #)
keepAliveLifted# ByteArray
ba State# RealWorld
s0 ((State# RealWorld -> (# State# RealWorld, a #))
 -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
-> (# State# RealWorld, a #)
forall a b. (a -> b) -> a -> b
$
    IO a -> State# RealWorld -> (# State# RealWorld, a #)
forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
unIO (IO a -> State# RealWorld -> (# State# RealWorld, a #))
-> IO a -> State# RealWorld -> (# State# RealWorld, a #)
forall a b. (a -> b) -> a -> b
$
      CString -> Int -> IO a
k
        (Addr# -> Ptr (ZonkAny 0)
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# (Text -> ByteArray#
textArray Text
ts)) Ptr (ZonkAny 0) -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
textMult))
        (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
textMult)

{-# INLINE isPinnedTS #-}
isPinnedTS :: TS.Text -> Bool
isPinnedTS :: Text -> Bool
isPinnedTS Text
ts = Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# (Text -> ByteArray#
textArray Text
ts))

{-# INLINE textArray #-}
textArray :: TS.Text -> ByteArray#
#if MIN_VERSION_text(2,0,0)
textArray :: Text -> ByteArray#
textArray (TS.Text (TA.ByteArray ByteArray#
ba#) Int
_ Int
_) = ByteArray#
ba#
#else
textArray (TS.Text (TA.Array ba#) _ _) = ba#
#endif

{-# INLINE textMult #-}
textMult :: Int
#if MIN_VERSION_text(2,0,0)
textMult :: Int
textMult = Int
1
#else
textMult = 2
#endif

-- | Class for hashable data types.
class XXHash t where
  -- | Calculate the 32-bit xxHash using a given seed.
  xxh32
    :: t
    -- ^ Data to hash
    -> Word32
    -- ^ Seed
    -> Word32
    -- ^ Resulting hash

  -- | Calculate the 64-bit xxHash using a given seed.
  xxh64
    :: t
    -- ^ Data to hash
    -> Word64
    -- ^ Seed
    -> Word64
    -- ^ Resulting hash

{-# DEPRECATED XXHash "Use new, XXH3-based functions instead" #-}

instance XXHash BS.ByteString where
  xxh32 :: ByteString -> Word32 -> Word32
xxh32 ByteString
bs Word32
seed = CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Word32)
-> ((CString -> CSize -> IO CUInt) -> CUInt)
-> (CString -> CSize -> IO CUInt)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CUInt -> CUInt
forall a. IO a -> a
accursedUnutterablePerformIO (IO CUInt -> CUInt)
-> ((CString -> CSize -> IO CUInt) -> IO CUInt)
-> (CString -> CSize -> IO CUInt)
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CString -> CSize -> IO CUInt) -> IO CUInt
forall a. ByteString -> (CString -> CSize -> IO a) -> IO a
useBS' ByteString
bs ((CString -> CSize -> IO CUInt) -> Word32)
-> (CString -> CSize -> IO CUInt) -> Word32
forall a b. (a -> b) -> a -> b
$
    \CString
ptr CSize
len -> CString -> CSize -> CUInt -> IO CUInt
forall a. Ptr a -> CSize -> CUInt -> IO CUInt
c_xxh32 CString
ptr CSize
len (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
seed)

  xxh64 :: ByteString -> Word64 -> Word64
xxh64 ByteString
bs Word64
seed = CULLong -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULLong -> Word64)
-> ((CString -> CSize -> IO CULLong) -> CULLong)
-> (CString -> CSize -> IO CULLong)
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CULLong -> CULLong
forall a. IO a -> a
accursedUnutterablePerformIO (IO CULLong -> CULLong)
-> ((CString -> CSize -> IO CULLong) -> IO CULLong)
-> (CString -> CSize -> IO CULLong)
-> CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CString -> CSize -> IO CULLong) -> IO CULLong
forall a. ByteString -> (CString -> CSize -> IO a) -> IO a
useBS' ByteString
bs ((CString -> CSize -> IO CULLong) -> Word64)
-> (CString -> CSize -> IO CULLong) -> Word64
forall a b. (a -> b) -> a -> b
$
    \CString
ptr CSize
len -> CString -> CSize -> CULLong -> IO CULLong
forall a. Ptr a -> CSize -> CULLong -> IO CULLong
c_xxh64 CString
ptr CSize
len (Word64 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
seed)

instance XXHash BL.ByteString where
  xxh32 :: ByteString -> Word32 -> Word32
xxh32 ByteString
bs Word32
seed = CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Word32) -> (IO CUInt -> CUInt) -> IO CUInt -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CUInt -> CUInt
forall a. IO a -> a
accursedUnutterablePerformIO (IO CUInt -> Word32) -> IO CUInt -> Word32
forall a b. (a -> b) -> a -> b
$
    (XXH32State -> IO CUInt) -> IO CUInt
forall a. (XXH32State -> IO a) -> IO a
allocaXXH32State ((XXH32State -> IO CUInt) -> IO CUInt)
-> (XXH32State -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \XXH32State
state -> do
      XXH32State -> CUInt -> IO ()
c_xxh32_reset XXH32State
state (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
seed)
      (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (XXH32State -> ByteString -> IO ()
update XXH32State
state) (ByteString -> [ByteString]
BL.toChunks ByteString
bs)
      XXH32State -> IO CUInt
c_xxh32_digest XXH32State
state
    where
      update :: XXH32State -> ByteString -> IO ()
update XXH32State
state ByteString
bs' = ByteString -> (CString -> CSize -> IO ()) -> IO ()
forall a. ByteString -> (CString -> CSize -> IO a) -> IO a
useBS' ByteString
bs' ((CString -> CSize -> IO ()) -> IO ())
-> (CString -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ XXH32State -> CString -> CSize -> IO ()
forall a. XXH32State -> Ptr a -> CSize -> IO ()
c_xxh32_update XXH32State
state

  xxh64 :: ByteString -> Word64 -> Word64
xxh64 ByteString
bs Word64
seed = CULLong -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULLong -> Word64)
-> (IO CULLong -> CULLong) -> IO CULLong -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CULLong -> CULLong
forall a. IO a -> a
accursedUnutterablePerformIO (IO CULLong -> Word64) -> IO CULLong -> Word64
forall a b. (a -> b) -> a -> b
$
    (XXH32State -> IO CULLong) -> IO CULLong
forall a. (XXH32State -> IO a) -> IO a
allocaXXH64State ((XXH32State -> IO CULLong) -> IO CULLong)
-> (XXH32State -> IO CULLong) -> IO CULLong
forall a b. (a -> b) -> a -> b
$ \XXH32State
state -> do
      XXH32State -> CULLong -> IO ()
c_xxh64_reset XXH32State
state (Word64 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
seed)
      (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (XXH32State -> ByteString -> IO ()
update XXH32State
state) (ByteString -> [ByteString]
BL.toChunks ByteString
bs)
      XXH32State -> IO CULLong
c_xxh64_digest XXH32State
state
    where
      update :: XXH32State -> ByteString -> IO ()
update XXH32State
state ByteString
bs' = ByteString -> (CString -> CSize -> IO ()) -> IO ()
forall a. ByteString -> (CString -> CSize -> IO a) -> IO a
useBS' ByteString
bs' ((CString -> CSize -> IO ()) -> IO ())
-> (CString -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ XXH32State -> CString -> CSize -> IO ()
forall a. XXH32State -> Ptr a -> CSize -> IO ()
c_xxh64_update XXH32State
state

-- | A newtype over 'BS.ByteString' and `TS.Text` to provide convenient access
-- to the `XXH3` hash function via `Hashable` type class.
--
-- @since 0.3
newtype XXH3 a = XXH3 {forall a. XXH3 a -> a
unXXH3 :: a}
  deriving (XXH3 a -> XXH3 a -> Bool
(XXH3 a -> XXH3 a -> Bool)
-> (XXH3 a -> XXH3 a -> Bool) -> Eq (XXH3 a)
forall a. Eq a => XXH3 a -> XXH3 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => XXH3 a -> XXH3 a -> Bool
== :: XXH3 a -> XXH3 a -> Bool
$c/= :: forall a. Eq a => XXH3 a -> XXH3 a -> Bool
/= :: XXH3 a -> XXH3 a -> Bool
Eq, Eq (XXH3 a)
Eq (XXH3 a) =>
(XXH3 a -> XXH3 a -> Ordering)
-> (XXH3 a -> XXH3 a -> Bool)
-> (XXH3 a -> XXH3 a -> Bool)
-> (XXH3 a -> XXH3 a -> Bool)
-> (XXH3 a -> XXH3 a -> Bool)
-> (XXH3 a -> XXH3 a -> XXH3 a)
-> (XXH3 a -> XXH3 a -> XXH3 a)
-> Ord (XXH3 a)
XXH3 a -> XXH3 a -> Bool
XXH3 a -> XXH3 a -> Ordering
XXH3 a -> XXH3 a -> XXH3 a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (XXH3 a)
forall a. Ord a => XXH3 a -> XXH3 a -> Bool
forall a. Ord a => XXH3 a -> XXH3 a -> Ordering
forall a. Ord a => XXH3 a -> XXH3 a -> XXH3 a
$ccompare :: forall a. Ord a => XXH3 a -> XXH3 a -> Ordering
compare :: XXH3 a -> XXH3 a -> Ordering
$c< :: forall a. Ord a => XXH3 a -> XXH3 a -> Bool
< :: XXH3 a -> XXH3 a -> Bool
$c<= :: forall a. Ord a => XXH3 a -> XXH3 a -> Bool
<= :: XXH3 a -> XXH3 a -> Bool
$c> :: forall a. Ord a => XXH3 a -> XXH3 a -> Bool
> :: XXH3 a -> XXH3 a -> Bool
$c>= :: forall a. Ord a => XXH3 a -> XXH3 a -> Bool
>= :: XXH3 a -> XXH3 a -> Bool
$cmax :: forall a. Ord a => XXH3 a -> XXH3 a -> XXH3 a
max :: XXH3 a -> XXH3 a -> XXH3 a
$cmin :: forall a. Ord a => XXH3 a -> XXH3 a -> XXH3 a
min :: XXH3 a -> XXH3 a -> XXH3 a
Ord, Int -> XXH3 a -> ShowS
[XXH3 a] -> ShowS
XXH3 a -> String
(Int -> XXH3 a -> ShowS)
-> (XXH3 a -> String) -> ([XXH3 a] -> ShowS) -> Show (XXH3 a)
forall a. Show a => Int -> XXH3 a -> ShowS
forall a. Show a => [XXH3 a] -> ShowS
forall a. Show a => XXH3 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> XXH3 a -> ShowS
showsPrec :: Int -> XXH3 a -> ShowS
$cshow :: forall a. Show a => XXH3 a -> String
show :: XXH3 a -> String
$cshowList :: forall a. Show a => [XXH3 a] -> ShowS
showList :: [XXH3 a] -> ShowS
Show)

instance Hashable (XXH3 BS.ByteString) where
  hashWithSalt :: Int -> XXH3 ByteString -> Int
hashWithSalt Int
salt (XXH3 ByteString
bs) = CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULLong -> Int)
-> ((CString -> Int -> IO CULLong) -> CULLong)
-> (CString -> Int -> IO CULLong)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CULLong -> CULLong
forall a. IO a -> a
accursedUnutterablePerformIO (IO CULLong -> CULLong)
-> ((CString -> Int -> IO CULLong) -> IO CULLong)
-> (CString -> Int -> IO CULLong)
-> CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CString -> Int -> IO CULLong) -> IO CULLong
forall a. ByteString -> (CString -> Int -> IO a) -> IO a
useBS ByteString
bs ((CString -> Int -> IO CULLong) -> Int)
-> (CString -> Int -> IO CULLong) -> Int
forall a b. (a -> b) -> a -> b
$
    \CString
ptr Int
len ->
      (if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000000 then CString -> CSize -> CULLong -> IO CULLong
forall a. Ptr a -> CSize -> CULLong -> IO CULLong
c_xxh3_64bits_withSeed else CString -> CSize -> CULLong -> IO CULLong
forall a. Ptr a -> CSize -> CULLong -> IO CULLong
c_xxh3_64bits_withSeed_safe)
        CString
ptr
        (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
        (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
salt)

instance Hashable (XXH3 BL.ByteString) where
  hashWithSalt :: Int -> XXH3 ByteString -> Int
hashWithSalt Int
salt (XXH3 ByteString
bs) = CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULLong -> Int) -> (IO CULLong -> CULLong) -> IO CULLong -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CULLong -> CULLong
forall a. IO a -> a
accursedUnutterablePerformIO (IO CULLong -> Int) -> IO CULLong -> Int
forall a b. (a -> b) -> a -> b
$
    (XXH32State -> IO CULLong) -> IO CULLong
forall a. (XXH32State -> IO a) -> IO a
allocaXXH3State ((XXH32State -> IO CULLong) -> IO CULLong)
-> (XXH32State -> IO CULLong) -> IO CULLong
forall a b. (a -> b) -> a -> b
$ \XXH32State
state -> do
      XXH32State -> IO ()
initXXH3State XXH32State
state
      XXH32State -> CULLong -> IO ()
c_xxh3_64bits_reset_withSeed XXH32State
state (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
salt)
      (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (XXH32State -> ByteString -> IO ()
update XXH32State
state) (ByteString -> [ByteString]
BL.toChunks ByteString
bs)
      XXH32State -> IO CULLong
c_xxh3_64bits_digest XXH32State
state
    where
      update :: XXH32State -> ByteString -> IO ()
update XXH32State
state ByteString
bs' = ByteString -> (CString -> Int -> IO ()) -> IO ()
forall a. ByteString -> (CString -> Int -> IO a) -> IO a
useBS ByteString
bs' ((CString -> Int -> IO ()) -> IO ())
-> (CString -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
ptr Int
len ->
        (if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000000 then XXH32State -> CString -> CSize -> IO ()
forall a. XXH32State -> Ptr a -> CSize -> IO ()
c_xxh3_64bits_update else XXH32State -> CString -> CSize -> IO ()
forall a. XXH32State -> Ptr a -> CSize -> IO ()
c_xxh3_64bits_update_safe)
          XXH32State
state
          CString
ptr
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

instance Hashable (XXH3 A.ByteArray) where
  hashWithSalt :: Int -> XXH3 ByteArray -> Int
hashWithSalt Int
salt (XXH3 ByteArray
ba) =
    CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULLong -> Int)
-> ((CString -> Int -> IO CULLong) -> CULLong)
-> (CString -> Int -> IO CULLong)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CULLong -> CULLong
forall a. IO a -> a
accursedUnutterablePerformIO (IO CULLong -> CULLong)
-> ((CString -> Int -> IO CULLong) -> IO CULLong)
-> (CString -> Int -> IO CULLong)
-> CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> (CString -> Int -> IO CULLong) -> IO CULLong
forall a. ByteArray -> (CString -> Int -> IO a) -> IO a
useBA ByteArray
ba ((CString -> Int -> IO CULLong) -> Int)
-> (CString -> Int -> IO CULLong) -> Int
forall a b. (a -> b) -> a -> b
$
      \CString
ptr Int
len ->
        ( if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000000 Bool -> Bool -> Bool
|| Bool -> Bool
not (ByteArray -> Bool
isPinnedBA ByteArray
ba)
            then CString -> CSize -> CULLong -> IO CULLong
forall a. Ptr a -> CSize -> CULLong -> IO CULLong
c_xxh3_64bits_withSeed
            else CString -> CSize -> CULLong -> IO CULLong
forall a. Ptr a -> CSize -> CULLong -> IO CULLong
c_xxh3_64bits_withSeed_safe
        )
          CString
ptr
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
          (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
salt)

instance Hashable (XXH3 TS.Text) where
  hashWithSalt :: Int -> XXH3 Text -> Int
hashWithSalt Int
salt (XXH3 Text
ts) = CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULLong -> Int)
-> ((CString -> Int -> IO CULLong) -> CULLong)
-> (CString -> Int -> IO CULLong)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CULLong -> CULLong
forall a. IO a -> a
accursedUnutterablePerformIO (IO CULLong -> CULLong)
-> ((CString -> Int -> IO CULLong) -> IO CULLong)
-> (CString -> Int -> IO CULLong)
-> CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (CString -> Int -> IO CULLong) -> IO CULLong
forall a. Text -> (CString -> Int -> IO a) -> IO a
useTS Text
ts ((CString -> Int -> IO CULLong) -> Int)
-> (CString -> Int -> IO CULLong) -> Int
forall a b. (a -> b) -> a -> b
$
    \CString
ptr Int
len ->
      ( if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000000 Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> Bool
isPinnedTS Text
ts)
          then CString -> CSize -> CULLong -> IO CULLong
forall a. Ptr a -> CSize -> CULLong -> IO CULLong
c_xxh3_64bits_withSeed
          else CString -> CSize -> CULLong -> IO CULLong
forall a. Ptr a -> CSize -> CULLong -> IO CULLong
c_xxh3_64bits_withSeed_safe
      )
        CString
ptr
        (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
        (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
salt)

instance Hashable (XXH3 TL.Text) where
  hashWithSalt :: Int -> XXH3 Text -> Int
hashWithSalt Int
salt (XXH3 Text
ts) = CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULLong -> Int) -> (IO CULLong -> CULLong) -> IO CULLong -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CULLong -> CULLong
forall a. IO a -> a
accursedUnutterablePerformIO (IO CULLong -> Int) -> IO CULLong -> Int
forall a b. (a -> b) -> a -> b
$
    (XXH32State -> IO CULLong) -> IO CULLong
forall a. (XXH32State -> IO a) -> IO a
allocaXXH3State ((XXH32State -> IO CULLong) -> IO CULLong)
-> (XXH32State -> IO CULLong) -> IO CULLong
forall a b. (a -> b) -> a -> b
$ \XXH32State
state -> do
      XXH32State -> IO ()
initXXH3State XXH32State
state
      XXH32State -> CULLong -> IO ()
c_xxh3_64bits_reset_withSeed XXH32State
state (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
salt)
      (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (XXH32State -> Text -> IO ()
update XXH32State
state) (Text -> [Text]
TL.toChunks Text
ts)
      XXH32State -> IO CULLong
c_xxh3_64bits_digest XXH32State
state
    where
      update :: XXH32State -> Text -> IO ()
update XXH32State
state Text
ts' = Text -> (CString -> Int -> IO ()) -> IO ()
forall a. Text -> (CString -> Int -> IO a) -> IO a
useTS Text
ts' ((CString -> Int -> IO ()) -> IO ())
-> (CString -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
ptr Int
len ->
        ( if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000000 Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> Bool
isPinnedTS Text
ts')
            then XXH32State -> CString -> CSize -> IO ()
forall a. XXH32State -> Ptr a -> CSize -> IO ()
c_xxh3_64bits_update
            else XXH32State -> CString -> CSize -> IO ()
forall a. XXH32State -> Ptr a -> CSize -> IO ()
c_xxh3_64bits_update_safe
        )
          XXH32State
state
          CString
ptr
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)