    {-# LANGUAGE BangPatterns, FlexibleInstances, KindSignatures,
                 ScopedTypeVariables, TypeOperators,
                 MultiParamTypeClasses, GADTs, FlexibleContexts #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}
    {-# LANGUAGE Trustworthy #-}

    ------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Hashable.Generic.Instances
    -- Copyright   :  (c) Bryan O'Sullivan 2012
    -- SPDX-License-Identifier : BSD-3-Clause
    -- Maintainer  :  bos@serpentine.com
    -- Stability   :  provisional
    -- Portability :  GHC >= 7.4
    --
    -- Internal module defining orphan instances for "GHC.Generics"
    --
    module Data.Hashable.Generic.Instances () where

    import Data.Hashable.Class
    import GHC.Generics
    import Data.Kind (Type)

    -- Type without constructors
    instance GHashable arity V1 where
        ghashWithSalt :: forall a. HashArgs arity a -> Int -> V1 a -> Int
    ghashWithSalt HashArgs arity a
    _ Int
    salt V1 a
    _ = Int -> () -> Int
    forall a. Hashable a => Int -> a -> Int
    hashWithSalt Int
    salt ()

    -- Constructor without arguments
    instance GHashable arity U1 where
        ghashWithSalt :: forall a. HashArgs arity a -> Int -> U1 a -> Int
    ghashWithSalt HashArgs arity a
    _ Int
    salt U1 a
    U1 = Int -> () -> Int
    forall a. Hashable a => Int -> a -> Int
    hashWithSalt Int
    salt ()

    instance (GHashable arity a, GHashable arity b) => GHashable arity (a :*: b) where
        ghashWithSalt :: forall a. HashArgs arity a -> Int -> (:*:) a b a -> Int
    ghashWithSalt HashArgs arity a
    toHash Int
    salt (a a
    x :*: b a
    y) =
          (HashArgs arity a -> Int -> b a -> Int
    forall a. HashArgs arity a -> Int -> b a -> Int
    forall arity (f :: * -> *) a.
    GHashable arity f =>
    HashArgs arity a -> Int -> f a -> Int
    ghashWithSalt HashArgs arity a
    toHash (HashArgs arity a -> Int -> a a -> Int
    forall a. HashArgs arity a -> Int -> a a -> Int
    forall arity (f :: * -> *) a.
    GHashable arity f =>
    HashArgs arity a -> Int -> f a -> Int
    ghashWithSalt HashArgs arity a
    toHash Int
    salt a a
    x) b a
    y)

    -- Metadata (constructor name, etc)
    instance GHashable arity a => GHashable arity (M1 i c a) where
        ghashWithSalt :: forall a. HashArgs arity a -> Int -> M1 i c a a -> Int
    ghashWithSalt HashArgs arity a
    targs Int
    salt = HashArgs arity a -> Int -> a a -> Int
    forall a. HashArgs arity a -> Int -> a a -> Int
    forall arity (f :: * -> *) a.
    GHashable arity f =>
    HashArgs arity a -> Int -> f a -> Int
    ghashWithSalt HashArgs arity a
    targs Int
    salt (a a -> Int) -> (M1 i c a a -> a a) -> M1 i c a a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . M1 i c a a -> a a
    forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
    unM1

    -- Constants, additional parameters, and rank-1 recursion
    instance Hashable a => GHashable arity (K1 i a) where
        ghashWithSalt :: forall a. HashArgs arity a -> Int -> K1 i a a -> Int
    ghashWithSalt HashArgs arity a
    _ = (K1 i a a -> a) -> Int -> K1 i a a -> Int
    forall b a. Hashable b => (a -> b) -> Int -> a -> Int
    hashUsing K1 i a a -> a
    forall k i c (p :: k). K1 i c p -> c
    unK1

    instance GHashable One Par1 where
        ghashWithSalt :: forall a. HashArgs One a -> Int -> Par1 a -> Int
    ghashWithSalt (HashArgs1 Int -> a -> Int
    h) Int
    salt = Int -> a -> Int
    h Int
    salt (a -> Int) -> (Par1 a -> a) -> Par1 a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Par1 a -> a
    forall p. Par1 p -> p
    unPar1

    instance Hashable1 f => GHashable One (Rec1 f) where
        ghashWithSalt :: forall a. HashArgs One a -> Int -> Rec1 f a -> Int
    ghashWithSalt (HashArgs1 Int -> a -> Int
    h) Int
    salt = (Int -> a -> Int) -> Int -> f a -> Int
    forall a. (Int -> a -> Int) -> Int -> f a -> Int
    forall (t :: * -> *) a.
    Hashable1 t =>
    (Int -> a -> Int) -> Int -> t a -> Int
    liftHashWithSalt Int -> a -> Int
    h Int
    salt (f a -> Int) -> (Rec1 f a -> f a) -> Rec1 f a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rec1 f a -> f a
    forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
    unRec1

    instance (Hashable1 f, GHashable One g) => GHashable One (f :.: g) where
        ghashWithSalt :: forall a. HashArgs One a -> Int -> (:.:) f g a -> Int
    ghashWithSalt HashArgs One a
    targs Int
    salt = (Int -> g a -> Int) -> Int -> f (g a) -> Int
    forall a. (Int -> a -> Int) -> Int -> f a -> Int
    forall (t :: * -> *) a.
    Hashable1 t =>
    (Int -> a -> Int) -> Int -> t a -> Int
    liftHashWithSalt (HashArgs One a -> Int -> g a -> Int
    forall a. HashArgs One a -> Int -> g a -> Int
    forall arity (f :: * -> *) a.
    GHashable arity f =>
    HashArgs arity a -> Int -> f a -> Int
    ghashWithSalt HashArgs One a
    targs) Int
    salt (f (g a) -> Int) -> ((:.:) f g a -> f (g a)) -> (:.:) f g a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (:.:) f g a -> f (g a)
    forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
    (:.:) f g p -> f (g p)
    unComp1

    class SumSize f => GSum arity f where
        hashSum :: HashArgs arity a -> Int -> Int -> f a -> Int
        -- hashSum args salt index value = ...

    -- [Note: Hashing a sum type]
    --
    -- The tree structure is used in GHC.Generics to represent the sum (and
    -- product) part of the generic representation of the type, e.g.:
    --
    --   (C0 ... :+: C1 ...) :+: (C2 ... :+: (C3 ... :+: C4 ...))
    --
    -- The value constructed with C2 constructor is represented as (R1 (L1 ...)).
    -- Yet, if we think that this tree is a flat (heterogeneous) list:
    --
    --   [C0 ..., C1 ..., C2 ..., C3 ..., C4... ]
    --
    -- then the value constructed with C2 is a (dependent) pair (2, ...), and
    -- hashing it is simple:
    --
    --   salt `hashWithSalt` (2 :: Int) `hashWithSalt` ...
    --
    -- This is what we do below. When drilling down the tree, we count how many
    -- leafs are to the left (`index` variable). At the leaf case C1, we'll have an
    -- actual index into the sum.
    --
    -- This works well for balanced data. However for recursive types like:
    --
    --   data Nat = Z | S Nat
    --
    -- the `hashWithSalt salt (S (S (S Z)))` is
    --
    --   salt `hashWithSalt` (1 :: Int) -- first S
    --        `hashWithSalt` (1 :: Int) -- second S
    --        `hashWithSalt` (1 :: Int) -- third S
    --        `hashWithSalt` (0 :: Int) -- Z
    --        `hashWithSalt` ()         -- U1
    --
    -- For that type the manual implementation:
    --
    --    instance Hashable Nat where
    --        hashWithSalt salt n = hashWithSalt salt (natToInteger n)
    --
    -- would be better performing CPU and hash-quality wise (assuming that
    -- Integer's Hashable is of high quality).
    --
    instance (GSum arity a, GSum arity b) => GHashable arity (a :+: b) where
        ghashWithSalt :: forall a. HashArgs arity a -> Int -> (:+:) a b a -> Int
    ghashWithSalt HashArgs arity a
    toHash Int
    salt = HashArgs arity a -> Int -> Int -> (:+:) a b a -> Int
    forall a. HashArgs arity a -> Int -> Int -> (:+:) a b a -> Int
    forall arity (f :: * -> *) a.
    GSum arity f =>
    HashArgs arity a -> Int -> Int -> f a -> Int
    hashSum HashArgs arity a
    toHash Int
    salt Int
    0

    instance (GSum arity a, GSum arity b) => GSum arity (a :+: b) where
        hashSum :: forall a. HashArgs arity a -> Int -> Int -> (:+:) a b a -> Int
    hashSum HashArgs arity a
    toHash !Int
    salt !Int
    index (:+:) a b a
    s = case (:+:) a b a
    s of
            L1 a a
    x -> HashArgs arity a -> Int -> Int -> a a -> Int
    forall a. HashArgs arity a -> Int -> Int -> a a -> Int
    forall arity (f :: * -> *) a.
    GSum arity f =>
    HashArgs arity a -> Int -> Int -> f a -> Int
    hashSum HashArgs arity a
    toHash Int
    salt Int
    index a a
    x
            R1 b a
    x -> HashArgs arity a -> Int -> Int -> b a -> Int
    forall a. HashArgs arity a -> Int -> Int -> b a -> Int
    forall arity (f :: * -> *) a.
    GSum arity f =>
    HashArgs arity a -> Int -> Int -> f a -> Int
    hashSum HashArgs arity a
    toHash Int
    salt (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    sizeL) b a
    x
          where
            sizeL :: Int
    sizeL = Tagged a -> Int
    forall (s :: * -> *). Tagged s -> Int
    unTagged (Tagged a
    forall (f :: * -> *). SumSize f => Tagged f
    sumSize :: Tagged a)
        {-# INLINE hashSum #-}

    instance GHashable arity a => GSum arity (C1 c a) where
        hashSum :: forall a. HashArgs arity a -> Int -> Int -> C1 c a a -> Int
    hashSum HashArgs arity a
    toHash !Int
    salt !Int
    index (M1 a a
    x) = HashArgs arity a -> Int -> a a -> Int
    forall a. HashArgs arity a -> Int -> a a -> Int
    forall arity (f :: * -> *) a.
    GHashable arity f =>
    HashArgs arity a -> Int -> f a -> Int
    ghashWithSalt HashArgs arity a
    toHash (Int -> Int -> Int
    forall a. Hashable a => Int -> a -> Int
    hashWithSalt Int
    salt Int
    index) a a
    x
        {-# INLINE hashSum #-}

    class SumSize f where
        sumSize :: Tagged f

    newtype Tagged (s :: Type -> Type) = Tagged {forall (s :: * -> *). Tagged s -> Int
    unTagged :: Int}

    instance (SumSize a, SumSize b) => SumSize (a :+: b) where
        sumSize :: Tagged (a :+: b)
    sumSize = Int -> Tagged (a :+: b)
    forall (s :: * -> *). Int -> Tagged s
    Tagged (Int -> Tagged (a :+: b)) -> Int -> Tagged (a :+: b)
    forall a b. (a -> b) -> a -> b
    $ Tagged a -> Int
    forall (s :: * -> *). Tagged s -> Int
    unTagged (Tagged a
    forall (f :: * -> *). SumSize f => Tagged f
    sumSize :: Tagged a) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +
                           Tagged b -> Int
    forall (s :: * -> *). Tagged s -> Int
    unTagged (Tagged b
    forall (f :: * -> *). SumSize f => Tagged f
    sumSize :: Tagged b)

    instance SumSize (C1 c a) where
        sumSize :: Tagged (C1 c a)
    sumSize = Int -> Tagged (C1 c a)
    forall (s :: * -> *). Int -> Tagged s
    Tagged Int
    1