7

相关问题 -派生 MonadThrow、MonadCatch、MonadBaseControl、MonadUnliftIO 等是否安全?- 我已经启用了 -DeriveAnyClassGeneralizedNewtypeDeriving 让代码编译,但没有费心查看不祥的警告。现在,我正在运行重构的代码,它引发了运行时错误:

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

注意:我意识到第一个错误 about>>=与错误 about 无关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)
--    |                                                                                                       ^^^^^^^^^^^^^
-- 
4

2 回答 2

7

计划:

  • 如何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 AuthAuthM。外层很简单:

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) -> uunAuthM. 将所有部分放在一起:

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

请注意fmap f (AuthM u) = AuthM (fmap f u)(根据fmapfor的定义AuthM),这是您获取顶部版本的方式。是否进行那一点重写主要是一个品味问题。

这些步骤中的大部分都可以在 GHC 的类型孔的帮助下进行。当您尝试为表达式找到正确的形状时,一开始会有一些松散的结局,但也可能有一种方法可以使用类型孔来帮助进行这部分探索。

请注意,这些都不需要任何有关askUnliftIOnor用途的知识AuthMAuthM它是 100% 无意识的和之间的包装/展开ReaderT,即 100% 可以自动化的样板,这是下一节的主题。

派生

关于为什么派生不能正常工作的技术解释。扩展GeneralizedNewtypeDeriving试图强制ReaderT Auth m (UnliftIO (ReaderT Auth m))AuthM m (UnliftIO (AuthM m))在 的情况下askUnliftIO)。m但是,如果名义上取决于其论点,则这是不可能的。

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)))
于 2019-07-25T12:28:42.140 回答
3

从 0.2.0.0 版本开始unliftio-core,该askUnliftIO函数已从类型类中移出,这使得newtype再次派生该实例成为可能!

data FeatureFlag
data Auth auth

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

cf https://github.com/fpco/unliftio/issues/55

于 2020-06-15T10:05:56.903 回答