-- | This module defines the central type class `LargeHashable` of this package.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
module Data.LargeHashable.Class (

    LargeHashable(..), largeHash, largeHashStable, LargeHashable'(..), genericUpdateHash,
    updateHashList
) where

-- keep imports in alphabetic order (in Emacs, use "M-x sort-lines")
import Data.Bits
import Data.Char (ord)
import Data.Fixed
import Data.Foldable
import Data.Int
import Data.LargeHashable.Endianness
import Data.LargeHashable.Intern
import Data.Ratio
import Data.Time
import Data.Time.Clock.TAI
import Data.Void (Void)
import Data.Word
import Foreign.C.Types
import Foreign.Ptr
import GHC.Generics
import qualified Data.Aeson as J
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as AesonKey
import qualified Data.Aeson.KeyMap as AesonKeyMap
#endif
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Internal as BLI
import qualified Data.ByteString.Short as BS
import qualified Data.Foldable as F
import qualified Data.HashMap.Lazy as HashMap
import qualified Data.HashSet as HashSet
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as M
import qualified Data.Scientific as Sci
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import qualified Data.Strict.Tuple as Tuple
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Foreign as TF
import qualified Data.Text.Internal.Lazy as TLI
import qualified Data.Text.Lazy as TL
import qualified Data.Vector as V
import Data.Kind (Type)

-- | A type class for computing hashes (i.e. MD5, SHA256, ...) from
-- haskell values.
--
-- The laws of this typeclass are the following:
--
-- (1) If two values are equal
-- according to '==', then the finally computed hashes must also be equal
-- according to '=='. However it is not required that the hashes of inequal
-- values have to be inequal. Also note that an instance of 'LargeHashable'
-- does not require a instance of 'Eq'. Using any sane algorithm the chance
-- of a collision should be 1 / n where n is the number of different hashes
-- possible.
--
-- (2) If two values are inequal
-- according to '==', then the probability of a hash collision is 1/n,
-- where n is the number of possible hashes produced by the
-- underlying hash algorithm.
--
-- A rule of thumb: hash all information that you would also need for
-- serializing/deserializing values of your datatype. For instance, when
-- hashing lists, you would not only hash the list elements but also the
-- length of the list. Consider the following datatype
--
-- > data Foo = Foo [Int] [Int]
--
-- We now write an instance for LargeHashable like this
--
-- > instance LargeHashable Foo where
-- >     updateHash (Foo l1 l2) = updateHash l1 >> updateHash l2
--
-- If we did not hash the length of a list, then the following two values
-- of @Foo@ would produce identical hashes:
--
-- > Foo [1,2,3] []
-- > Foo [1] [2,3]
--
class LargeHashable a where
    updateHash :: a -> LH ()
    default updateHash :: (GenericLargeHashable (Rep a), Generic a) => a -> LH ()
    updateHash = a -> LH ()
forall a. (Generic a, GenericLargeHashable (Rep a)) => a -> LH ()
genericUpdateHash
    updateHashStable :: a -> LH ()
    default updateHashStable :: (GenericLargeHashable (Rep a), Generic a) => a -> LH ()
    updateHashStable = a -> LH ()
forall a. (Generic a, GenericLargeHashable (Rep a)) => a -> LH ()
genericUpdateHashStable

class LargeHashable' t where
    updateHash' :: LargeHashable a => t a -> LH ()
    updateHashStable' :: LargeHashable a => t a -> LH ()

-- | 'largeHash' is the central function of this package.
--   For a given value it computes a 'Hash' using the given
--   'HashAlgorithm'. The library tries to keep the
--   hash values for @LargeHashable@ instances provided by
--   library stable across releases, but there is no guarantee.
--   See @largeHashStable&
largeHash :: LargeHashable a => HashAlgorithm h -> a -> h
largeHash :: forall a h. LargeHashable a => HashAlgorithm h -> a -> h
largeHash HashAlgorithm h
algo a
x = HashAlgorithm h -> LH () -> h
forall h. HashAlgorithm h -> LH () -> h
runLH HashAlgorithm h
algo (a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a
x)

-- | 'largeHashStable' is similar to @largeHash@, but the hash
--   value is guaranteed to remain stable across releases,
--   even if this causes performance to degrade.
largeHashStable :: LargeHashable a => HashAlgorithm h -> a -> h
largeHashStable :: forall a h. LargeHashable a => HashAlgorithm h -> a -> h
largeHashStable HashAlgorithm h
algo a
x = HashAlgorithm h -> LH () -> h
forall h. HashAlgorithm h -> LH () -> h
runLH HashAlgorithm h
algo (a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable a
x)

{-# INLINE updateHashTextData #-}
updateHashTextData :: T.Text -> LH ()
updateHashTextData :: Text -> LH ()
updateHashTextData !Text
t = do
    HashUpdates
updates <- LH HashUpdates
hashUpdates
    IO () -> LH ()
forall a. IO a -> LH a
ioInLH (IO () -> LH ()) -> IO () -> LH ()
forall a b. (a -> b) -> a -> b
$ do
#if MIN_VERSION_text(2,0,0)
        Text -> (Ptr Word8 -> I8 -> IO ()) -> IO ()
forall a. Text -> (Ptr Word8 -> I8 -> IO a) -> IO a
TF.useAsPtr Text
t ((Ptr Word8 -> I8 -> IO ()) -> IO ())
-> (Ptr Word8 -> I8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr Word8
valPtr :: Ptr Word8) (I8
units :: TF.I8) ->
            HashUpdates -> Ptr Word8 -> Int -> IO ()
hu_updatePtr HashUpdates
updates (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
valPtr) (I8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral I8
units)
#else
        -- UTF-16 encoding
        TF.useAsPtr t $ \(valPtr :: Ptr Word16) (units :: TF.I16) ->
            hu_updatePtr updates (castPtr valPtr) (fromIntegral (2 * units))
#endif
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# INLINE updateHashText #-}
updateHashText :: T.Text -> LH ()
updateHashText :: Text -> LH ()
updateHashText !Text
t = do
    Text -> LH ()
updateHashTextData Text
t
    HashUpdates
updates <- LH HashUpdates
hashUpdates
    IO () -> LH ()
forall a. IO a -> LH a
ioInLH (IO () -> LH ()) -> IO () -> LH ()
forall a b. (a -> b) -> a -> b
$ HashUpdates -> Word64 -> IO ()
hu_updateULong HashUpdates
updates (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
t))

