如何将 MTL 风格、CPS 风格的高阶效果融入多义词中？答案

【问题标题】：How to incorporate MTL-style, CPS-style higher-order effect into polysemy?如何将 MTL 风格、CPS 风格的高阶效果融入多义词中？
【发布时间】：2021-07-14 20:11:42
【问题描述】：

我正在将代码库转换为使用polysemy，并且在转换我对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

显然是高阶的。我想创建一个与LFresh 类对应的效果，并通过unbound-generics 提供的LFreshM monad 运行它。这是我迄今为止尝试过的，使用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 一起工作”，所以如果有更好的、完全不同的方法来实现，我也很高兴听到它。

【问题讨论】：

我在主题中说“CPS 风格”的原因是 lunbind 采用 Bind 和 continuation 指定如何处理解构绑定的方式.问题似乎是bindS 假设 Kleisli 箭头的输入将是另一个单子动作的结果，在调用 runS 之后，该动作最终将包裹在 f 中。但是，这里不是这样。

标签： haskell haskell-polysemy

【解决方案1】：

在阅读了https://reasonablypolymorphic.com/blog/freer-higher-order-effects/index.html 和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)))

【讨论】：