haskus / packages

Haskus packages
https://haskus.org/
24 stars 11 forks source link

MonadBaseControl instance? #34

Open hasufell opened 4 years ago

hasufell commented 4 years ago

Are these usually defined in the upstream package?

hasufell commented 4 years ago

I had some success with:

instance MonadBaseControl b m => MonadBaseControl b (Excepts e m) where
    type StM (Excepts e m) a = ComposeSt (Excepts e) m a
    liftBaseWith   = defaultLiftBaseWith
    restoreM       = defaultRestoreM
    {-# INLINABLE liftBaseWith #-}
    {-# INLINABLE restoreM #-}

instance MonadTransControl (Excepts e) where
    type StT (Excepts e) a = VEither e a
    liftWith f = veitherMToExcepts <$> liftM return $ f $ runE
    restoreT = veitherMToExcepts
    {-# INLINABLE liftWith #-}
    {-# INLINABLE restoreT #-}

instance MonadBase b m => MonadBase b (Excepts e m) where
  liftBase = liftBaseDefault
  {-# INLINABLE liftBase #-}

instance MonadBaseControl (VEither e) (VEither e) where
  type StM (VEither e) a = a
  liftBaseWith f = f id
  restoreM = return
  {-# INLINABLE liftBaseWith #-}
  {-# INLINABLE restoreM #-}

instance MonadBase (VEither e) (VEither e) where
  liftBase = id
  {-# INLINABLE liftBase #-}

veitherMToExcepts :: Monad m => m (VEither es a) -> Excepts es m a
veitherMToExcepts ma = do
  ve <- lift ma
  veitherToExcepts ve
hsyl20 commented 4 years ago

Would you like to make a PR? Ideally with some tests :)

hasufell commented 2 years ago

Well, it seems some parts of the ecosystem are moving away from MonadBaseControl: https://www.snoyman.com/blog/2018/02/conduitpocalypse/

ResourceT already has no instance anymore.

hsyl20 commented 2 years ago

Should we close the issue then? Are there useful utility functions that you would like to upstream?

hasufell commented 2 years ago

Well, MonadUnliftIO instance for ExceptT is somewhat controversially discussed here: https://github.com/fpco/unliftio/issues/68

That certainly applies for Excepts as well. I'm not sure what to do.

hasufell commented 1 year ago

Based on the comment in the unliftio thread, I wrote a similar instance for Excepts. It was a little tricky to not degrade to SomeException, so I had to add an Exception (V (x ': xs)) instance:

instance forall es m . (MonadUnliftIO m, Exception (V es)) => MonadUnliftIO (Excepts es m) where
    withRunInIO exceptSToIO = Excepts $ fmap (either VLeft VRight) $ try $ do
        withRunInIO $ \runInIO ->
            exceptSToIO (runInIO . ((\case
                                     VLeft v -> liftIO $ throwIO $ toException v
                                     VRight a -> pure a) <=< runE))

instance Exception (V '[]) where

instance
   ( Exception x
   , Typeable xs
   , Exception (V xs)
   ) => Exception (V (x ': xs))

I tested this in my own codebase and it seems the error types are preserved.

Let me know what you think @hsyl20

hsyl20 commented 1 year ago

I haven't tested it but it looks good. PR: https://github.com/haskus/packages/pull/45