{-# INLINE updateHashStableTextData #-}
updateHashStableTextData :: T.Text -> LH ()
updateHashStableTextData :: Text -> LH ()
updateHashStableTextData Text
t = do
    let bs :: ByteString
bs =
            case Endianness
systemEndianness of
                Endianness
LittleEndian -> Text -> ByteString
TE.encodeUtf16LE Text
t
                Endianness
BigEndian -> Text -> ByteString
TE.encodeUtf16BE Text
t
    ByteString -> LH ()
updateHashByteStringData ByteString
bs

{-# INLINE updateHashStableText #-}
updateHashStableText :: T.Text -> LH ()
updateHashStableText :: Text -> LH ()
updateHashStableText Text
t = do
    Text -> LH ()
updateHashStableTextData Text
t
    HashUpdates
updates <- LH HashUpdates
hashUpdates
    IO () -> LH ()
forall a. IO a -> LH a
ioInLH (IO () -> LH ()) -> IO () -> LH ()
forall a b. (a -> b) -> a -> b
$ HashUpdates -> Word64 -> IO ()
hu_updateULong HashUpdates
updates (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
t))

instance LargeHashable T.Text where
    updateHash :: Text -> LH ()
updateHash = Text -> LH ()
updateHashText
    updateHashStable :: Text -> LH ()
updateHashStable = Text -> LH ()
updateHashStableText

{-# INLINE updateHashLazyText #-}
updateHashLazyText :: Int -> TL.Text -> LH ()
updateHashLazyText :: Int -> Text -> LH ()
updateHashLazyText !Int
len (TLI.Chunk !Text
t !Text
next) = do
    Text -> LH ()
updateHashTextData Text
t
    Int -> Text -> LH ()
updateHashLazyText (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t) Text
next
updateHashLazyText !Int
len Text
TLI.Empty = Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
len

{-# INLINE updateHashStableLazyText #-}
updateHashStableLazyText :: Int -> TL.Text -> LH ()
updateHashStableLazyText :: Int -> Text -> LH ()
updateHashStableLazyText !Int
len (TLI.Chunk !Text
t !Text
next) = do
    Text -> LH ()
updateHashStableTextData Text
t
    Int -> Text -> LH ()
updateHashStableLazyText (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t) Text
next
updateHashStableLazyText !Int
len Text
TLI.Empty = Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
len

instance LargeHashable TL.Text where
    updateHash :: Text -> LH ()
updateHash = Int -> Text -> LH ()
updateHashLazyText Int
0
    updateHashStable :: Text -> LH ()
updateHashStable = Int -> Text -> LH ()
updateHashStableLazyText Int
0

{-# INLINE updateHashByteStringData #-}
updateHashByteStringData :: B.ByteString -> LH ()
updateHashByteStringData :: ByteString -> LH ()
updateHashByteStringData !ByteString
b = do
    HashUpdates
updates <- LH HashUpdates
hashUpdates
    IO () -> LH ()
forall a. IO a -> LH a
ioInLH (IO () -> LH ()) -> IO () -> LH ()
forall a b. (a -> b) -> a -> b
$ do
        CString
ptr <- ByteString -> (CString -> IO CString) -> IO CString
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
b CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        HashUpdates -> Ptr Word8 -> Int -> IO ()
hu_updatePtr HashUpdates
updates (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ptr) (ByteString -> Int
B.length ByteString
b)

{-# INLINE updateHashByteString #-}
updateHashByteString :: B.ByteString -> LH ()
updateHashByteString :: ByteString -> LH ()
updateHashByteString !ByteString
b = do
    ByteString -> LH ()
updateHashByteStringData ByteString
b
    HashUpdates
updates <- LH HashUpdates
hashUpdates
    IO () -> LH ()
forall a. IO a -> LH a
ioInLH (IO () -> LH ()) -> IO () -> LH ()
forall a b. (a -> b) -> a -> b
$ HashUpdates -> Word64 -> IO ()
hu_updateULong HashUpdates
updates (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
b))

instance LargeHashable B.ByteString where
    updateHash :: ByteString -> LH ()
updateHash = ByteString -> LH ()
updateHashByteString
    updateHashStable :: ByteString -> LH ()
updateHashStable = ByteString -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

{-# INLINE updateHashLazyByteString #-}
updateHashLazyByteString :: Int -> BL.ByteString -> LH ()
updateHashLazyByteString :: Int -> ByteString -> LH ()
updateHashLazyByteString !Int
len (BLI.Chunk !ByteString
bs !ByteString
next) = do
    ByteString -> LH ()
updateHashByteStringData ByteString
bs
    Int -> ByteString -> LH ()
updateHashLazyByteString (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
bs) ByteString
next
updateHashLazyByteString !Int
len ByteString
BLI.Empty = Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
len

instance LargeHashable BL.ByteString where
    updateHash :: ByteString -> LH ()
updateHash = Int -> ByteString -> LH ()
updateHashLazyByteString Int
0
    updateHashStable :: ByteString -> LH ()
updateHashStable = ByteString -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable BS.ShortByteString where
    updateHash :: ShortByteString -> LH ()
updateHash = ByteString -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (ByteString -> LH ())
-> (ShortByteString -> ByteString) -> ShortByteString -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
BS.fromShort
    updateHashStable :: ShortByteString -> LH ()
updateHashStable = ShortByteString -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

{-# INLINE updateHashWithFun #-}
updateHashWithFun :: (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun :: forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> a -> IO ()
f a
x =
    do HashUpdates
updates <- LH HashUpdates
hashUpdates
       IO () -> LH ()
forall a. IO a -> LH a
ioInLH (IO () -> LH ()) -> IO () -> LH ()
forall a b. (a -> b) -> a -> b
$ HashUpdates -> a -> IO ()
f HashUpdates
updates a
x

instance LargeHashable Int where
    updateHash :: Int -> LH ()
updateHash = (HashUpdates -> Word64 -> IO ()) -> Word64 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word64 -> IO ()
hu_updateULong (Word64 -> LH ()) -> (Int -> Word64) -> Int -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    updateHashStable :: Int -> LH ()
updateHashStable = Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Int8 where
    updateHash :: Int8 -> LH ()
updateHash = (HashUpdates -> Word8 -> IO ()) -> Word8 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word8 -> IO ()
hu_updateUChar (Word8 -> LH ()) -> (Int8 -> Word8) -> Int8 -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    updateHashStable :: Int8 -> LH ()
updateHashStable = Int8 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Int16 where
    updateHash :: Int16 -> LH ()
updateHash = (HashUpdates -> Word16 -> IO ()) -> Word16 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word16 -> IO ()
hu_updateUShort (Word16 -> LH ()) -> (Int16 -> Word16) -> Int16 -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    updateHashStable :: Int16 -> LH ()
updateHashStable = Int16 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Int32 where
    updateHash :: Int32 -> LH ()
updateHash = (HashUpdates -> Word32 -> IO ()) -> Word32 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word32 -> IO ()
hu_updateUInt (Word32 -> LH ()) -> (Int32 -> Word32) -> Int32 -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    updateHashStable :: Int32 -> LH ()
updateHashStable = Int32 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Int64 where
    updateHash :: Int64 -> LH ()
updateHash = (HashUpdates -> Word64 -> IO ()) -> Word64 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word64 -> IO ()
hu_updateULong (Word64 -> LH ()) -> (Int64 -> Word64) -> Int64 -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    updateHashStable :: Int64 -> LH ()
updateHashStable = Int64 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Word where
    updateHash :: Word -> LH ()
updateHash = (HashUpdates -> Word64 -> IO ()) -> Word64 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word64 -> IO ()
hu_updateULong (Word64 -> LH ()) -> (Word -> Word64) -> Word -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    updateHashStable :: Word -> LH ()
updateHashStable = Word -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Word8 where
    updateHash :: Word8 -> LH ()
updateHash = (HashUpdates -> Word8 -> IO ()) -> Word8 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word8 -> IO ()
hu_updateUChar
    updateHashStable :: Word8 -> LH ()
updateHashStable = Word8 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Word16 where
    updateHash :: Word16 -> LH ()
updateHash = (HashUpdates -> Word16 -> IO ()) -> Word16 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word16 -> IO ()
hu_updateUShort
    updateHashStable :: Word16 -> LH ()
updateHashStable = Word16 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Word32 where
    updateHash :: Word32 -> LH ()
updateHash = (HashUpdates -> Word32 -> IO ()) -> Word32 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word32 -> IO ()
hu_updateUInt
    updateHashStable :: Word32 -> LH ()
updateHashStable = Word32 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Word64 where
    updateHash :: Word64 -> LH ()
updateHash = (HashUpdates -> Word64 -> IO ()) -> Word64 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word64 -> IO ()
hu_updateULong (Word64 -> LH ()) -> (Word64 -> Word64) -> Word64 -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    updateHashStable :: Word64 -> LH ()
updateHashStable = Word64 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable CChar where
    updateHash :: CChar -> LH ()
updateHash (CChar Int8
i) = (HashUpdates -> Word8 -> IO ()) -> Word8 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word8 -> IO ()
hu_updateUChar (Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
i)
    updateHashStable :: CChar -> LH ()
updateHashStable = CChar -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable CShort where
    updateHash :: CShort -> LH ()
updateHash (CShort Int16
i) = (HashUpdates -> Word16 -> IO ()) -> Word16 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word16 -> IO ()
hu_updateUShort (Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
i)
    updateHashStable :: CShort -> LH ()
updateHashStable = CShort -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable CInt where
    updateHash :: CInt -> LH ()
updateHash (CInt Int32
i) = (HashUpdates -> Word32 -> IO ()) -> Word32 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word32 -> IO ()
hu_updateUInt (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
    updateHashStable :: CInt -> LH ()
updateHashStable = CInt -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable CLong where
    updateHash :: CLong -> LH ()
updateHash (CLong Int64
i) = (HashUpdates -> Word64 -> IO ()) -> Word64 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word64 -> IO ()
hu_updateULong (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
    updateHashStable :: CLong -> LH ()
updateHashStable = CLong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable CUChar where
    updateHash :: CUChar -> LH ()
updateHash (CUChar Word8
w) = (HashUpdates -> Word8 -> IO ()) -> Word8 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word8 -> IO ()
hu_updateUChar Word8
w
    updateHashStable :: CUChar -> LH ()
updateHashStable = CUChar -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable CUShort where
    updateHash :: CUShort -> LH ()
updateHash (CUShort Word16
w) = (HashUpdates -> Word16 -> IO ()) -> Word16 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word16 -> IO ()
hu_updateUShort Word16
w
    updateHashStable :: CUShort -> LH ()
updateHashStable = CUShort -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable CUInt where
    updateHash :: CUInt -> LH ()
updateHash (CUInt Word32
w) = (HashUpdates -> Word32 -> IO ()) -> Word32 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word32 -> IO ()
hu_updateUInt Word32
w
    updateHashStable :: CUInt -> LH ()
updateHashStable = CUInt -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable CULong where
    updateHash :: CULong -> LH ()
updateHash (CULong Word64
w) = (HashUpdates -> Word64 -> IO ()) -> Word64 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word64 -> IO ()
hu_updateULong (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w)
    updateHashStable :: CULong -> LH ()
updateHashStable = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Char where
    updateHash :: Char -> LH ()
updateHash = (HashUpdates -> Word32 -> IO ()) -> Word32 -> LH ()
forall a. (HashUpdates -> a -> IO ()) -> a -> LH ()
updateHashWithFun HashUpdates -> Word32 -> IO ()
hu_updateUInt (Word32 -> LH ()) -> (Char -> Word32) -> Char -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word32
c2w
    updateHashStable :: Char -> LH ()
updateHashStable = Char -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

c2w :: Char -> Word32
{-# INLINE c2w #-}
c2w :: Char -> Word32
c2w Char
c = Int -> Word32
forall a. Enum a => Int -> a
toEnum (Char -> Int
ord Char
c :: Int)

{-# INLINE updateHashInteger #-}
updateHashInteger :: Integer -> LH ()
updateHashInteger :: Integer -> LH ()
updateHashInteger !Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = CUChar -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CUChar
0 :: CUChar)
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0  = do
        CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Integer -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffffffffffff) :: CULong)
        Integer -> LH ()
updateHashInteger (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
i (-Int
64))
    | Bool
otherwise = do
        CUChar -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CUChar
0 :: CUChar) -- prepend 0 to show it is negative
        Integer -> LH ()
updateHashInteger (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)

instance LargeHashable Integer where
    updateHash :: Integer -> LH ()
updateHash = Integer -> LH ()
updateHashInteger
    updateHashStable :: Integer -> LH ()
updateHashStable = Integer -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

foreign import ccall doubleToWord64 :: Double -> Word64

instance LargeHashable Double where
    updateHash :: Double -> LH ()
updateHash = Word64 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Word64 -> LH ()) -> (Double -> Word64) -> Double -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
doubleToWord64
    updateHashStable :: Double -> LH ()
updateHashStable = Double -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

foreign import ccall floatToWord32 :: Float -> Word32

instance LargeHashable Float where
    updateHash :: Float -> LH ()
updateHash = Word32 -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Word32 -> LH ()) -> (Float -> Word32) -> Float -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
floatToWord32
    updateHashStable :: Float -> LH ()
updateHashStable = Float -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

{-# INLINE updateHashFixed #-}
updateHashFixed :: HasResolution a => Fixed a -> LH ()
updateHashFixed :: forall a. HasResolution a => Fixed a -> LH ()
updateHashFixed Fixed a
f = Integer -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Fixed a -> Integer
forall b. Integral b => Fixed a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Fixed a -> Integer) -> (Integer -> Fixed a) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
* Fixed a
f) (Fixed a -> Fixed a) -> (Integer -> Fixed a) -> Integer -> Fixed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Fixed a
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Fixed a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
forall (p :: * -> *). p a -> Integer
resolution Fixed a
f :: Integer)

instance HasResolution a => LargeHashable (Fixed a) where
    updateHash :: Fixed a -> LH ()
updateHash = Fixed a -> LH ()
forall a. HasResolution a => Fixed a -> LH ()
updateHashFixed
    updateHashStable :: Fixed a -> LH ()
updateHashStable = Fixed a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

{-# INLINE updateHashBool #-}
updateHashBool :: Bool -> LH ()
updateHashBool :: Bool -> LH ()
updateHashBool Bool
True  = CUChar -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CUChar
1 :: CUChar)
updateHashBool Bool
False = CUChar -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CUChar
0 :: CUChar)

instance LargeHashable Bool where
    updateHash :: Bool -> LH ()
updateHash = Bool -> LH ()
updateHashBool
    updateHashStable :: Bool -> LH ()
updateHashStable = Bool -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

{-# INLINE updateHashList #-}
updateHashList :: forall a. (a -> LH ()) -> [a] -> LH ()
updateHashList :: forall a. (a -> LH ()) -> [a] -> LH ()
updateHashList a -> LH ()
f = Int -> [a] -> LH ()
loop Int
0
    where
      loop :: Int -> [a] -> LH ()
      loop :: Int -> [a] -> LH ()
loop !Int
i [] =
          Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
i
      loop !Int
i (a
x:[a]
xs) = do
          a -> LH ()
f a
x
          Int -> [a] -> LH ()
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs

instance LargeHashable a => LargeHashable [a] where
    updateHash :: [a] -> LH ()
updateHash = (a -> LH ()) -> [a] -> LH ()
forall a. (a -> LH ()) -> [a] -> LH ()
updateHashList a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash
    updateHashStable :: [a] -> LH ()
updateHashStable = (a -> LH ()) -> [a] -> LH ()
forall a. (a -> LH ()) -> [a] -> LH ()
updateHashList a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable

{-# INLINE setFoldFun #-}
setFoldFun :: LargeHashable a => (a -> LH ()) -> LH () -> a -> LH ()
setFoldFun :: forall a. LargeHashable a => (a -> LH ()) -> LH () -> a -> LH ()
setFoldFun a -> LH ()
f LH ()
action a
value = LH ()
action LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> LH ()
f a
value

{-# INLINE updateHashSet #-}
updateHashSet :: LargeHashable a => (a -> LH ()) -> S.Set a -> LH ()
updateHashSet :: forall a. LargeHashable a => (a -> LH ()) -> Set a -> LH ()
updateHashSet !a -> LH ()
f !Set a
set = do
    (LH () -> a -> LH ()) -> LH () -> Set a -> LH ()
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> LH ()) -> LH () -> a -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> LH () -> a -> LH ()
setFoldFun a -> LH ()
f) (() -> LH ()
forall a. a -> LH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Set a
set -- Note: foldl' for sets traverses the elements in asc order
    Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Set a -> Int
forall a. Set a -> Int
S.size Set a
set)

instance LargeHashable a => LargeHashable (S.Set a) where
    updateHash :: Set a -> LH ()
updateHash = (a -> LH ()) -> Set a -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> Set a -> LH ()
updateHashSet a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash
    updateHashStable :: Set a -> LH ()
updateHashStable = (a -> LH ()) -> Set a -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> Set a -> LH ()
updateHashSet a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable

{-# INLINE updateHashIntSet #-}
updateHashIntSet :: IntSet.IntSet -> LH ()
updateHashIntSet :: IntSet -> LH ()
updateHashIntSet !IntSet
set = do
    (LH () -> Int -> LH ()) -> LH () -> IntSet -> LH ()
forall a. (a -> Int -> a) -> a -> IntSet -> a
IntSet.foldl' ((Int -> LH ()) -> LH () -> Int -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> LH () -> a -> LH ()
setFoldFun Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash) (() -> LH ()
forall a. a -> LH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) IntSet
set
    Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (IntSet -> Int
IntSet.size IntSet
set)

-- Lazy and Strict IntSet share the same definition
instance LargeHashable IntSet.IntSet where
    updateHash :: IntSet -> LH ()
updateHash = IntSet -> LH ()
updateHashIntSet
    updateHashStable :: IntSet -> LH ()
updateHashStable = IntSet -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

{-# INLINE updateHashHashSet #-}
updateHashHashSet :: LargeHashable a => (a -> LH ()) -> HashSet.HashSet a -> LH ()
updateHashHashSet :: forall a. LargeHashable a => (a -> LH ()) -> HashSet a -> LH ()
updateHashHashSet !a -> LH ()
f !HashSet a
set =
    -- The ordering of elements in a set does not matter. A HashSet does not
    -- offer an efficient way of exctracting its elements in some specific
    -- ordering. So we use the auxiliary function 'hashListModuloOrdering'.
    (a -> LH ()) -> Int -> [a] -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> Int -> [a] -> LH ()
hashListModuloOrdering a -> LH ()
f (HashSet a -> Int
forall a. HashSet a -> Int
HashSet.size HashSet a
set) (HashSet a -> [a]
forall a. HashSet a -> [a]
HashSet.toList HashSet a
set)

-- | Hashes a list of values such the two permutations of the same list
-- yields the same hash.
hashListModuloOrdering :: LargeHashable a => (a -> LH ()) -> Int -> [a] -> LH ()
hashListModuloOrdering :: forall a. LargeHashable a => (a -> LH ()) -> Int -> [a] -> LH ()
hashListModuloOrdering a -> LH ()
f Int
len [a]
list =
    do [LH ()] -> LH ()
updateXorHash ((a -> LH ()) -> [a] -> [LH ()]
forall a b. (a -> b) -> [a] -> [b]
map a -> LH ()
f [a]
list)
       Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
len

-- Lazy and Strict HashSet share the same definition
instance LargeHashable a => LargeHashable (HashSet.HashSet a) where
    updateHash :: HashSet a -> LH ()
updateHash = (a -> LH ()) -> HashSet a -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> HashSet a -> LH ()
updateHashHashSet a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash
    updateHashStable :: HashSet a -> LH ()
updateHashStable = (a -> LH ()) -> HashSet a -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> HashSet a -> LH ()
updateHashHashSet a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable

{-# INLINE mapFoldFun #-}
mapFoldFun :: (LargeHashable k, LargeHashable a) =>
    (k -> LH ()) -> (a -> LH ()) -> LH () -> k -> a -> LH ()
mapFoldFun :: forall k a.
(LargeHashable k, LargeHashable a) =>
(k -> LH ()) -> (a -> LH ()) -> LH () -> k -> a -> LH ()
mapFoldFun k -> LH ()
kf a -> LH ()
vf LH ()
action k
key a
value = LH ()
action LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> k -> LH ()
kf k
key LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> LH ()
vf a
value

{-# INLINE updateHashMap #-}
updateHashMap :: (LargeHashable k, LargeHashable a) =>
    (k -> LH ()) -> (a -> LH ()) -> M.Map k a -> LH ()
updateHashMap :: forall k a.
(LargeHashable k, LargeHashable a) =>
(k -> LH ()) -> (a -> LH ()) -> Map k a -> LH ()
updateHashMap !k -> LH ()
kf !a -> LH ()
vf !Map k a
m = do
        (LH () -> k -> a -> LH ()) -> LH () -> Map k a -> LH ()
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey' ((k -> LH ()) -> (a -> LH ()) -> LH () -> k -> a -> LH ()
forall k a.
(LargeHashable k, LargeHashable a) =>
(k -> LH ()) -> (a -> LH ()) -> LH () -> k -> a -> LH ()
mapFoldFun k -> LH ()
kf a -> LH ()
vf) (() -> LH ()
forall a. a -> LH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Map k a
m
        Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Map k a -> Int
forall k a. Map k a -> Int
M.size Map k a
m)

-- Lazy and Strict Map share the same definition
instance (LargeHashable k, LargeHashable a) => LargeHashable (M.Map k a) where
    updateHash :: Map k a -> LH ()
updateHash = (k -> LH ()) -> (a -> LH ()) -> Map k a -> LH ()
forall k a.
(LargeHashable k, LargeHashable a) =>
(k -> LH ()) -> (a -> LH ()) -> Map k a -> LH ()
updateHashMap k -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash
    updateHashStable :: Map k a -> LH ()
updateHashStable = (k -> LH ()) -> (a -> LH ()) -> Map k a -> LH ()
forall k a.
(LargeHashable k, LargeHashable a) =>
(k -> LH ()) -> (a -> LH ()) -> Map k a -> LH ()
updateHashMap k -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable

{-# INLINE updateHashIntMap #-}
updateHashIntMap :: LargeHashable a => (a -> LH ()) -> IntMap.IntMap a -> LH ()
updateHashIntMap :: forall a. LargeHashable a => (a -> LH ()) -> IntMap a -> LH ()
updateHashIntMap !a -> LH ()
f !IntMap a
m = do
    (LH () -> Int -> a -> LH ()) -> LH () -> IntMap a -> LH ()
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
IntMap.foldlWithKey' ((Int -> LH ()) -> (a -> LH ()) -> LH () -> Int -> a -> LH ()
forall k a.
(LargeHashable k, LargeHashable a) =>
(k -> LH ()) -> (a -> LH ()) -> LH () -> k -> a -> LH ()
mapFoldFun Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a -> LH ()
f) (() -> LH ()
forall a. a -> LH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) IntMap a
m
    Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (IntMap a -> Int
forall a. IntMap a -> Int
IntMap.size IntMap a
m)

-- Lazy and Strict IntMap share the same definition
instance LargeHashable a => LargeHashable (IntMap.IntMap a) where
    updateHash :: IntMap a -> LH ()
updateHash = (a -> LH ()) -> IntMap a -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> IntMap a -> LH ()
updateHashIntMap a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash
    updateHashStable :: IntMap a -> LH ()
updateHashStable = (a -> LH ()) -> IntMap a -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> IntMap a -> LH ()
updateHashIntMap a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable

updateHashHashMap :: (LargeHashable k, LargeHashable v) =>
    ((k, v) -> LH ()) -> HashMap.HashMap k v -> LH ()
updateHashHashMap :: forall k v.
(LargeHashable k, LargeHashable v) =>
((k, v) -> LH ()) -> HashMap k v -> LH ()
updateHashHashMap !(k, v) -> LH ()
f !HashMap k v
m =
    -- The ordering of elements in a map do not matter. A HashMap does not
    -- offer an efficient way of exctracting its elements in some specific
    -- ordering. So we use the auxiliary function 'hashListModuloOrdering'.
    ((k, v) -> LH ()) -> Int -> [(k, v)] -> LH ()
forall a. LargeHashable a => (a -> LH ()) -> Int -> [a] -> LH ()
hashListModuloOrdering (k, v) -> LH ()
f (HashMap k v -> Int
forall k v. HashMap k v -> Int
HashMap.size HashMap k v
m) (HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap k v
m)

-- Lazy and Strict HashMap share the same definition
instance (LargeHashable k, LargeHashable v) => LargeHashable (HashMap.HashMap k v) where
    updateHash :: HashMap k v -> LH ()
updateHash = ((k, v) -> LH ()) -> HashMap k v -> LH ()
forall k v.
(LargeHashable k, LargeHashable v) =>
((k, v) -> LH ()) -> HashMap k v -> LH ()
updateHashHashMap (k, v) -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash
    updateHashStable :: HashMap k v -> LH ()
updateHashStable = ((k, v) -> LH ()) -> HashMap k v -> LH ()
forall k v.
(LargeHashable k, LargeHashable v) =>
((k, v) -> LH ()) -> HashMap k v -> LH ()
updateHashHashMap (k, v) -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable

instance (LargeHashable a, LargeHashable b) => LargeHashable (a, b) where
    updateHash :: (a, b) -> LH ()
updateHash (!a
a, !b
b) = a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a
a LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash b
b
    updateHashStable :: (a, b) -> LH ()
updateHashStable (!a
a, !b
b) = a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable a
a LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable b
b

instance (LargeHashable a, LargeHashable b, LargeHashable c) => LargeHashable (a, b, c) where
    updateHash :: (a, b, c) -> LH ()
updateHash (a
a, b
b, c
c) = a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a
a LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash b
b LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash c
c
    updateHashStable :: (a, b, c) -> LH ()
updateHashStable (a
a, b
b, c
c) = a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable a
a LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable b
b LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable c
c

instance (LargeHashable a, LargeHashable b, LargeHashable c, LargeHashable d) => LargeHashable (a, b, c, d) where
    updateHash :: (a, b, c, d) -> LH ()
updateHash (a
a, b
b, c
c, d
d) = a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a
a LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash b
b LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash c
c LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash d
d
    updateHashStable :: (a, b, c, d) -> LH ()
updateHashStable (a
a, b
b, c
c, d
d) =
        a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable a
a LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable b
b LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable c
c LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable d
d

instance (LargeHashable a, LargeHashable b, LargeHashable c, LargeHashable d, LargeHashable e) => LargeHashable (a, b, c, d, e) where
    updateHash :: (a, b, c, d, e) -> LH ()
updateHash (a
a, b
b, c
c, d
d, e
e) =
        a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a
a LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash b
b LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash c
c LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash d
d LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash e
e
    updateHashStable :: (a, b, c, d, e) -> LH ()
updateHashStable (a
a, b
b, c
c, d
d, e
e) =
        a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable a
a LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable b
b LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable c
c LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> d -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable d
d LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> e -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable e
e

instance LargeHashable a => LargeHashable (Maybe a) where
    updateHash :: Maybe a -> LH ()
updateHash Maybe a
Nothing   = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
0 :: CULong)
    updateHash (Just !a
x) = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
1 :: CULong) LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a
x
    updateHashStable :: Maybe a -> LH ()
updateHashStable Maybe a
Nothing   = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
0 :: CULong)
    updateHashStable (Just !a
x) = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
1 :: CULong) LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable a
x

instance (LargeHashable a, LargeHashable b) => LargeHashable (Either a b) where
    updateHash :: Either a b -> LH ()
updateHash (Left !a
l)  = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
0 :: CULong) LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a
l
    updateHash (Right !b
r) = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
1 :: CULong) LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash b
r
    updateHashStable :: Either a b -> LH ()
