{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Strict.IntMap.Internal where

import Data.IntMap.Lazy                  as L
import Data.Strict.IntMap.Autogen.Strict as S

import Control.Monad
import Data.Binary
import Data.Foldable.WithIndex
import Data.Functor.WithIndex
import Data.Traversable.WithIndex
import Data.Semigroup (Semigroup (..)) -- helps with compatibility
import Data.Strict.Classes

instance Strict (L.IntMap e) (S.IntMap e) where
  toStrict :: IntMap e -> IntMap e
toStrict = [(Key, e)] -> IntMap e
forall a. [(Key, a)] -> IntMap a
S.fromList ([(Key, e)] -> IntMap e)
-> (IntMap e -> [(Key, e)]) -> IntMap e -> IntMap e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap e -> [(Key, e)]
forall a. IntMap a -> [(Key, a)]
L.toList
  toLazy :: IntMap e -> IntMap e
toLazy = [(Key, e)] -> IntMap e
forall a. [(Key, a)] -> IntMap a
L.fromList ([(Key, e)] -> IntMap e)
-> (IntMap e -> [(Key, e)]) -> IntMap e -> IntMap e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap e -> [(Key, e)]
forall a. IntMap a -> [(Key, a)]
S.toList
  {-# INLINE toStrict #-}
  {-# INLINE toLazy #-}

-- code copied from indexed-traversable

instance FunctorWithIndex Int S.IntMap where
  imap :: forall a b. (Key -> a -> b) -> IntMap a -> IntMap b
imap = (Key -> a -> b) -> IntMap a -> IntMap b
forall a b. (Key -> a -> b) -> IntMap a -> IntMap b
S.mapWithKey
  {-# INLINE imap #-}

instance FoldableWithIndex Int S.IntMap where
  ifoldMap :: forall m a. Monoid m => (Key -> a -> m) -> IntMap a -> m
ifoldMap = (Key -> a -> m) -> IntMap a -> m
forall m a. Monoid m => (Key -> a -> m) -> IntMap a -> m
S.foldMapWithKey
  {-# INLINE ifoldMap #-}
  ifoldr :: forall a b. (Key -> a -> b -> b) -> b -> IntMap a -> b
ifoldr   = (Key -> a -> b -> b) -> b -> IntMap a -> b
forall a b. (Key -> a -> b -> b) -> b -> IntMap a -> b
S.foldrWithKey
  {-# INLINE ifoldr #-}
  ifoldl' :: forall b a. (Key -> b -> a -> b) -> b -> IntMap a -> b
ifoldl'  = (b -> Key -> a -> b) -> b -> IntMap a -> b
forall a b. (a -> Key -> b -> a) -> a -> IntMap b -> a
S.foldlWithKey' ((b -> Key -> a -> b) -> b -> IntMap a -> b)
-> ((Key -> b -> a -> b) -> b -> Key -> a -> b)
-> (Key -> b -> a -> b)
-> b
-> IntMap a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> b -> a -> b) -> b -> Key -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
  {-# INLINE ifoldl' #-}

instance TraversableWithIndex Int S.IntMap where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Key -> a -> f b) -> IntMap a -> f (IntMap b)
itraverse = (Key -> a -> f b) -> IntMap a -> f (IntMap b)
forall (f :: * -> *) a b.
Applicative f =>
(Key -> a -> f b) -> IntMap a -> f (IntMap b)
S.traverseWithKey
  {-# INLINE itraverse #-}

-- code copied from binary

instance (Binary e) => Binary (S.IntMap e) where
    put :: IntMap e -> Put
put IntMap e
m = Key -> Put
forall t. Binary t => t -> Put
put (IntMap e -> Key
forall a. IntMap a -> Key
S.size IntMap e
m) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> ((Key, e) -> Put) -> [(Key, e)] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Key, e) -> Put
forall t. Binary t => t -> Put
put (IntMap e -> [(Key, e)]
forall a. IntMap a -> [(Key, a)]
S.toAscList IntMap e
m)
    get :: Get (IntMap e)
get   = ([(Key, e)] -> IntMap e) -> Get [(Key, e)] -> Get (IntMap e)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(Key, e)] -> IntMap e
forall a. [(Key, a)] -> IntMap a
S.fromDistinctAscList Get [(Key, e)]
forall t. Binary t => Get t
get