如何为带有幻像类型变量的新类型定义MonadUnliftIO实例？

Question

相关问题- 派生MonadThrow，MonadCatch，MonadBaseControl，MonadUnliftIO等是否安全？-我在那里启动，这- DeriveAnyClass并且GeneralizedNewtypeDeriving 让代码编译，但没有打扰看不祥的警告。现在，我正在运行重构的代码，它会引发运行时错误：

No instance nor default method for class operation >>=

因此，我DeriveAnyClass仅删除并保留GeneralizedNewtypeDeriving了以下编译错误：

{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies, AllowAmbiguousTypes, RankNTypes, StandaloneDeriving, UndecidableInstances #-}

newtype AuthM (fs :: [FeatureFlag]) auth m a =
  AuthM (ReaderT (Auth auth) m a)
  deriving (Functor, Applicative, Monad, MonadReader (Auth auth), MonadIO, MonadThrow, MonadCatch, MonadMask, MonadUnliftIO)


--     • Couldn't match representation of type ‘m (Control.Monad.IO.Unlift.UnliftIO
--                                                   (AuthM fs auth m))’
--                                with that of ‘m (Control.Monad.IO.Unlift.UnliftIO
--                                                   (ReaderT (Auth auth) m))’
--         arising from the coercion of the method ‘Control.Monad.IO.Unlift.askUnliftIO’
--           from type ‘ReaderT
--                        (Auth auth)
--                        m
--                        (Control.Monad.IO.Unlift.UnliftIO (ReaderT (Auth auth) m))’
--             to type ‘AuthM
--                        fs auth m (Control.Monad.IO.Unlift.UnliftIO (AuthM fs auth m))’
--       NB: We cannot know what roles the parameters to ‘m’ have;
--         we must assume that the role is nominal
--     • When deriving the instance for (MonadUnliftIO (AuthM fs auth m))
--    |
-- 82 |   deriving (Functor, Applicative, Monad, MonadReader (Auth auth), MonadIO, MonadThrow, MonadCatch, MonadMask, MonadUnliftIO)
--    |                                                                                                               ^^^^^^^^^^^^^

注意：我意识到关于的第一个错误>>=与关于的错误无关MonadUnliftIO。我已确认关闭>>=时没有关于丢失的警告DeriveAnyClass。

我想我需要为MonadUnliftIO我自己编写实例，因为编译器在存在newtypeAND幻像类型变量的情况下可能无法解决这个问题。但是，我只是不知道如何为askUnliftIO上面的类型定义类型。

以最少的代码段尝试1

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Try13 where

import Control.Monad.Reader
import UnliftIO
import Control.Monad.Catch

data Auth = Auth

newtype AuhM m a = AuthM (ReaderT Auth m a)
  deriving(Functor, Applicative, Monad, MonadReader Auth, MonadIO, MonadThrow, MonadCatch, MonadMask, MonadUnliftIO)

--     • Couldn't match representation of type ‘m (UnliftIO (AuhM m))’
--                                with that of ‘m (UnliftIO (ReaderT Auth m))’
--         arising from the coercion of the method ‘askUnliftIO’
--           from type ‘ReaderT Auth m (UnliftIO (ReaderT Auth m))’
--             to type ‘AuhM m (UnliftIO (AuhM m))’
--       NB: We cannot know what roles the parameters to ‘m’ have;
--         we must assume that the role is nominal
--     • When deriving the instance for (MonadUnliftIO (AuhM m))
--    |
-- 12 |   deriving(Functor, Applicative, Monad, MonadReader Auth, MonadIO, MonadThrow, MonadCatch, MonadMask, MonadUnliftIO)
--    |                                                                                                       ^^^^^^^^^^^^^
-- 

Answer 1

计划：

• 如何MonadUnliftIO手工实施。
• 如何衍生新类型MonadUnliftIO。

明确实施

newtype AuthM m a = AuthM { unAuthM :: ReaderT Auth m a }
  deriving ...

instance MonadUnliftIO m => MonadUnliftIO (AuthM m) where
  askUnliftIO = AuthM (fmap (\(UnliftIO run) -> UnliftIO (run . unAuthM)) askUnliftIO)
  withRunInIO go = AuthM (withRunInIO (\k -> go (k . unAuthM)))

这没有什么不可思议的。这是您得出的定义的方法askUnliftIO。我们要包装MonadUnliftIOfor 的现有实例ReaderT Auth m。使用该实例，我们可以：

askUnliftIO :: ReaderT Auth m (UnliftIO (ReaderT Auth m))

我们正在寻找

_ :: AuthM m (UnliftIO (AuthM m))