updateHashStable (Left !a
l)  = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
0 :: CULong) LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable a
l
    updateHashStable (Right !b
r) = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
1 :: CULong) LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable b
r

instance LargeHashable () where
    updateHash :: () -> LH ()
updateHash () = () -> LH ()
forall a. a -> LH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    updateHashStable :: () -> LH ()
updateHashStable () = () -> LH ()
forall a. a -> LH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance LargeHashable Ordering where
    updateHash :: Ordering -> LH ()
updateHash Ordering
EQ = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
0  :: CULong)
    updateHash Ordering
GT = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (-CULong
1 :: CULong)
    updateHash Ordering
LT = CULong -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (CULong
1  :: CULong)
    updateHashStable :: Ordering -> LH ()
updateHashStable = Ordering -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance (Integral a, LargeHashable a) => LargeHashable (Ratio a) where
    updateHash :: Ratio a -> LH ()
updateHash !Ratio a
i = do
        a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (a -> LH ()) -> a -> LH ()
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
i
        a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (a -> LH ()) -> a -> LH ()
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
i
    updateHashStable :: Ratio a -> LH ()
updateHashStable = Ratio a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable AbsoluteTime where
    updateHash :: AbsoluteTime -> LH ()
updateHash AbsoluteTime
t = DiffTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (DiffTime -> LH ()) -> DiffTime -> LH ()
forall a b. (a -> b) -> a -> b
$ AbsoluteTime -> AbsoluteTime -> DiffTime
diffAbsoluteTime AbsoluteTime
t AbsoluteTime
taiEpoch
    updateHashStable :: AbsoluteTime -> LH ()
