-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Effect.Map.Strict
-- Copyright   :  (c) Michael Szvetits, 2020
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  typedbyte@qualified.name
-- Stability   :  stable
-- Portability :  portable
--
-- Strict interpretations of the 'Map'' effect.
--
-- If you don't require disambiguation of multiple map effects
-- (i.e., you only have one map effect in your monadic context),
-- you usually need the untagged interpretations.
-----------------------------------------------------------------------------
module Control.Effect.Map.Strict
  ( -- * Interpreter Type
    StrictMap
    -- * Tagged Interpretations
  , runMap'
    -- * Untagged Interpretations
  , runMap
  ) where

-- containers
import qualified Data.Map.Strict as M

-- transformers
import qualified Control.Monad.Trans.State.Strict as S

import Control.Effect.Machinery
import Control.Effect.Map (Map, Map', clear', lookup', update')

-- | The strict interpreter of the map effect. This type implements the
-- 'Map'' type class in a strict manner.
--
-- When interpreting the effect, you usually don\'t interact with this type directly,
-- but instead use one of its corresponding interpretation functions.
newtype StrictMap k v m a =
  StrictMap { StrictMap k v m a -> StateT (Map k v) m a
runStrictMap :: S.StateT (M.Map k v) m a }
    deriving (Functor (StrictMap k v m)
a -> StrictMap k v m a
Functor (StrictMap k v m) =>
(forall a. a -> StrictMap k v m a)
-> (forall a b.
    StrictMap k v m (a -> b) -> StrictMap k v m a -> StrictMap k v m b)
-> (forall a b c.
    (a -> b -> c)
    -> StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m c)
-> (forall a b.
    StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b)
-> (forall a b.
    StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m a)
-> Applicative (StrictMap k v m)
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m a
StrictMap k v m (a -> b) -> StrictMap k v m a -> StrictMap k v m b
(a -> b -> c)
-> StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m c
forall a. a -> StrictMap k v m a
forall a b.
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m a
forall a b.
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
forall a b.
StrictMap k v m (a -> b) -> StrictMap k v m a -> StrictMap k v m b
forall a b c.
(a -> b -> c)
-> StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m c
forall k v (m :: * -> *). Monad m => Functor (StrictMap k v m)
forall k v (m :: * -> *) a. Monad m => a -> StrictMap k v m a
forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m a
forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m (a -> b) -> StrictMap k v m a -> StrictMap k v m b
forall k v (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m a
$c<* :: forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m a
*> :: StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
$c*> :: forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
liftA2 :: (a -> b -> c)
-> StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m c
$cliftA2 :: forall k v (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m c
<*> :: StrictMap k v m (a -> b) -> StrictMap k v m a -> StrictMap k v m b
$c<*> :: forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m (a -> b) -> StrictMap k v m a -> StrictMap k v m b
pure :: a -> StrictMap k v m a
$cpure :: forall k v (m :: * -> *) a. Monad m => a -> StrictMap k v m a
$cp1Applicative :: forall k v (m :: * -> *). Monad m => Functor (StrictMap k v m)
Applicative, a -> StrictMap k v m b -> StrictMap k v m a
(a -> b) -> StrictMap k v m a -> StrictMap k v m b
(forall a b. (a -> b) -> StrictMap k v m a -> StrictMap k v m b)
-> (forall a b. a -> StrictMap k v m b -> StrictMap k v m a)
-> Functor (StrictMap k v m)
forall a b. a -> StrictMap k v m b -> StrictMap k v m a
forall a b. (a -> b) -> StrictMap k v m a -> StrictMap k v m b
forall k v (m :: * -> *) a b.
Functor m =>
a -> StrictMap k v m b -> StrictMap k v m a
forall k v (m :: * -> *) a b.
Functor m =>
(a -> b) -> StrictMap k v m a -> StrictMap k v m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StrictMap k v m b -> StrictMap k v m a
$c<$ :: forall k v (m :: * -> *) a b.
Functor m =>
a -> StrictMap k v m b -> StrictMap k v m a
fmap :: (a -> b) -> StrictMap k v m a -> StrictMap k v m b
$cfmap :: forall k v (m :: * -> *) a b.
Functor m =>
(a -> b) -> StrictMap k v m a -> StrictMap k v m b
Functor, Applicative (StrictMap k v m)
a -> StrictMap k v m a
Applicative (StrictMap k v m) =>
(forall a b.
 StrictMap k v m a -> (a -> StrictMap k v m b) -> StrictMap k v m b)
-> (forall a b.
    StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b)
-> (forall a. a -> StrictMap k v m a)
-> Monad (StrictMap k v m)
StrictMap k v m a -> (a -> StrictMap k v m b) -> StrictMap k v m b
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
forall a. a -> StrictMap k v m a
forall a b.
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
forall a b.
StrictMap k v m a -> (a -> StrictMap k v m b) -> StrictMap k v m b
forall k v (m :: * -> *). Monad m => Applicative (StrictMap k v m)
forall k v (m :: * -> *) a. Monad m => a -> StrictMap k v m a
forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m a -> (a -> StrictMap k v m b) -> StrictMap k v m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> StrictMap k v m a
$creturn :: forall k v (m :: * -> *) a. Monad m => a -> StrictMap k v m a
>> :: StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
$c>> :: forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m a -> StrictMap k v m b -> StrictMap k v m b
>>= :: StrictMap k v m a -> (a -> StrictMap k v m b) -> StrictMap k v m b
$c>>= :: forall k v (m :: * -> *) a b.
Monad m =>
StrictMap k v m a -> (a -> StrictMap k v m b) -> StrictMap k v m b
$cp1Monad :: forall k v (m :: * -> *). Monad m => Applicative (StrictMap k v m)
Monad, Monad (StrictMap k v m)
Monad (StrictMap k v m) =>
(forall a. IO a -> StrictMap k v m a) -> MonadIO (StrictMap k v m)
IO a -> StrictMap k v m a
forall a. IO a -> StrictMap k v m a
forall k v (m :: * -> *). MonadIO m => Monad (StrictMap k v m)
forall k v (m :: * -> *) a. MonadIO m => IO a -> StrictMap k v m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> StrictMap k v m a
$cliftIO :: forall k v (m :: * -> *) a. MonadIO m => IO a -> StrictMap k v m a
$cp1MonadIO :: forall k v (m :: * -> *). MonadIO m => Monad (StrictMap k v m)
MonadIO)
    deriving (m a -> StrictMap k v m a
(forall (m :: * -> *) a. Monad m => m a -> StrictMap k v m a)
-> MonadTrans (StrictMap k v)
forall k v (m :: * -> *) a. Monad m => m a -> StrictMap k v m a
forall (m :: * -> *) a. Monad m => m a -> StrictMap k v m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> StrictMap k v m a
$clift :: forall k v (m :: * -> *) a. Monad m => m a -> StrictMap k v m a
MonadTrans, MonadTrans (StrictMap k v)
m (StT (StrictMap k v) a) -> StrictMap k v m a
MonadTrans (StrictMap k v) =>
(forall (m :: * -> *) a.
 Monad m =>
 (Run (StrictMap k v) -> m a) -> StrictMap k v m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT (StrictMap k v) a) -> StrictMap k v m a)
-> MonadTransControl (StrictMap k v)
(Run (StrictMap k v) -> m a) -> StrictMap k v m a
forall k v. MonadTrans (StrictMap k v)
forall k v (m :: * -> *) a.
Monad m =>
m (StT (StrictMap k v) a) -> StrictMap k v m a
forall k v (m :: * -> *) a.
Monad m =>
(Run (StrictMap k v) -> m a) -> StrictMap k v m a
forall (m :: * -> *) a.
Monad m =>
m (StT (StrictMap k v) a) -> StrictMap k v m a
forall (m :: * -> *) a.
Monad m =>
(Run (StrictMap k v) -> m a) -> StrictMap k v m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
(forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT (StrictMap k v) a) -> StrictMap k v m a
$crestoreT :: forall k v (m :: * -> *) a.
Monad m =>
m (StT (StrictMap k v) a) -> StrictMap k v m a
liftWith :: (Run (StrictMap k v) -> m a) -> StrictMap k v m a
$cliftWith :: forall k v (m :: * -> *) a.
Monad m =>
(Run (StrictMap k v) -> m a) -> StrictMap k v m a
$cp1MonadTransControl :: forall k v. MonadTrans (StrictMap k v)
MonadTransControl)
    deriving (MonadBase b, MonadBaseControl b)

instance (Monad m, Ord k) => Map' tag k v (StrictMap k v m) where
  clear' :: StrictMap k v m ()
clear' = StateT (Map k v) m () -> StrictMap k v m ()
forall k v (m :: * -> *) a.
StateT (Map k v) m a -> StrictMap k v m a
StrictMap (StateT (Map k v) m () -> StrictMap k v m ())
-> StateT (Map k v) m () -> StrictMap k v m ()
forall a b. (a -> b) -> a -> b
$ Map k v -> StateT (Map k v) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
S.put Map k v
forall k a. Map k a
M.empty
  {-# INLINE clear' #-}
  lookup' :: k -> StrictMap k v m (Maybe v)
lookup' = StateT (Map k v) m (Maybe v) -> StrictMap k v m (Maybe v)
forall k v (m :: * -> *) a.
StateT (Map k v) m a -> StrictMap k v m a
StrictMap (StateT (Map k v) m (Maybe v) -> StrictMap k v m (Maybe v))
-> (k -> StateT (Map k v) m (Maybe v))
-> k
-> StrictMap k v m (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map k v -> Maybe v) -> StateT (Map k v) m (Maybe v)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
S.gets ((Map k v -> Maybe v) -> StateT (Map k v) m (Maybe v))
-> (k -> Map k v -> Maybe v) -> k -> StateT (Map k v) m (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
  {-# INLINE lookup' #-}
  update' :: k -> Maybe v -> StrictMap k v m ()
update' k :: k
k mv :: Maybe v
mv = StateT (Map k v) m () -> StrictMap k v m ()
forall k v (m :: * -> *) a.
StateT (Map k v) m a -> StrictMap k v m a
StrictMap (StateT (Map k v) m () -> StrictMap k v m ())
-> StateT (Map k v) m () -> StrictMap k v m ()
forall a b. (a -> b) -> a -> b
$ (Map k v -> Map k v) -> StateT (Map k v) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
S.modify ((Maybe v -> Maybe v) -> k -> Map k v -> Map k v
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Maybe v -> Maybe v -> Maybe v
forall a b. a -> b -> a
const Maybe v
mv) k
k)
  {-# INLINE update' #-}

-- | Runs the map effect, initialized with an empty map.
runMap' :: forall tag k v m a. Monad m
        => (Map' tag k v `Via` StrictMap k v) m a -- ^ The program whose map effect should be handled.
        -> m a                                  -- ^ The program with its map effect handled.
runMap' :: Via (Map' tag k v) (StrictMap k v) m a -> m a
runMap' = (StateT (Map k v) m a -> Map k v -> m a)
-> Map k v -> StateT (Map k v) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Map k v) m a -> Map k v -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
S.evalStateT Map k v
forall k a. Map k a
M.empty (StateT (Map k v) m a -> m a)
-> (Via (Map' tag k v) (StrictMap k v) m a -> StateT (Map k v) m a)
-> Via (Map' tag k v) (StrictMap k v) m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMap k v m a -> StateT (Map k v) m a
forall k v (m :: * -> *) a.
StrictMap k v m a -> StateT (Map k v) m a
runStrictMap (StrictMap k v m a -> StateT (Map k v) m a)
-> (Via (Map' tag k v) (StrictMap k v) m a -> StrictMap k v m a)
-> Via (Map' tag k v) (StrictMap k v) m a
-> StateT (Map k v) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Via (Map' tag k v) (StrictMap k v) m a -> StrictMap k v m a
forall (effs :: [Effect]) (t :: (* -> *) -> * -> *) (m :: * -> *)
       a.
EachVia effs t m a -> t m a
runVia
{-# INLINE runMap' #-}

-- | The untagged version of 'runMap''.
runMap :: Monad m => (Map k v `Via` StrictMap k v) m a -> m a
runMap :: Via (Map k v) (StrictMap k v) m a -> m a
runMap = forall k (tag :: k) k v (m :: * -> *) a.
Monad m =>
Via (Map' tag k v) (StrictMap k v) m a -> m a
forall k v (m :: * -> *) a.
Monad m =>
Via (Map' G k v) (StrictMap k v) m a -> m a
runMap' @G
{-# INLINE runMap #-}