haskell - 嵌套应用仿函数时使 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) 使用 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

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

* 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)

有没有办法使用我的 Bind.do当两者 QualifiedDo和 ApplicativeDo在 Main 中启用?

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