updateHashStable = AbsoluteTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable DiffTime where
    -- could be replaced by diffTimeToPicoseconds as soon as
    -- time 1.6 becomes more common
    updateHash :: DiffTime -> LH ()
updateHash = Pico -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Pico -> LH ()) -> (DiffTime -> Pico) -> DiffTime -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (Rational -> Pico) -> (DiffTime -> Rational) -> DiffTime -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational :: DiffTime -> Pico)
    updateHashStable :: DiffTime -> LH ()
updateHashStable = DiffTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable NominalDiffTime where
    updateHash :: NominalDiffTime -> LH ()
updateHash = Pico -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Pico -> LH ())
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (Rational -> Pico)
-> (NominalDiffTime -> Rational) -> NominalDiffTime -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational :: NominalDiffTime -> Pico)
    updateHashStable :: NominalDiffTime -> LH ()
updateHashStable = NominalDiffTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable LocalTime where
    updateHash :: LocalTime -> LH ()
updateHash (LocalTime Day
d TimeOfDay
tod) = Day -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Day
d LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeOfDay -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash TimeOfDay
tod
    updateHashStable :: LocalTime -> LH ()
updateHashStable = LocalTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable ZonedTime where
    updateHash :: ZonedTime -> LH ()
updateHash (ZonedTime LocalTime
lt TimeZone
tz) = LocalTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash LocalTime
lt LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TimeZone -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash TimeZone
tz
    updateHashStable :: ZonedTime -> LH ()
