{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}

-- |
-- Module: Data.Hash.Utils
-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>
-- License: MIT
-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>
-- Stability: experimental
--
module Data.Hash.Utils
(
-- * Pure API
  hashStorable
, hashStorable_
, hashByteString
, hashByteString_
, hashByteArray
, hashByteArray_
, hashPtr
, hashPtr_

-- * IO API
, hashStorableIO
, hashStorableIO_
, hashByteStringIO
, hashByteStringIO_
, hashByteArrayIO
, hashByteArrayIO_
) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Data.Word

import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable

import GHC.Exts
import GHC.IO
import Foreign.Marshal.Alloc

-- -------------------------------------------------------------------------- --
-- Pure API

-- Storable

hashStorable :: Storable a => (Ptr Word8 -> Int -> IO b) -> a -> b
hashStorable :: (Ptr Word8 -> Int -> IO b) -> a -> b
hashStorable Ptr Word8 -> Int -> IO b
f = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO (IO b -> b) -> (a -> IO b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Word8 -> Int -> IO b) -> a -> IO b
forall a b. Storable a => (Ptr Word8 -> Int -> IO b) -> a -> IO b
hashStorableIO Ptr Word8 -> Int -> IO b
f
{-# INLINE hashStorable #-}

hashStorable_ :: Storable a => (Ptr Word8 -> Int -> b -> IO b) -> a -> b -> b
hashStorable_ :: (Ptr Word8 -> Int -> b -> IO b) -> a -> b -> b
hashStorable_ Ptr Word8 -> Int -> b -> IO b
f a
a = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO (IO b -> b) -> (b -> IO b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Word8 -> Int -> b -> IO b) -> a -> b -> IO b
forall a b.
Storable a =>
(Ptr Word8 -> Int -> b -> IO b) -> a -> b -> IO b
hashStorableIO_ Ptr Word8 -> Int -> b -> IO b
f a
a
{-# INLINE hashStorable_ #-}

-- ByteString

hashByteString :: (Ptr Word8 -> Int -> IO b) -> B.ByteString -> b
hashByteString :: (Ptr Word8 -> Int -> IO b) -> ByteString -> b
hashByteString Ptr Word8 -> Int -> IO b
f = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO (IO b -> b) -> (ByteString -> IO b) -> ByteString -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Word8 -> Int -> IO b) -> ByteString -> IO b
forall b. (Ptr Word8 -> Int -> IO b) -> ByteString -> IO b
hashByteStringIO Ptr Word8 -> Int -> IO b
f
{-# INLINE hashByteString #-}

hashByteString_ :: (Ptr Word8 -> Int -> b -> IO b) -> B.ByteString -> b -> b
hashByteString_ :: (Ptr Word8 -> Int -> b -> IO b) -> ByteString -> b -> b
hashByteString_ Ptr Word8 -> Int -> b -> IO b
f ByteString
a = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO (IO b -> b) -> (b -> IO b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Word8 -> Int -> b -> IO b) -> ByteString -> b -> IO b
forall b.
(Ptr Word8 -> Int -> b -> IO b) -> ByteString -> b -> IO b
hashByteStringIO_ Ptr Word8 -> Int -> b -> IO b
f ByteString
a
{-# INLINE hashByteString_ #-}

-- ByteArray

hashByteArray :: (Ptr Word8 -> Int -> IO b) -> ByteArray# -> b
hashByteArray :: (Ptr Word8 -> Int -> IO b) -> ByteArray# -> b
hashByteArray Ptr Word8 -> Int -> IO b
f ByteArray#
a# = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$! (Ptr Word8 -> Int -> IO b) -> ByteArray# -> IO b
forall b. (Ptr Word8 -> Int -> IO b) -> ByteArray# -> IO b
hashByteArrayIO Ptr Word8 -> Int -> IO b
f ByteArray#
a#
{-# INLINE hashByteArray #-}

hashByteArray_ :: (Ptr Word8 -> Int -> b -> IO b) -> ByteArray# -> b -> b
hashByteArray_ :: (Ptr Word8 -> Int -> b -> IO b) -> ByteArray# -> b -> b
hashByteArray_ Ptr Word8 -> Int -> b -> IO b
f ByteArray#
a# = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO (IO b -> b) -> (b -> IO b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Word8 -> Int -> b -> IO b) -> ByteArray# -> b -> IO b
forall b.
(Ptr Word8 -> Int -> b -> IO b) -> ByteArray# -> b -> IO b
hashByteArrayIO_ Ptr Word8 -> Int -> b -> IO b
f ByteArray#
a#
{-# INLINE hashByteArray_ #-}

-- Ptr

hashPtr :: (Ptr Word8 -> Int -> IO b) -> Ptr Word8 -> Int -> b
hashPtr :: (Ptr Word8 -> Int -> IO b) -> Ptr Word8 -> Int -> b
hashPtr Ptr Word8 -> Int -> IO b
f Ptr Word8
ptr = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO (IO b -> b) -> (Int -> IO b) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> Int -> IO b
f Ptr Word8
ptr
{-# INLINE hashPtr #-}

hashPtr_ :: (Ptr Word8 -> Int -> b -> IO b) -> Ptr Word8 -> Int -> b -> b
hashPtr_ :: (Ptr Word8 -> Int -> b -> IO b) -> Ptr Word8 -> Int -> b -> b
hashPtr_ Ptr Word8 -> Int -> b -> IO b
f Ptr Word8
ptr Int
l = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO (IO b -> b) -> (b -> IO b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> Int -> b -> IO b
f Ptr Word8
ptr Int
l
{-# INLINE hashPtr_ #-}

-- -------------------------------------------------------------------------- --
-- IO API

-- Storable

hashStorableIO :: Storable a => (Ptr Word8 -> Int -> IO b) -> a -> IO b
hashStorableIO :: (Ptr Word8 -> Int -> IO b) -> a -> IO b
hashStorableIO Ptr Word8 -> Int -> IO b
f a
a = a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
a ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr Word8 -> Int -> IO b
f (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) (a -> Int
forall a. Storable a => a -> Int
sizeOf a
a)
{-# INLINE hashStorableIO #-}

hashStorableIO_ :: Storable a => (Ptr Word8 -> Int -> b -> IO b) -> a -> b -> IO b
hashStorableIO_ :: (Ptr Word8 -> Int -> b -> IO b) -> a -> b -> IO b
hashStorableIO_ Ptr Word8 -> Int -> b -> IO b
f a
a b
b = a -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
a ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr Word8 -> Int -> b -> IO b
f (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) (a -> Int
forall a. Storable a => a -> Int
sizeOf a
a) b
b
{-# INLINE hashStorableIO_ #-}

-- ByteString

hashByteStringIO :: (Ptr Word8 -> Int -> IO b) -> B.ByteString -> IO b
hashByteStringIO :: (Ptr Word8 -> Int -> IO b) -> ByteString -> IO b
hashByteStringIO Ptr Word8 -> Int -> IO b
f ByteString
a = ByteString -> (CStringLen -> IO b) -> IO b
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
a ((CStringLen -> IO b) -> IO b) -> (CStringLen -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \(!Ptr CChar
p, !Int
l) -> Ptr Word8 -> Int -> IO b
f (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p) Int
l
{-# INLINE hashByteStringIO #-}

hashByteStringIO_ :: (Ptr Word8 -> Int -> b -> IO b) -> B.ByteString -> b -> IO b
hashByteStringIO_ :: (Ptr Word8 -> Int -> b -> IO b) -> ByteString -> b -> IO b
hashByteStringIO_ Ptr Word8 -> Int -> b -> IO b
f ByteString
a b
b = ByteString -> (CStringLen -> IO b) -> IO b
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
a ((CStringLen -> IO b) -> IO b) -> (CStringLen -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \(!Ptr CChar
p, !Int
l) -> Ptr Word8 -> Int -> b -> IO b
f (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p) Int
l b
b
{-# INLINE hashByteStringIO_ #-}

-- ByteArray

hashByteArrayIO :: (Ptr Word8 -> Int -> IO b) -> ByteArray# -> IO b
hashByteArrayIO :: (Ptr Word8 -> Int -> IO b) -> ByteArray# -> IO b
hashByteArrayIO Ptr Word8 -> Int -> IO b
f ByteArray#
a# = case ByteArray# -> Int#
isByteArrayPinned# ByteArray#
a# of
    -- Pinned ByteArray
    Int#
1# -> Ptr Word8 -> Int -> IO b
f (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
a#)) (Int# -> Int
I# Int#
size#)

    -- Unpinned ByteArray, copy content to newly allocated pinned ByteArray
    Int#
_ -> Int -> (Ptr Word8 -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int# -> Int
I# Int#
size#) ((Ptr Word8 -> IO b) -> IO b) -> (Ptr Word8 -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr@(Ptr Addr#
addr#) -> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, b #)) -> IO b)
-> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
        case ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
a# Int#
0# Addr#
addr# Int#
size# State# RealWorld
s0 of
            State# RealWorld
s1 -> case Ptr Word8 -> Int -> IO b
f Ptr Word8
ptr (Int# -> Int
I# Int#
size#) of
                IO State# RealWorld -> (# State# RealWorld, b #)
run -> State# RealWorld -> (# State# RealWorld, b #)
run State# RealWorld
s1
  where
    size# :: Int#
size# = ByteArray# -> Int#
sizeofByteArray# ByteArray#
a#
{-# INLINE hashByteArrayIO #-}


hashByteArrayIO_ :: (Ptr Word8 -> Int -> b -> IO b) -> ByteArray# -> b -> IO b
hashByteArrayIO_ :: (Ptr Word8 -> Int -> b -> IO b) -> ByteArray# -> b -> IO b
hashByteArrayIO_ Ptr Word8 -> Int -> b -> IO b
f ByteArray#
a# b
b = case ByteArray# -> Int#
isByteArrayPinned# ByteArray#
a# of
    -- Pinned ByteArray
    Int#
1# -> Ptr Word8 -> Int -> b -> IO b
f (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
a#)) (Int# -> Int
I# Int#
size#) b
b

    -- Unpinned ByteArray, copy content to newly allocated pinned ByteArray
    Int#
_ -> Int -> (Ptr Word8 -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int# -> Int
I# Int#
size#) ((Ptr Word8 -> IO b) -> IO b) -> (Ptr Word8 -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr@(Ptr Addr#
addr#) -> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, b #)) -> IO b)
-> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
        case ByteArray#
-> Int# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
a# Int#
0# Addr#
addr# Int#
size# State# RealWorld
s0 of
            State# RealWorld
s1 -> case Ptr Word8 -> Int -> b -> IO b
f Ptr Word8
ptr (Int# -> Int
I# Int#
size#) b
b of
                IO State# RealWorld -> (# State# RealWorld, b #)
run -> State# RealWorld -> (# State# RealWorld, b #)
run State# RealWorld
s1
  where
    size# :: Int#
size# = ByteArray# -> Int#
sizeofByteArray# ByteArray#
a#
{-# INLINE hashByteArrayIO_ #-}