{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Effect.Map
-- Copyright   :  (c) Michael Szvetits, 2020
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  typedbyte@qualified.name
-- Stability   :  stable
-- Portability :  portable
--
-- The map effect for modeling a mutable collection of key-value pairs.
--
-- Lazy and strict interpretations of the effect are available here:
-- "Control.Effect.Map.Lazy" and "Control.Effect.Map.Strict".
-----------------------------------------------------------------------------
module Control.Effect.Map
  ( -- * Tagged Map Effect
    Map'(..)
    -- * Untagged Map Effect
    -- | If you don't require disambiguation of multiple map effects
    -- (i.e., you only have one map effect in your monadic context),
    -- it is recommended to always use the untagged map effect.
  , Map
  , clear
  , lookup
  , update
    -- * Convenience Functions
    -- | If you don't require disambiguation of multiple map effects
    -- (i.e., you only have one map effect in your monadic context),
    -- it is recommended to always use the untagged functions.
  , delete'
  , delete
  , exists'
  , exists
  , insert'
  , insert
  , modify'
  , modify
    -- * Tagging and Untagging
    -- | Conversion functions between the tagged and untagged map effect,
    -- usually used in combination with type applications, like:
    --
    -- @
    --     'tagMap'' \@\"newTag\" program
    --     'retagMap'' \@\"oldTag\" \@\"newTag\" program
    --     'untagMap'' \@\"erasedTag\" program
    -- @
    -- 
  , tagMap'
  , retagMap'
  , untagMap'
  ) where

-- base
import Data.Maybe     (isJust)
import Prelude hiding (lookup)

import Control.Effect.Machinery

-- | An effect that adds a mutable collection of key-value pairs to a given computation.
class Monad m => Map' tag k v m | tag m -> k v where
  -- | Deletes all key-value pairs from the map.
  clear' :: m ()
  -- | Searches for a value that corresponds to a given key.
  -- Returns 'Nothing' if the key cannot be found.
  lookup' :: k -> m (Maybe v)
  -- | Updates the value that corresponds to a given key.
  -- Passing 'Nothing' as the updated value removes the key-value pair from the map.
  update' :: k -> Maybe v -> m ()

makeTaggedEffect ''Map'

-- | Deletes a key and its corresponding value from the map.
delete' :: forall tag k v m. Map' tag k v m => k -> m ()
delete' :: k -> m ()
delete' k :: k
k = k -> Maybe v -> m ()
forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
k -> Maybe v -> m ()
update' @tag k
k Maybe v
forall a. Maybe a
Nothing
{-# INLINE delete' #-}

-- | The untagged version of 'delete''.
delete :: Map k v m => k -> m ()
delete :: k -> m ()
delete = forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
k -> m ()
forall k v (m :: SomeMonad). Map' G k v m => k -> m ()
delete' @G
{-# INLINE delete #-}

-- | Checks if the map contains a given key.
exists' :: forall tag k v m. Map' tag k v m => k -> m Bool
exists' :: k -> m Bool
exists' = (Maybe v -> Bool) -> m (Maybe v) -> m Bool
forall (f :: SomeMonad) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe v -> Bool
forall a. Maybe a -> Bool
isJust (m (Maybe v) -> m Bool) -> (k -> m (Maybe v)) -> k -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
k -> m (Maybe v)
forall k v (m :: SomeMonad). Map' tag k v m => k -> m (Maybe v)
lookup' @tag
{-# INLINE exists' #-}

-- | The untagged version of 'exists''.
exists :: Map k v m => k -> m Bool
exists :: k -> m Bool
exists = forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
k -> m Bool
forall k v (m :: SomeMonad). Map' G k v m => k -> m Bool
exists' @G
{-# INLINE exists #-}

-- | Inserts a new key-value pair into the map. If the key is already present
-- in the map, the associated value is replaced with the new value.
insert' :: forall tag k v m. Map' tag k v m => k -> v -> m ()
insert' :: k -> v -> m ()
insert' k :: k
k = k -> Maybe v -> m ()
forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
k -> Maybe v -> m ()
update' @tag k
k (Maybe v -> m ()) -> (v -> Maybe v) -> v -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Maybe v
forall a. a -> Maybe a
Just
{-# INLINE insert' #-}

-- | The untagged version of 'insert''.
insert :: Map k v m => k -> v -> m ()
insert :: k -> v -> m ()
insert = forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
k -> v -> m ()
forall k v (m :: SomeMonad). Map' G k v m => k -> v -> m ()
insert' @G
{-# INLINE insert #-}

-- | Updates the value that corresponds to a given key.
-- If the key cannot be found, a corresponding default value is assumed.
modify' :: forall tag k v m. Map' tag k v m
        => v        -- ^ The default value that is assumed if the key is missing.
        -> (v -> v) -- ^ The function for updating the value. This function is
                    -- also applied to the default value if the key is missing.
        -> k        -- ^ The key whose corresponding value is updated.
        -> m ()     -- ^ The operation produces no value.
modify' :: v -> (v -> v) -> k -> m ()
modify' fallback :: v
fallback f :: v -> v
f k :: k
k = do
  Maybe v
maybeVal <- k -> m (Maybe v)
forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
k -> m (Maybe v)
lookup' @tag k
k
  case Maybe v
maybeVal of
    Just v :: v
v  -> k -> v -> m ()
forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
k -> v -> m ()
insert' @tag k
k (v -> v
f v
v)
    Nothing -> k -> v -> m ()
forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
k -> v -> m ()
insert' @tag k
k (v -> v
f v
fallback)
{-# INLINE modify' #-}

-- | The untagged version of 'modify''.
modify :: Map k v m => v -> (v -> v) -> k -> m ()
modify :: v -> (v -> v) -> k -> m ()
modify = forall k (tag :: k) k v (m :: SomeMonad).
Map' tag k v m =>
v -> (v -> v) -> k -> m ()
forall k v (m :: SomeMonad).
Map' G k v m =>
v -> (v -> v) -> k -> m ()
modify' @G
{-# INLINE modify #-}