{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Hash.Class.Mutable.Internal
(
IncrementalHash(..)
, updateByteString
, updateByteStringLazy
, updateShortByteString
, updateStorable
, updateByteArray
, ResetableHash(..)
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Short as BS
import qualified Data.ByteString.Unsafe as B
import Data.Kind
import Data.Word
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import GHC.Exts
import GHC.IO
class IncrementalHash a where
type Context a :: Type
update :: Context a -> Ptr Word8 -> Int -> IO ()
finalize :: Context a -> IO a
updateByteString
:: forall a
. IncrementalHash a
=> Context a
-> B.ByteString
-> IO ()
updateByteString :: forall a. IncrementalHash a => Context a -> ByteString -> IO ()
updateByteString Context a
ctx ByteString
b = forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
b forall a b. (a -> b) -> a -> b
$ \(!Ptr CChar
p, !Int
l) ->
forall a.
IncrementalHash a =>
Context a -> Ptr Word8 -> Int -> IO ()
update @a Context a
ctx (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p) Int
l
{-# INLINE updateByteString #-}
updateByteStringLazy
:: forall a
. IncrementalHash a
=> Context a
-> BL.ByteString
-> IO ()
updateByteStringLazy :: forall a. IncrementalHash a => Context a -> ByteString -> IO ()
updateByteStringLazy Context a
ctx = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. IncrementalHash a => Context a -> ByteString -> IO ()
updateByteString @a Context a
ctx) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
{-# INLINE updateByteStringLazy #-}
updateShortByteString
:: forall a
. IncrementalHash a
=> Context a
-> BS.ShortByteString
-> IO ()
updateShortByteString :: forall a.
IncrementalHash a =>
Context a -> ShortByteString -> IO ()
updateShortByteString Context a
ctx ShortByteString
b = forall a. ShortByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ShortByteString
b forall a b. (a -> b) -> a -> b
$ \(!Ptr CChar
p, !Int
l) ->
forall a.
IncrementalHash a =>
Context a -> Ptr Word8 -> Int -> IO ()
update @a Context a
ctx (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p) Int
l
{-# INLINE updateShortByteString #-}
updateStorable
:: forall a b
. IncrementalHash a
=> Storable b
=> Context a
-> b
-> IO ()
updateStorable :: forall a b.
(IncrementalHash a, Storable b) =>
Context a -> b -> IO ()
updateStorable Context a
ctx b
b = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with b
b forall a b. (a -> b) -> a -> b
$ \Ptr b
p -> forall a.
IncrementalHash a =>
Context a -> Ptr Word8 -> Int -> IO ()
update @a Context a
ctx (forall a b. Ptr a -> Ptr b
castPtr Ptr b
p) (forall a. Storable a => a -> Int
sizeOf b
b)
{-# INLINE updateStorable #-}
updateByteArray
:: forall a
. IncrementalHash a
=> Context a
-> ByteArray#
-> IO ()
updateByteArray :: forall a. IncrementalHash a => Context a -> ByteArray# -> IO ()
updateByteArray Context a
ctx ByteArray#
a# = case ByteArray# -> Int#
isByteArrayPinned# ByteArray#
a# of
Int#
1# -> forall a.
IncrementalHash a =>
Context a -> Ptr Word8 -> Int -> IO ()
update @a Context a
ctx (forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
a#)) (Int# -> Int
I# Int#
size#)
Int#
_ -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int# -> Int
I# Int#
size#) forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr@(Ptr Addr#
addr#) -> forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
case 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 forall a.
IncrementalHash a =>
Context a -> Ptr Word8 -> Int -> IO ()
update @a Context a
ctx Ptr Word8
ptr (Int# -> Int
I# Int#
size#) of
IO State# RealWorld -> (# State# RealWorld, () #)
run -> State# RealWorld -> (# State# RealWorld, () #)
run State# RealWorld
s1
where
size# :: Int#
size# = ByteArray# -> Int#
sizeofByteArray# ByteArray#
a#
{-# INLINE updateByteArray #-}
class IncrementalHash a => ResetableHash a where
reset :: Context a -> IO ()