嵌套应用函子时使 QualifiedDo 和 ApplicativeDo 一起工作

Question

我想定义深度嵌套的 compositions 应用函子。例如这样的事情：

{-# LANGUAGE TypeOperators #-}
import Control.Monad.Trans.Cont
import Control.Arrow (Kleisli (..))
import Data.Aeson
import Data.Aeson.Types
import Data.Functor.Compose
import Data.Functor

type Configurator = Kleisli Parser Value
type Allocator = ContT () IO 
type Validator = Either String

someConfigurator :: Configurator Int
someConfigurator = undefined

someAllocator :: Allocator Char
someAllocator = undefined

-- the nested functor composition. left-associated
type Phases = Configurator `Compose` Allocator `Compose` Validator 

data Foo = Foo Int Char

-- I want to streamline writing this, without spamming the Compose constructor 
fooPhases :: Phases Foo
fooPhases = _

为了简化创建 fooPhases 值的语法，我想到了 (ab)using QualifiedDo:

module Bind where
import Data.Functor
import Data.Functor.Compose

(>>=) :: Functor f => f a -> (a -> g b) -> Compose f g b 
(>>=) f k = bindPhase f k

(>>) :: Functor f => f a -> g b -> Compose f g b 
(>>) f g = Compose $ f <&> \_ -> g

fail :: MonadFail m => String -> m a
fail = Prelude.fail

bindPhase :: Functor f => f a -> (a -> g b) -> Compose f g b 
bindPhase f k = Compose (f <&> k)

令我有些惊讶的是，它起作用了：

{-# LANGUAGE QualifiedDo #-}
import qualified Bind
fooPhases :: Phases Foo
fooPhases = Bind.do 
    i <- someConfigurator 
    c <- someAllocator 
    pure (Foo i c)

唉，当我向 Bind 模块添加类似应用程序的函数时

return :: Applicative f => a -> f a
return = Prelude.pure

pure :: Applicative f => a -> f a
pure = Prelude.pure

fmap :: Functor f => (a -> b) -> f a -> f b
fmap = Prelude.fmap

join :: f (g a) -> Compose f g a
join = Compose

(<*>) :: (Applicative f, Applicative g) => f (a -> b) -> g a -> Compose f g b
(<*>) f g = Compose $ f <&> \z -> Prelude.fmap (z $) g

然后在Main中启用ApplicativeDo，我开始收到如下错误：

* Couldn't match type: Compose (Kleisli Parser Value) (ContT () IO)
                 with: Kleisli Parser Value
  Expected: Configurator (Compose Allocator Validator Foo)
    Actual: Compose
              (Kleisli Parser Value)
              (ContT () IO)
              (Compose Allocator Validator Foo)

当 QualifiedDo 和 ApplicativeDo 在 Main 中启用时，有没有办法使用我的 Bind.do？

Answer 1

为了使这更容易推理，首先手动脱糖 fooPhases 每种方式：

fooPhasesMonad = 
    someConfigurator Bind.>>= \i ->
    someAllocator Bind.>>= \c ->
    pure (Foo i c)

fooPhasesApplicative = Bind.fmap Foo someConfigurator Bind.<*> someAllocator

如果您在 GHCi 中检查它们的类型，您会看到 fooPhasesMonad 具有您想要的类型（正如预期的那样，因为它有效），但是 fooPhasesApplicative 具有类型 (Configurator `Compose` Allocator) Foo .

第一个问题是 Bind.fmap f m 不等同于 m Bind.>>= (pure . f)。特别是，后者会产生一个额外的 Compose 层，而前者不会。当您使用 ApplicativeDo 时，使用前者代替意味着您最终只得到 (Configurator `Compose` Allocator) 而不是 (Configurator `Compose` Allocator `Compose` Validator)，这是您的类型错误的原因。要修复它，请将 Bind.fmap 的定义替换为以下定义：

fmap :: (Functor f, Applicative g) => (a -> b) -> f a -> Compose f g b
fmap f k = bindPhase k (Prelude.pure . f)

虽然你的 do-notation 的“monads”不符合所有的 monad 法则（甚至结果的类型也不正确），所以一些你认为理所当然的重写仍然无效。特别是，除非您满足于像这样组合类型，否则您仍然会收到错误消息：

type Phases = (Configurator `Compose` Validator) `Compose` Allocator

嵌套应用函子时使 QualifiedDo 和 ApplicativeDo 一起工作

Making QualifiedDo and ApplicativeDo work together when nesting applicative functors

haskell

do-notation

applicative