basvandijk/monad-control

`defaultLiftWith2` broken with ghc-9.0.1

Opened this issue · 4 comments

jumper149 commented

Older ghc versions are working, but with ghc 9.0.1 this fails:
https://travis-ci.com/github/jumper149/blucontrol/jobs/499404592#L486

src/Blucontrol/Recolor/X.hs:36:14: error:
    • Couldn't match type: Monad (ReaderT Display m1)
                     with: RecolorXT m1 b
      Expected: (Run RecolorXT -> m a) -> RecolorXT m a
        Actual: (RunDefault2 RecolorXT (ExceptT XError) (ReaderT Display)
                 -> m a)
                -> RecolorXT m a
    • In the expression: defaultLiftWith2 RecolorXT unRecolorXT
      In an equation for ‘liftWith’:
          liftWith = defaultLiftWith2 RecolorXT unRecolorXT
      In the instance declaration for ‘MonadTransControl RecolorXT’
   |
36 |   liftWith = defaultLiftWith2 RecolorXT unRecolorXT
   |              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

The source code is here:
https://github.com/jumper149/blucontrol/blob/v0.3.0.0/src/Blucontrol/Recolor/X.hs#L36

newtype RecolorXT m a = RecolorXT { unRecolorXT :: ExceptT XError (ReaderT Display m) a }
  deriving (Applicative, Functor, Monad, MonadBase b, MonadBaseControl b, MonadError XError)

instance MonadTrans RecolorXT where
  lift = RecolorXT . lift . lift

instance MonadTransControl RecolorXT where
  type StT RecolorXT a = StT (ReaderT Display) (StT (ExceptT XError) a)
  liftWith = defaultLiftWith2 RecolorXT unRecolorXT
  restoreT = defaultRestoreT2 RecolorXT
jumper149 commented

I just came up with a way to reduce boilerplate a little!

First we set up a newtype, which will need an explicit implementation.

newtype CombinerT (t1 :: (Type -> Type) -> Type -> Type) (t2 :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) (a :: Type) = CombinerT { unCombinerT :: t1 (t2 m) a }
  deriving (Applicative, Functor, Monad, MonadBase b, MonadBaseControl b)

instance ((forall m. Monad m => Monad (t2 m)), MonadTrans t1, MonadTrans t2) => MonadTrans (CombinerT t1 t2) where
    lift = CombinerT . lift . lift

instance ((forall m. Monad m => Monad (t2 m)), MonadTransControl t1, MonadTransControl t2) => MonadTransControl (CombinerT t1 t2) where
  type StT (CombinerT t1 t2) a = StT t2 (StT t1 a)
  liftWith f = CombinerT $ liftWith $ \run -> liftWith $ \run' -> f $ run' . run . unCombinerT
  restoreT = defaultRestoreT2 CombinerT

Then we can use DerivingVia to keep it concise.

newtype RecolorXT m a = RecolorXT { unRecolorXT :: ExceptT XError (ReaderT Display m) a }
  deriving (Applicative, Functor, Monad, MonadBase b, MonadBaseControl b, MonadError XError)
  deriving (MonadTrans, MonadTransControl) via CombinerT (ExceptT XError) (ReaderT Display)

Another advantage of this method is, that it isn't even necessary to manually set StT RecolorR a.
This was my inspiration: https://www.youtube.com/watch?v=UZaQuSIrO6s

jumper149 commented

Soooo, after spending some time on IRC...
there is also a way to use defaultLiftWith2 with GHC 9.

liftWith f = defaultLiftWith2 RecolorXT unRecolorXT $ \ x -> f x
  • 🎉1
phadej commented

Your combiner is ComposeT, which we will (be able to define) with next release of transformers.

phadej commented

The eta-expansion in #52 (comment) is the way to go. I'm quite sure we cannot do better, unfortunately. This is an effect of simplified subsumption.