{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module: Data.Hash.Class.Pure
-- Copyright: Copyright © 2021 Lars Kuhtz <lakuhtz@gmail.com>
-- License: MIT
-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>
-- Stability: experimental
--
-- Hashes with pure context
--
module Data.Hash.Class.Pure
( Hash(..)
, IncrementalHash(..)

, hashPtr
, hashStorable
, hashByteString
, hashByteStringLazy
, hashShortByteString
, hashByteArray

-- * Incremental Hashing
, updateByteString
, updateByteStringLazy
, updateShortByteString
, updateStorable
, updateByteArray

-- * Utilities
, initializeWithSalt
) where

import Control.Monad

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Short as BS
import Data.Word

import Foreign.Ptr
import Foreign.Storable

import GHC.Exts

-- internal modules

import Data.Hash.Class.Pure.Internal

-- -------------------------------------------------------------------------- --
-- Class of Pure Hashes

class IncrementalHash a => Hash a where
    initialize :: Context a

-- -------------------------------------------------------------------------- --
-- hash Functions

hashPtr :: forall a. Hash a => Ptr Word8 -> Int -> IO a
hashPtr :: forall a. Hash a => Ptr Word8 -> Int -> IO a
hashPtr Ptr Word8
p Int
n = forall a. IncrementalHash a => Context a -> a
finalize forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
IncrementalHash a =>
Context a -> Ptr Word8 -> Int -> IO (Context a)
update @a (forall a. Hash a => Context a
initialize @a) Ptr Word8
p Int
n
{-# INLINE hashPtr #-}

hashByteString :: forall a . Hash a => B.ByteString -> a
hashByteString :: forall a. Hash a => ByteString -> a
hashByteString ByteString
b = forall a. IncrementalHash a => Context a -> a
finalize forall a b. (a -> b) -> a -> b
$! forall a. IncrementalHash a => Context a -> ByteString -> Context a
updateByteString @a (forall a. Hash a => Context a
initialize @a) ByteString
b
{-# INLINE hashByteString #-}

hashByteStringLazy :: forall a . Hash a => BL.ByteString -> a
hashByteStringLazy :: forall a. Hash a => ByteString -> a
hashByteStringLazy ByteString
b = forall a. IncrementalHash a => Context a -> a
finalize forall a b. (a -> b) -> a -> b
$! forall a. IncrementalHash a => Context a -> ByteString -> Context a
updateByteStringLazy @a (forall a. Hash a => Context a
initialize @a) ByteString
b
{-# INLINE hashByteStringLazy #-}

hashShortByteString :: forall a . Hash a => BS.ShortByteString -> a
hashShortByteString :: forall a. Hash a => ShortByteString -> a
hashShortByteString ShortByteString
b = forall a. IncrementalHash a => Context a -> a
finalize forall a b. (a -> b) -> a -> b
$! forall a.
IncrementalHash a =>
Context a -> ShortByteString -> Context a
updateShortByteString @a (forall a. Hash a => Context a
initialize @a) ShortByteString
b
{-# INLINE hashShortByteString #-}

hashStorable :: forall a b . Hash a => Storable b => b -> a
hashStorable :: forall a b. (Hash a, Storable b) => b -> a
hashStorable b
b = forall a. IncrementalHash a => Context a -> a
finalize forall a b. (a -> b) -> a -> b
$! forall a b.
(IncrementalHash a, Storable b) =>
Context a -> b -> Context a
updateStorable @a (forall a. Hash a => Context a
initialize @a) b
b
{-# INLINE hashStorable #-}

hashByteArray :: forall a . Hash a => ByteArray# -> a
hashByteArray :: forall a. Hash a => ByteArray# -> a
hashByteArray ByteArray#
b = forall a. IncrementalHash a => Context a -> a
finalize forall a b. (a -> b) -> a -> b
$! forall a. IncrementalHash a => Context a -> ByteArray# -> Context a
updateByteArray @a (forall a. Hash a => Context a
initialize @a) ByteArray#
b
{-# INLINE hashByteArray #-}

-- -------------------------------------------------------------------------- --
-- Utilities

-- | Utility function to initialize a hash with a salt
--
initializeWithSalt :: forall a s . Hash a => Storable s => s -> Context a
initializeWithSalt :: forall a s. (Hash a, Storable s) => s -> Context a
initializeWithSalt = forall a b.
(IncrementalHash a, Storable b) =>
Context a -> b -> Context a
updateStorable @a forall a b. (a -> b) -> a -> b
$ forall a. Hash a => Context a
initialize @a
{-# INLINE initializeWithSalt #-}