{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Strict.HashMap.Lens
  (
  ) where

import           Control.Lens
import           Data.Hashable (Hashable)

import qualified Data.Strict.HashMap as HM

import           Data.Strict.HashMap (HashMap)


#if !MIN_VERSION_lens(5,0,0)
instance FunctorWithIndex k (HashMap k) where
  imap = HM.mapWithKey
  {-# INLINE imap #-}

instance FoldableWithIndex k (HashMap k) where
  ifoldr  = HM.foldrWithKey
  {-# INLINE ifoldr #-}
  ifoldl' = HM.foldlWithKey' . flip
  {-# INLINE ifoldl' #-}

instance TraversableWithIndex k (HashMap k) where
  itraverse = HM.traverseWithKey
  {-# INLINE itraverse #-}
#endif

type instance Index (HashMap k v) = k
type instance IxValue (HashMap k v) = v

instance (Eq k, Hashable k) => Ixed (HashMap k a) where
  ix :: Index (HashMap k a)
-> Traversal' (HashMap k a) (IxValue (HashMap k a))
ix Index (HashMap k a)
k IxValue (HashMap k a) -> f (IxValue (HashMap k a))
f HashMap k a
m = case k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
Index (HashMap k a)
k HashMap k a
m of
     Just a
v  -> IxValue (HashMap k a) -> f (IxValue (HashMap k a))
f a
IxValue (HashMap k a)
v f a -> (a -> HashMap k a) -> f (HashMap k a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> k -> a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert k
Index (HashMap k a)
k a
v' HashMap k a
m
     Maybe a
Nothing -> HashMap k a -> f (HashMap k a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k a
m
  {-# INLINE ix #-}

instance (Eq k, Hashable k) => At (HashMap k v) where
  at :: Index (HashMap k v)
-> Lens' (HashMap k v) (Maybe (IxValue (HashMap k v)))
at Index (HashMap k v)
k Maybe (IxValue (HashMap k v)) -> f (Maybe (IxValue (HashMap k v)))
f = (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HM.alterF Maybe v -> f (Maybe v)
Maybe (IxValue (HashMap k v)) -> f (Maybe (IxValue (HashMap k v)))
f k
Index (HashMap k v)
k
  {-# INLINE at #-}

instance AsEmpty (HashMap k a) where
  _Empty :: p () (f ()) -> p (HashMap k a) (f (HashMap k a))
_Empty = HashMap k a -> (HashMap k a -> Bool) -> Prism' (HashMap k a) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly HashMap k a
forall k v. HashMap k v
HM.empty HashMap k a -> Bool
forall k v. HashMap k v -> Bool
HM.null
  {-# INLINE _Empty #-}

instance (c ~ d) => Each (HashMap c a) (HashMap d b) a b where
  each :: (a -> f b) -> HashMap c a -> f (HashMap d b)
each = (a -> f b) -> HashMap c a -> f (HashMap d b)
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
  {-# INLINE each #-}

instance (t ~ HashMap k' a', Hashable k, Eq k) => Rewrapped (HashMap k a) t
instance (Hashable k, Eq k) => Wrapped (HashMap k a) where
  type Unwrapped (HashMap k a) = [(k, a)]
  _Wrapped' :: p (Unwrapped (HashMap k a)) (f (Unwrapped (HashMap k a)))
-> p (HashMap k a) (f (HashMap k a))
_Wrapped' = (HashMap k a -> [(k, a)])
-> ([(k, a)] -> HashMap k a)
-> Iso (HashMap k a) (HashMap k a) [(k, a)] [(k, a)]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso HashMap k a -> [(k, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
  {-# INLINE _Wrapped' #-}