{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Composite.Record.Hashable where

import Composite.Record((:->), Record, Rec(RNil, (:&)), getVal)
import Data.Hashable(Hashable(hashWithSalt))

instance Hashable a => Hashable (s :-> a) where
  hashWithSalt :: Int -> (s :-> a) -> Int
hashWithSalt Int
n s :-> a
x = Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ (s :-> a) -> a
forall (s :: Symbol) a. (s :-> a) -> a
getVal s :-> a
x

instance Hashable (Record '[]) where
  hashWithSalt :: Int -> Record '[] -> Int
hashWithSalt Int
n Record '[]
RNil = Int
n Int -> () -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ()

instance (Hashable x, Hashable (Record xs)) => Hashable (Record (x : xs)) where
  hashWithSalt :: Int -> Record (x : xs) -> Int
hashWithSalt Int
n (Identity r
x :& Rec Identity rs
xs) = Int
n Int -> Identity r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Identity r
x Int -> Rec Identity rs -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Rec Identity rs
xs