{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Binary.Instances.Hashable where

import Data.Binary.Orphans ()

#if MIN_VERSION_hashable(1,2,5)
import           Data.Binary   (Binary, get, put)
import qualified Data.Hashable as Hashable

instance (Hashable.Hashable a, Binary a) => Binary (Hashable.Hashed a) where
    get :: Get (Hashed a)
get = (a -> Hashed a) -> Get a -> Get (Hashed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Hashed a
forall a. Hashable a => a -> Hashed a
Hashable.hashed Get a
forall t. Binary t => Get t
get
    put :: Hashed a -> Put
put = a -> Put
forall t. Binary t => t -> Put
put (a -> Put) -> (Hashed a -> a) -> Hashed a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hashed a -> a
forall a. Hashed a -> a
Hashable.unhashed
#endif