Monad Transformer：由于不同的 monad 定义绑定的麻烦答案

【问题标题】：Monad Transformer: troubles defining bind due to different monadsMonad Transformer：由于不同的 monad 定义绑定的麻烦
【发布时间】：2016-04-25 12:34:13
【问题描述】：

我有一个名为 TaskMonad 的 Monad，定义如下：

data TaskMonad a = TaskMonad (Environment -> (TaskResult a, Environment))

其中Environment 是记录类型，TaskResult 是 ADT；但它们对问题并不重要。

我已经为TaskMonad 定义了Functor、Applicative 和Monad 实例，现在我希望能够将此单子与其他单子（例如IO）结合起来，所以我定义了一个新类型如下：

newtype Task m a = Task { runTask :: m (TaskMonad a) }

我已将Functor 和Applicative 定义如下：

instance Monad m => Functor (Task m) where
    fmap f ta = Task $ do tma <- runTask ta
                          return (fmap f tma)

instance Monad m => Applicative (Task m) where
    pure = Task . return . return
    (<*>) prod tx = Task $ do tmprod <- runTask prod
                              tmtx   <- runTask tx
                              return (tmprod <*> tmtx)

我还让Task 成为MonadTrans 类的成员：

instance MonadTrans Task where
    lift = Task . (liftM return)

到目前为止一切顺利（或者至少可以编译..），但现在我想为Monad 定义实例，但我在这里遇到了问题：

instance Monad m => Monad (Task m) where
    return      = pure
    (>>=) ta tb = ...

我尝试了很多事情，大多数尝试都是这样开始的：

(>>=) ta tb = Task $ do tma <- runTask ta

现在我们在 do 块中为 m monad 提供了 tma :: TaskMonad a。现在我想做的是，以某种方式调用>>= 实例为TaskMonad，这样我就可以得到tma 的结果，一个a 类型的值，所以我可以用它参数化tb 以获得一个Task b 的值。但是我在m monad 的上下文中，遇到了各种各样的问题。

我如何获得tma 的结果并提供给tb？

【问题讨论】：

一个明显的问题是你没有得到Environment 对吗？我认为你必须再次打开TaskMonad（而不是使用你已经得到的>>=）
呃哦，说了很多坏话之后，我的 Applicative 实例让 TaskMonad 工作了。我生锈了现在正在尝试让您的绑定工作。
嗯，我想我将不得不稍微摆弄一下Environment。需要注意的是TaskMonad 的(>>=) 函数有些复杂。仅仅向TaskMonad 提供Environment 是不够的。我需要使用TaskMonad 的(>>=) 来表达它。感谢您尝试 Bartek！我自己现在已经没有坏话了。
也许从一开始就将TaskMonad 定义为转换器？它在外观上看起来类似于 StateT，也许这是要走的路？

标签： haskell functional-programming monads monad-transformers

【解决方案1】：

好吧，我不知道这有多大帮助，但如果你真的从第 0 天开始使用变压器（TaskMonad），你可以这样做：

data TaskMonad m a = TaskMonad (Environment -> m (TaskResult a, Environment)) deriving Functor
        
instance Monad m => Monad (TaskMonad m) where
    return = pure
    (TaskMonad f) >>= b = TaskMonad $ \e -> do
        (TaskResult r, e') <- f e
        let (TaskMonad g) = b r
        g e'

instance (Monad m, Functor m) => Applicative (TaskMonad m) where
    pure a = TaskMonad $ \e -> return (TaskResult a, e)
    (TaskMonad f) <*> (TaskMonad g) = TaskMonad $ \e -> do
        (TaskResult f', e') <- f e 
        (TaskResult a, e'') <- g e'
        return (TaskResult (f' a), e'')

可能还有一种方法可以按照您最初的意图进行操作，但我很确定原始 Task 也需要更改为初始 Environment。

我认为你实际上在你的 monad 中做的不仅仅是 State，所以需要将它放在各自的实例中，但我认为框架应该会有所帮助。

当然，如果您需要使用非变压器版本，只需将Identity 传递给m。

免责声明：

我知道 Applicative 实例的这种实现没有意义，但我是在没有 ApplicativeDo 的旧 GHC 上构建它的，将愚蠢的约束放在那里确实是最简单的事情。

【讨论】：

可以只定义(<*>) = ap。

【解决方案2】：

如@BartekBanachewicz 的回答中所述，将单子m 放入-> 是可行的方法。

我相信拥有m (TaskMonad a) 不可能按照您想要的方式进行操作，至少一般情况下是这样。一般monads aren't closed under composition，这是这种情况的一个例子。

让我举一个简化的例子（需要一些理论）：让我们使用 reader monad 而不是 state monad，让我们删除 TaskResult 并将环境作为类型参数。所以TaskMonad 将只是m (r -> a)。现在让我们假设它是一个单子，那么有

join :: m (r -> (m (r -> a))) -> m (r -> a)

将a 专业化为Void（另请参阅Bottom type）和m 至Either r 我们得到

join :: Either r (r -> (Either r (r -> Void))) -> Either r (r -> Void)

但是我们可以构建

doubleNegationElimination :: Either r (r -> Void)
doubleNegationElimination = join (Right Left)

作为Right Left :: Either r (r -> Either r (r -> Void))。通过Curry-Howard isomorphism，这意味着我们可以证明Double negation elimination 在直觉逻辑中，这是一个矛盾。

您的情况有些复杂，但也可以在那里提出类似的论点。唯一的漏洞是我们假设“环境”部分r 是通用的，因此如果您的join 或>>= 以某种方式特定于Environment，则将无法工作。所以在这种情况下你也许可以这样做，但我猜你会遇到其他问题，阻止你获得正确的非平凡Monad 实例。

【讨论】：