updateHashStable = ZonedTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable TimeOfDay where
    updateHash :: TimeOfDay -> LH ()
updateHash (TimeOfDay Int
h Int
m Pico
s) = Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
h LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
m LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pico -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Pico
s
    updateHashStable :: TimeOfDay -> LH ()
updateHashStable = TimeOfDay -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable TimeZone where
    updateHash :: TimeZone -> LH ()
updateHash (TimeZone Int
mintz Bool
summerOnly String
name) =
        Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
mintz LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Bool
summerOnly LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash String
name
    updateHashStable :: TimeZone -> LH ()
updateHashStable (TimeZone Int
mintz Bool
summerOnly String
name) =
        Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable Int
mintz LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable Bool
summerOnly LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable String
name

instance LargeHashable UTCTime where
    updateHash :: UTCTime -> LH ()
updateHash (UTCTime Day
d DiffTime
dt) = Day -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Day
d LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiffTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash DiffTime
dt
    updateHashStable :: UTCTime -> LH ()
updateHashStable = UTCTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable Day where
    updateHash :: Day -> LH ()
updateHash (ModifiedJulianDay Integer
d) = Integer -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Integer
d
    updateHashStable :: Day -> LH ()
updateHashStable = Day -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable UniversalTime where
    updateHash :: UniversalTime -> LH ()
