{-# LANGUAGE
    DeriveGeneric
  #-}

module Data.HSet.Types where

import GHC.Fingerprint (Fingerprint(..))
import GHC.Generics
import Data.Hashable



data HKey' = HKey'
  { HKey' -> Fingerprint
getTypeIndex :: {-# UNPACK #-} !Fingerprint
  , HKey' -> Int
getTypeCount :: {-# UNPACK #-} !Int
  } deriving (HKey' -> HKey' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HKey' -> HKey' -> Bool
$c/= :: HKey' -> HKey' -> Bool
== :: HKey' -> HKey' -> Bool
$c== :: HKey' -> HKey' -> Bool
Eq, forall x. Rep HKey' x -> HKey'
forall x. HKey' -> Rep HKey' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HKey' x -> HKey'
$cfrom :: forall x. HKey' -> Rep HKey' x
Generic)

instance Hashable HKey'

newtype HKey a = HKey
  { forall a. HKey a -> HKey'
getHKey :: HKey'
  } deriving (HKey a -> HKey a -> Bool
forall a. HKey a -> HKey a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HKey a -> HKey a -> Bool
$c/= :: forall a. HKey a -> HKey a -> Bool
== :: HKey a -> HKey a -> Bool
$c== :: forall a. HKey a -> HKey a -> Bool
Eq)