How to define MonadUnliftIO instance for a newtype with a phantom type-variable?

问题

Related question - Is it safe to derive MonadThrow, MonadCatch, MonadBaseControl, MonadUnliftIO, etc? - where I had enabled, both - DeriveAnyClass and GeneralizedNewtypeDeriving to get the code to compile, but didn't bother looking at the ominous warnings. Now, that I am running my refactored code, it's throwing a runtime error:

No instance nor default method for class operation >>=

So, I removed DeriveAnyClass and kept ONLY GeneralizedNewtypeDeriving and have the following compile error:

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

Note: I realise that the first error about >>= has got nothing to do with the error about MonadUnliftIO. I have confirmed that there are no warnings about a missing >>=, when DeriveAnyClass is turned off.

I guess I need to write the instance for MonadUnliftIO myself, because the compiler probably cannot figure this out in the presence of a newtype AND a phantom type-variable. However, I just can't figure out how to define the askUnliftIO for my type, given above.

Attempt 1 at minimal code snippet

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

回答1:

Plan:

• How to implement MonadUnliftIO by hand.
• How to newtype-derive MonadUnliftIO.

Implement explicitly

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

There is nothing magical about this; here's how you can derive the definition of askUnliftIO. We want to wrap the existing instance of MonadUnliftIO for ReaderT Auth m. Using that instance, we have:

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

And we are looking for

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

In other words, we want to replace the two occurrences of ReaderT Auth with AuthM. The outer one is easy:

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

To get at the inner one, we can use fmap, and then the problem becomes to find the right function UnliftIO (ReaderT Auth m) -> UnliftIO (AuthM m).

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

-- provided --

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

We're now looking for a function, and the library doesn't provide any functions on UnliftIO, so the only way to start is a lambda with pattern-matching, and since the function result is UnliftIO, we can also start with a constructor:

(\(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)

Here we see that run and the hole only differ in their arguments. We can transform a function's argument by function composition, we fill the hole with run . _, containing a new hole:

(\(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)

That hole is finally filled with the destructor \(AuthM u) -> u, aka. unAuthM. Put all the pieces together:

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

Note that fmap f (AuthM u) = AuthM (fmap f u) (by definition of fmap for AuthM), which is how you get the version at the top. Whether or not to do that bit of rewriting is mostly a matter of taste.

Most of these steps can be carried out with the help of GHC's typed holes. There's some loose ends at the beginning when you try to find the right shape for the expression, but there might also be a way to use typed holes to help with that part of the exploration as well.

• See also Implement With Types, Not Your Brain!

Note that none of this requires any knowledge about the purpose of askUnliftIO nor AuthM. It's 100% mindless wrapping/unwrapping between AuthM and ReaderT, i.e., 100% boilerplate that could be automated, which is the topic of this next section.

Derive

Technical explanation of why deriving doesn't Just Work. The extension GeneralizedNewtypeDeriving tries to coerce ReaderT Auth m (UnliftIO (ReaderT Auth m)) to AuthM m (UnliftIO (AuthM m)) (in the case of askUnliftIO). However, this is not possible if m depends on its argument nominally.

• For more details, see also this blogpost, which also gives the solution summarized below: https://ryanglscott.github.io/2018/03/04/how-quantifiedconstraints-can-let-us-put-join-back-in-monad/

We need a "representational role" constraint, which we can encode as follows thanks to QuantifiedConstraints which appeared in 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

Thus annotate the derived instance with that constraint:

{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}

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

---

Full snippet:

{-# 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)))

来源：https://stackoverflow.com/questions/57198777/how-to-define-monadunliftio-instance-for-a-newtype-with-a-phantom-type-variable