updateHash (ModJulianDate Rational
d) = Rational -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Rational
d
    updateHashStable :: UniversalTime -> LH ()
updateHashStable = UniversalTime -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

instance LargeHashable a => LargeHashable (V.Vector a) where
    updateHash :: Vector a -> LH ()
updateHash = [a] -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash ([a] -> LH ()) -> (Vector a -> [a]) -> Vector a -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
V.toList
    updateHashStable :: Vector a -> LH ()
updateHashStable = [a] -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable ([a] -> LH ()) -> (Vector a -> [a]) -> Vector a -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
V.toList

instance (LargeHashable a, LargeHashable b) => LargeHashable (Tuple.Pair a b) where
    updateHash :: Pair a b -> LH ()
updateHash (a
x Tuple.:!: b
y) =
        do a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash a
x
           b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash b
y
    updateHashStable :: Pair a b -> LH ()
updateHashStable (a
x Tuple.:!: b
y) =
        do a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable a
x
           b -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable b
y

instance LargeHashable Sci.Scientific where
    updateHash :: Scientific -> LH ()
updateHash Scientific
notNormalized =
        do let n :: Scientific
n = Scientific -> Scientific
Sci.normalize Scientific
notNormalized
           Integer -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Scientific -> Integer
Sci.coefficient Scientific
n)
           Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Scientific -> Int
