{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Binary.Instances.UnorderedContainers where

import Data.Binary         (Binary, get, put)
import Data.Binary.Orphans ()

import qualified Data.Hashable     as Hashable
import qualified Data.HashMap.Lazy as HM
import qualified Data.HashSet      as HS

instance  (Hashable.Hashable k, Eq k, Binary k, Binary v) => Binary (HM.HashMap k v) where
    get :: Get (HashMap k v)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall t. Binary t => Get t
get
    put :: HashMap k v -> Put
put = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HM.toList

instance (Hashable.Hashable v, Eq v, Binary v) => Binary (HS.HashSet v) where
    get :: Get (HashSet v)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall t. Binary t => Get t
get
    put :: HashSet v -> Put
put = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> [a]
HS.toList