I try to use raiseUnder (with polysemy 1.6.0) to introduce effects to use other interpreters, such that:
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
module Memoization where
import Data.Kind
import qualified Data.Map.Strict as M
import Polysemy
import Polysemy.State
data Memoization (k :: Type) (v :: Type) (m :: Type -> Type) (a :: Type) where
FetchMemoized :: k -> Memoization k v m v
makeSem ''Memoization
runMemoizationState ::
forall k v r.
( Ord k,
Members
'[State (M.Map k v)]
r
) =>
(k -> Sem r v) ->
InterpreterFor (Memoization k v) r
runMemoizationState f = interpret $ \case
FetchMemoized k -> do
memoized <- get @(M.Map k v)
case memoized M.!? k of
Just memoizedResult -> return memoizedResult
Nothing -> do
result <- f k
modify' $ M.insert k result
return result
runMemoizationState' ::
forall k v r.
( Ord k
) =>
(k -> Sem r v) ->
InterpreterFor (Memoization k v) r
runMemoizationState' f =
evalState mempty
. runMemoizationState f
. raiseUnder @(State (M.Map k v)) @(Memoization k v) @r
While I expect it to simply inject a new effect:
raiseUnder :: forall e2 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': (e2 ': r)) a
I get this error:
Sem r a -> Sem (WithTactics e f (Sem rInitial) r) (f a)
Memoization.hs:46:7-55: error:
* Occurs check: cannot construct the infinite type:
r ~ State (M.Map k v) : r
Expected type: Sem (Memoization k v : r) a
-> Sem (Memoization k v : r) a
Actual type: Sem (Memoization k v : r) a
-> Sem (Memoization k v : State (M.Map k v) : r) a
* In the second argument of `(.)', namely
`raiseUnder @(State (M.Map k v)) @(Memoization k v) @r'
In the second argument of `(.)', namely
`runMemoizationState f
. raiseUnder @(State (M.Map k v)) @(Memoization k v) @r'
In the expression:
evalState mempty
. runMemoizationState f
. raiseUnder @(State (M.Map k v)) @(Memoization k v) @r
* Relevant bindings include
f :: k -> Sem r v
(bound at Memoization.hs:43:22)
runMemoizationState' :: (k -> Sem r v)
-> InterpreterFor (Memoization k v) r
(bound at Memoization.hs:43:1)
|
46 | . raiseUnder @(State (M.Map k v)) @(Memoization k v) @r
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
As mentioned by @Georgi Lyubenov, the issue was that my function f, in runMemoizationState, neededthe State effect, once decoupled, it works:
runMemoizationState ::
forall k v r.
Ord k =>
(k -> Sem r v) ->
InterpretersFor '[Memoization k v, State (M.Map k v)] r
runMemoizationState f =
evalState mempty
. run'
where
run' :: InterpreterFor (Memoization k v) (State (M.Map k v) ': r)
run' = interpret $ \case
FetchMemoized k -> do
memoized <- get @(M.Map k v)
case memoized M.!? k of
Just memoizedResult -> return memoizedResult
Nothing -> do
result <- raise $ f k
modify' $ M.insert k result
return result
runMemoizationState' ::
forall k v r.
( Ord k
) =>
(k -> Sem r v) ->
InterpreterFor (Memoization k v) r
runMemoizationState' f =
runMemoizationState f
. raiseUnder @(State (M.Map k v)) @(Memoization k v) @r