Sci.base10Exponent Scientific
n)
    updateHashStable :: Scientific -> LH ()
updateHashStable = Scientific -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash

updateHashJson :: (forall a . LargeHashable a => a -> LH ()) -> J.Value -> LH ()
updateHashJson :: (forall a. LargeHashable a => a -> LH ()) -> Value -> LH ()
updateHashJson forall a. LargeHashable a => a -> LH ()
f Value
v =
    case Value
v of
        J.Object Object
obj ->
            do Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Int
0::Int)
               Object -> LH ()
forall a. LargeHashable a => a -> LH ()
f Object
obj
        J.Array Array
arr ->
            do Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Int
1::Int)
               Array -> LH ()
forall a. LargeHashable a => a -> LH ()
f Array
arr
        J.String Text
t ->
            do Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Int
2::Int)
               Text -> LH ()
forall a. LargeHashable a => a -> LH ()
f Text
t
        J.Number Scientific
n ->
            do Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Int
3::Int)
               Scientific -> LH ()
forall a. LargeHashable a => a -> LH ()
f Scientific
n
        J.Bool Bool
b ->
            do Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Int
4::Int)
               Bool -> LH ()
forall a. LargeHashable a => a -> LH ()
f Bool
b
        Value
J.Null ->
            Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Int
5::Int)

instance LargeHashable J.Value where
    updateHash :: Value -> LH ()
updateHash = (forall a. LargeHashable a => a -> LH ()) -> Value -> LH ()
updateHashJson a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash
    updateHashStable :: Value -> LH ()
updateHashStable = (forall a. LargeHashable a => a -> LH ()) -> Value -> LH ()
updateHashJson a -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable

#if MIN_VERSION_aeson(2,0,0)
instance LargeHashable J.Key where
    updateHash :: Key -> LH ()
updateHash = Text -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (Text -> LH ()) -> (Key -> Text) -> Key -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
AesonKey.toText
    updateHashStable :: Key -> LH ()
updateHashStable = Text -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable (Text -> LH ()) -> (Key -> Text) -> Key -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
AesonKey.toText

instance LargeHashable v => LargeHashable (AesonKeyMap.KeyMap v) where
    updateHash :: KeyMap v -> LH ()
updateHash KeyMap v
v = HashMap Key v -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (KeyMap v -> HashMap Key v
forall v. KeyMap v -> HashMap Key v
AesonKeyMap.toHashMap KeyMap v
v)
    updateHashStable :: KeyMap v -> LH ()
updateHashStable KeyMap v
v = HashMap Key v -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable (KeyMap v -> HashMap Key v
forall v. KeyMap v -> HashMap Key v
AesonKeyMap.toHashMap KeyMap v
v)
#endif

instance LargeHashable Void where
    updateHash :: Void -> LH ()
updateHash Void
_ = String -> LH ()
forall a. HasCallStack => String -> a
error String
"I'm void"

instance LargeHashable a => LargeHashable (Seq.Seq a) where
    updateHash :: Seq a -> LH ()
updateHash = [a] -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash ([a] -> LH ()) -> (Seq a -> [a]) -> Seq a -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
    updateHashStable :: Seq a -> LH ()
updateHashStable = [a] -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable ([a] -> LH ()) -> (Seq a -> [a]) -> Seq a -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

