-----------------------------------------------------------
-- |
-- Module      : Control.Imperative.Hash.Class
-- Copyright   : (C) 2015, Yu Fukuzawa
-- License     : BSD3
-- Maintainer  : minpou.primer@email.com
-- Stability   : experimental
-- Portability : portable
--
-----------------------------------------------------------

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}

module Control.Imperative.Hash.Class
( -- * Class
  MHash(..)
, HashKey
) where
import           Control.Applicative
import           Control.Monad.ST
import           Data.Hashable
import qualified Data.HashTable.Class     as HC
import qualified Data.HashTable.IO        as HIO
import qualified Data.HashTable.ST.Basic as HST
import           Data.Maybe

class (Eq k, Hashable k) => HashKey k
instance (Eq k, Hashable k) => HashKey k

-- | Base class for mutable hashtables.
class Monad m => MHash m where
  type HashEntity m :: * -> * -> *
  newSizedHash :: Int -> m (HashEntity m k v)
  unsafeLookupHash :: HashKey k => HashEntity m k v -> k -> m v
  lookupHash :: HashKey k => HashEntity m k v -> k -> m (Maybe v)
  insertHash :: HashKey k => HashEntity m k v -> k -> v -> m ()
  deleteHash :: HashKey k => HashEntity m k v -> k -> m ()
  fromListHash :: HashKey k => [(k, v)] -> m (HashEntity m k v)
  toListHash :: HashKey k => HashEntity m k v -> m [(k, v)]

instance MHash IO where
  type HashEntity IO = HST.HashTable RealWorld
  newSizedHash = HIO.newSized
  {-# INLINE newSizedHash #-}
  unsafeLookupHash h k = fromJust <$> HIO.lookup h k
  {-# INLINE unsafeLookupHash #-}
  lookupHash = HIO.lookup
  {-# INLINE lookupHash #-}
  insertHash = HIO.insert
  {-# INLINE insertHash #-}
  deleteHash = HIO.delete
  {-# INLINE deleteHash #-}
  fromListHash = HIO.fromList
  {-# INLINE fromListHash #-}
  toListHash = HIO.toList
  {-# INLINE toListHash #-}

instance MHash (ST s) where
  type HashEntity (ST s) = HST.HashTable s
  newSizedHash = HST.newSized
  {-# INLINE newSizedHash #-}
  unsafeLookupHash h k = fromJust <$> HST.lookup h k
  {-# INLINE unsafeLookupHash #-}
  lookupHash = HST.lookup
  {-# INLINE lookupHash #-}
  insertHash = HST.insert
  {-# INLINE insertHash #-}
  deleteHash = HST.delete
  {-# INLINE deleteHash #-}
  fromListHash = HC.fromList
  {-# INLINE fromListHash #-}
  toListHash = HC.toList
  {-# INLINE toListHash #-}