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

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

import Data.Map.Lazy                  as L
import Data.Strict.Map.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 (Eq k, Ord k) => Strict (L.Map k v) (S.Map k v) where
  toStrict :: Map k v -> Map k v
toStrict = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
S.fromList ([(k, v)] -> Map k v)
-> (Map k v -> [(k, v)]) -> Map k v -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
L.toList
  toLazy :: Map k v -> Map k v
toLazy = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
L.fromList ([(k, v)] -> Map k v)
-> (Map k v -> [(k, v)]) -> Map k v -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
S.toList
  {-# INLINE toStrict #-}
  {-# INLINE toLazy #-}

-- code copied from indexed-traversable

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

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

instance TraversableWithIndex k (S.Map k) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(k -> a -> f b) -> Map k a -> f (Map k b)
itraverse = (k -> a -> f b) -> Map k a -> f (Map k b)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
S.traverseWithKey
  {-# INLINE itraverse #-}

-- code copied from binary

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