genericUpdateHash :: (Generic a, GenericLargeHashable (Rep a)) => a -> LH ()
genericUpdateHash :: forall a. (Generic a, GenericLargeHashable (Rep a)) => a -> LH ()
genericUpdateHash = Rep a Any -> LH ()
forall p. Rep a p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashGeneric (Rep a Any -> LH ()) -> (a -> Rep a Any) -> a -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
{-# INLINE genericUpdateHash #-}

genericUpdateHashStable :: (Generic a, GenericLargeHashable (Rep a)) => a -> LH ()
genericUpdateHashStable :: forall a. (Generic a, GenericLargeHashable (Rep a)) => a -> LH ()
genericUpdateHashStable = Rep a Any -> LH ()
forall p. Rep a p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashStableGeneric (Rep a Any -> LH ()) -> (a -> Rep a Any) -> a -> LH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
{-# INLINE genericUpdateHashStable #-}

-- | Support for generically deriving 'LargeHashable' instances.
-- Any instance of the type class 'GHC.Generics.Generic' can be made
-- an instance of 'LargeHashable' by an empty instance declaration.
class GenericLargeHashable f where
    updateHashGeneric :: f p -> LH ()
    updateHashStableGeneric :: f p -> LH ()

instance GenericLargeHashable V1 where
    {-# INLINE updateHashGeneric #-}
    updateHashGeneric :: forall p. V1 p -> LH ()
updateHashGeneric = V1 p -> LH ()
forall a. HasCallStack => a
undefined
    updateHashStableGeneric :: forall p. V1 p -> LH ()
updateHashStableGeneric = V1 p -> LH ()
forall a. HasCallStack => a
undefined

instance GenericLargeHashable U1 where
    {-# INLINE updateHashGeneric #-}
    updateHashGeneric :: forall p. U1 p -> LH ()
updateHashGeneric U1 p
U1 = () -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash ()
    updateHashStableGeneric :: forall p. U1 p -> LH ()
updateHashStableGeneric U1 p
U1 = () -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable ()

instance (GenericLargeHashable f, GenericLargeHashable g) => GenericLargeHashable (f :*: g) where
    {-# INLINE updateHashGeneric #-}
    updateHashGeneric :: forall p. (:*:) f g p -> LH ()
updateHashGeneric (f p
x :*: g p
y) = f p -> LH ()
forall p. f p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashGeneric f p
x LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> g p -> LH ()
forall p. g p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashGeneric g p
y
    updateHashStableGeneric :: forall p. (:*:) f g p -> LH ()
updateHashStableGeneric (f p
x :*: g p
y) = f p -> LH ()
forall p. f p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashStableGeneric f p
x LH () -> LH () -> LH ()
forall a b. LH a -> LH b -> LH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> g p -> LH ()
forall p. g p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashStableGeneric g p
y

instance (GenericLargeHashable f, GenericLargeHashableSum g) => GenericLargeHashable (f :+: g) where
    {-# INLINE updateHashGeneric #-}
    updateHashGeneric :: forall p. (:+:) f g p -> LH ()
updateHashGeneric (:+:) f g p
x = (:+:) f g p -> Int -> LH ()
forall p. (:+:) f g p -> Int -> LH ()
forall (f :: * -> *) p.
GenericLargeHashableSum f =>
f p -> Int -> LH ()
updateHashGenericSum (:+:) f g p
x Int
0
    updateHashStableGeneric :: forall p. (:+:) f g p -> LH ()
updateHashStableGeneric (:+:) f g p
x = (:+:) f g p -> Int -> LH ()
forall p. (:+:) f g p -> Int -> LH ()
forall (f :: * -> *) p.
GenericLargeHashableSum f =>
f p -> Int -> LH ()
updateHashStableGenericSum (:+:) f g p
x Int
0

instance LargeHashable c => GenericLargeHashable (K1 i c) where
    {-# INLINE updateHashGeneric #-}
    updateHashGeneric :: forall p. K1 i c p -> LH ()
updateHashGeneric K1 i c p
x = c -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash (K1 i c p -> c
forall k i c (p :: k). K1 i c p -> c
unK1 K1 i c p
x)
    updateHashStableGeneric :: forall p. K1 i c p -> LH ()
updateHashStableGeneric K1 i c p
x = c -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable (K1 i c p -> c
forall k i c (p :: k). K1 i c p -> c
unK1 K1 i c p
x)

-- ignore meta-info (for now)
instance (GenericLargeHashable f) => GenericLargeHashable (M1 i t f) where
    {-# INLINE updateHashGeneric #-}
    updateHashGeneric :: forall p. M1 i t f p -> LH ()
updateHashGeneric M1 i t f p
x = f p -> LH ()
forall p. f p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashGeneric (M1 i t f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i t f p
x)
    updateHashStableGeneric :: forall p. M1 i t f p -> LH ()
updateHashStableGeneric M1 i t f p
x = f p -> LH ()
forall p. f p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashStableGeneric (M1 i t f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i t f p
x)

class GenericLargeHashableSum (f :: Type -> Type) where
    updateHashGenericSum :: f p -> Int -> LH ()
    updateHashStableGenericSum :: f p -> Int -> LH ()

instance (GenericLargeHashable f, GenericLargeHashableSum g)
    => GenericLargeHashableSum (f :+: g) where
    {-# INLINE updateHashGenericSum #-}
    updateHashGenericSum :: forall p. (:+:) f g p -> Int -> LH ()
updateHashGenericSum (L1 f p
x) !Int
p = do
        Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
p
        f p -> LH ()
forall p. f p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashGeneric f p
x
    updateHashGenericSum (R1 g p
x) !Int
p = g p -> Int -> LH ()
forall p. g p -> Int -> LH ()
forall (f :: * -> *) p.
GenericLargeHashableSum f =>
f p -> Int -> LH ()
updateHashGenericSum g p
x (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    updateHashStableGenericSum :: forall p. (:+:) f g p -> Int -> LH ()
updateHashStableGenericSum (L1 f p
x) !Int
p = do
        Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable Int
p
        f p -> LH ()
forall p. f p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashStableGeneric f p
x
    updateHashStableGenericSum (R1 g p
x) !Int
p = g p -> Int -> LH ()
forall p. g p -> Int -> LH ()
forall (f :: * -> *) p.
GenericLargeHashableSum f =>
f p -> Int -> LH ()
updateHashStableGenericSum g p
x (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

instance (GenericLargeHashable f) => GenericLargeHashableSum (M1 i t f) where
    {-# INLINE updateHashGenericSum #-}
    updateHashGenericSum :: forall p. M1 i t f p -> Int -> LH ()
updateHashGenericSum M1 i t f p
x !Int
p = do
        Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHash Int
p
        f p -> LH ()
forall p. f p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashGeneric (M1 i t f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i t f p
x)
    updateHashStableGenericSum :: forall p. M1 i t f p -> Int -> LH ()
updateHashStableGenericSum M1 i t f p
x !Int
p = do
        Int -> LH ()
forall a. LargeHashable a => a -> LH ()
updateHashStable Int
p
        f p -> LH ()
forall p. f p -> LH ()
forall (f :: * -> *) p. GenericLargeHashable f => f p -> LH ()
updateHashStableGeneric (M1 i t f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i t f p
x)