如何将MTL风格、CPS风格的高阶效应融入多义词?

How to incorporate MTL-style, CPS-style higher-order effect into polysemy?

我正在转换代码库以使用 polysemy, and have run into trouble converting my uses of the LFresh typeclass from unbound-generics。我需要的两个操作有签名

avoid :: LFresh m => [AnyName] -> m a -> m a
lunbind :: (LFresh m, Alpha p, Alpha t) => Bind p t -> ((p, t) -> m c) -> m c

这显然是高阶的。我想通过 unbound-generics 提供的 LFreshM monad 创建一个对应于 LFresh class 和 运行 的效果。到目前为止,这是我尝试过的方法,使用 Final 因为这似乎让我比 Embed 更像父亲(而且我觉得 LFreshM 始终是效果堆栈中的最后一件事):

import           Polysemy
import           Polysemy.Final
import qualified Unbound.Generics.LocallyNameless as U

data LFresh m a where
  Avoid   :: [U.AnyName] -> m a -> LFresh m a
  LUnbind :: (U.Alpha p, U.Alpha t) => U.Bind p t -> ((p,t) -> m c) -> LFresh m c

makeSem ''LFresh

runLFresh :: Member (Final U.LFreshM) r => Sem (LFresh ': r) a -> Sem r a
runLFresh = interpretFinal @U.LFreshM $ \case
  Avoid xs m  -> do
    m' <- runS m
    pure (U.avoid xs m')
  LUnbind b k -> do
    k' <- bindS k
    pure (U.lunbind b k')

然而,LUnbind 的情况自 k' :: f (p, t) -> U.LFreshM (f x) 以来没有进行类型检查,但它期望 (p, t) -> U.LFreshM (f x) 类型的内容作为 U.lunbind 的第二个参数;注意 k'.

类型中的额外 f

我还有其他模糊的想法,但我暂时将其保留在那里,很乐意进一步澄清。甚至不确定我是否在正确的轨道上。最终,我的真正目标只是“让 unbound-generics 中的 LFresh 使用多义词”,所以如果有更好的、完全不同的方法来实现,我也很高兴听到它。

阅读了 https://reasonablypolymorphic.com/blog/freer-higher-order-effects/index.html and https://reasonablypolymorphic.com/blog/tactics/index.html 等博文后,我想我明白了。我只需要使用 getInitialStateS 得到一个 f (),然后使用冰淇淋运算符 <$ 在传递之前将 (p,t) 值注入 f 上下文它是 bindT 的结果。我被暗示使用 getInitialStateS 之类的东西更高级并且应该避免的评论吓跑了,但是现在我更好地理解了正在发生的事情,我认为它正是这种情况的正确工具。这是结果代码。它会进行类型检查,但我还不能真正测试它。

import           Polysemy
import           Polysemy.Final
import qualified Unbound.Generics.LocallyNameless as U

data LFresh m a where
  Avoid   :: [U.AnyName] -> m a -> LFresh m a
  LUnbind :: (U.Alpha p, U.Alpha t) => U.Bind p t -> ((p,t) -> m c) -> LFresh m c

makeSem ''LFresh

runLFresh :: Member (Final U.LFreshM) r => Sem (LFresh ': r) a -> Sem r a
runLFresh = interpretFinal @U.LFreshM $ \case
  Avoid xs m  -> do
    m' <- runS m
    pure (U.avoid xs m')
  LUnbind b k -> do
    s <- getInitialStateS
    k' <- bindS k
    pure (U.lunbind b (k' . (<$ s)))