换句话说，我们要替换的两次出现ReaderT Auth用AuthM。外层很容易：

AuthM askUnliftIO :: AuthM m (UnliftIO (ReaderT Auth m))

要获得内部fmap函数，我们可以使用，然后问题就变成了找到正确的函数UnliftIO (ReaderT Auth m) -> UnliftIO (AuthM m)。

fmap _ (AuthM askUnliftIO) :: AuthM m (UnliftIO (AuthM m))

-- provided --

_ :: UnliftIO (ReaderT Auth m) -> UnliftIO (AuthM m)

我们现在正在寻找一个函数，并且库中没有提供任何函数UnliftIO，因此，唯一的启动方法是具有模式匹配的lambda，并且由于函数结果为UnliftIO，我们还可以从构造函数开始：

(\(UnliftIO run) -> UnliftIO (_ :: forall a. AuthM m a -> IO a) :: UnliftIO (AuthM m))
  :: UnliftIO (ReaderT Auth m) -> UnliftIO (AuthM m)

-- where (run :: forall a. ReaderT Auth m a -> IO a)

在这里，我们看到run和漏洞仅在于他们的论点不同。我们可以通过函数组成来转换函数的参数，我们用填充孔run . _，其中包含一个新孔：

(\(UnliftIO run) -> UnliftIO (run . (_ :: AuthM m a -> ReaderT Auth m a)
                                :: forall a. AuthM m a -> IO a
                             )
) :: UnliftIO (ReaderT Auth m) -> UnliftIO (AuthM m)

那个洞终于被析构函数\(AuthM u) -> uaka 充满了。unAuthM。将所有部分放在一起：

fmap (\(UnliftIO run) -> UnliftIO (run . unAuthM)) (AuthM askUnliftIO)

请注意fmap f (AuthM u) = AuthM (fmap f u)（根据fmapfor 的定义AuthM），这就是您如何在顶部获得版本。是否进行这种重写大部分取决于品味。

这些步骤中的大多数都可以通过GHC的打孔完成。当您尝试为表达式找到合适的形状时，一开始会有一些松散的结局，但也可能有一种使用类型化的孔来帮助探索这一部分的方法。

• 另请参见以类型实现，而不是您的大脑！

请注意，所有这些都不需要任何有关askUnliftIOnor 的目的的知识AuthM。AuthM和之间是100％的不注意包装/展开ReaderT，即100％的样板可以自动化，这是本节的主题。

派生

为什么派生不起作用的技术说明。延伸GeneralizedNewtypeDeriving试图强迫ReaderT Auth m (UnliftIO (ReaderT Auth m))到AuthM m (UnliftIO (AuthM m))（在的情况下askUnliftIO）。但是，如果m名义上取决于其论点，则这是不可能的。

• 有关更多详细信息，请参阅此博客文章，该文章还提供了以下总结的解决方案：https : //ryanglscott.github.io/2018/03/04/how-quantifiedconstraints-can-let-us-put-join-back-in -单子/

我们需要一个“代表角色”约束，由于QuantifiedConstraints它出现在GHC 8.6中，因此可以将其编码如下。

{-# LANGUAGE QuantifiedConstraints, RankNTypes, KindSignatures #-}
-- Note: GHC >= 8.6

import Data.Coerce
import Data.Kind (Constraint)

type Representational m
  = (forall a b. Coercible a b => Coercible (m a) (m b) :: Constraint)
  -- ^ QuantifiedConstraints + RankNTypes               ^ KindSignatures

因此，使用该约束注释派生实例：

{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}

deriving instance (MonadUnliftIO m, Representational m) => MonadUnliftIO (AuthM m)

完整摘要：

{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, QuantifiedConstraints, KindSignatures, RankNTypes #-}

module Try13 where

import Control.Monad.Reader
import UnliftIO
import Control.Monad.Catch
import Data.Coerce
import Data.Kind (Constraint)

data Auth = Auth

newtype AuthM m a = AuthM { unAuthM :: ReaderT Auth m a }
  deriving(Functor, Applicative, Monad, MonadReader Auth, MonadIO, MonadThrow, MonadCatch, MonadMask)

type Representational m = (forall a b. Coercible a b => Coercible (m a) (m b) :: Constraint)

deriving instance (MonadUnliftIO m, Representational m) => MonadUnliftIO (AuthM m)

-- instance MonadUnliftIO m => MonadUnliftIO (AuthM m) where
--   askUnliftIO = AuthM (fmap (\(UnliftIO run) -> UnliftIO (run . unAuthM)) askUnliftIO)
--   withRunInIO go = AuthM (withRunInIO (\k -> go (k . unAuthM)))