{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module      : Streamly.Internal.Data.IsMap.HashMap
-- Copyright   : (c) 2022 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Adds an orphan HashMap instance for the IsMap type class from streamly-core
-- package. This is useful for various combinators that use a map type. We
-- cannot define this in streamly-core as it adds several non-boot library
-- dependencies on streamly-core.

module Streamly.Internal.Data.IsMap.HashMap () where

import Data.Hashable (Hashable)
import Streamly.Internal.Data.IsMap (IsMap(..))

import qualified Data.HashMap.Strict as HashMap

instance (Hashable k, Eq k) => IsMap (HashMap.HashMap k) where
    type Key (HashMap.HashMap k) = k

    mapEmpty :: forall a. HashMap k a
mapEmpty = forall k v. HashMap k v
HashMap.empty
    mapAlterF :: forall (g :: * -> *) a.
Functor g =>
(Maybe a -> g (Maybe a))
-> Key (HashMap k) -> HashMap k a -> g (HashMap k a)
mapAlterF = forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF
    mapLookup :: forall a. Key (HashMap k) -> HashMap k a -> Maybe a
mapLookup = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup
    mapInsert :: forall a. Key (HashMap k) -> a -> HashMap k a -> HashMap k a
mapInsert = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert
    mapDelete :: forall a. Key (HashMap k) -> HashMap k a -> HashMap k a
mapDelete = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete
    mapUnion :: forall a. HashMap k a -> HashMap k a -> HashMap k a
mapUnion = forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union
    mapNull :: forall a. HashMap k a -> Bool
mapNull = forall k v. HashMap k v -> Bool
HashMap.null