Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

throw envelope errors in a short-circuiting monad #3

Open
cdepillabout opened this issue May 2, 2017 · 7 comments
Open

throw envelope errors in a short-circuiting monad #3

cdepillabout opened this issue May 2, 2017 · 7 comments
Labels

Comments

@cdepillabout
Copy link
Owner

@cdepillabout cdepillabout commented May 2, 2017

It would be nice to be able to throw Envelope errors in some sort of short circuiting monad.

I'm not sure if there is a good / clean / easy way to implement this, but I would be interested in different possibilities.

@cdepillabout
Copy link
Owner Author

@cdepillabout cdepillabout commented May 7, 2017

@lexi-lambda Left some notes on playing around with this at #7 (comment)

@3noch
Copy link

@3noch 3noch commented May 19, 2017

Just to get it on the table: You could just use throwIO. You create a custom exception type that is not exported and a type-safe function that throws only that exception within your Envelope. Your Envelope "runner" would always catch this custom exception type and handle it properly.

This may seem hacky, but in some cases I prefer this over pulling out ExceptT which seems like a very heavy tool for the job.

@cdepillabout
Copy link
Owner Author

@cdepillabout cdepillabout commented Mar 8, 2018

I ended up making an EnvelopeT similar to lexi-lambda's suggestion from #7 (comment). It seems to work alright, although it suffers from the same problems she describes:

data EnvelopeT es m a = EnvelopeT
  { runEnvelopeT :: m (Envelope es a)
  } deriving Functor

instance Monad m => Applicative (EnvelopeT es m) where
  pure :: a -> EnvelopeT es m a
  pure a = EnvelopeT $ pureSuccEnvelope a

  (<*>) :: EnvelopeT es m (a -> b) -> EnvelopeT es m a -> EnvelopeT es m b
  (<*>) = ap

instance Monad m => Monad (EnvelopeT es m) where
  (>>=) :: EnvelopeT es m a -> (a -> EnvelopeT es m b) -> EnvelopeT es m b
  (EnvelopeT m) >>= k = EnvelopeT $ do
    env <- m
    case env of
      SuccEnvelope a -> runEnvelopeT $ k a
      ErrEnvelope err -> pure $ ErrEnvelope err

instance MonadTrans (EnvelopeT es) where
  lift :: Monad m => m a -> EnvelopeT es m a
  lift m = EnvelopeT $ do
    val <- m
    pureSuccEnvelope val

instance MonadIO m => MonadIO (EnvelopeT es m) where
  liftIO :: IO a -> EnvelopeT es m a
  liftIO = lift . liftIO

pureSuccEnvT :: Applicative m => a -> EnvelopeT es m a
pureSuccEnvT = EnvelopeT . pureSuccEnvelope

pureErrEnvT :: (Applicative m, IsMember e es) => e -> EnvelopeT es m a
pureErrEnvT = EnvelopeT . pureErrEnvelope

Then you can write helper functions for your application like this:

runDbOr404EnvT ::
     ( HasPool r
     , IsMember DbNotFoundErr es
     , MonadBaseControl IO m
     , MonadReader r m
     )
  => ReaderT SqlBackend m (Maybe a)
  -> EnvelopeT es m a
runDbOr404EnvT query = do
  pool' <- lift $ view pool
  maybeRes <- lift $ runSqlPool query pool'
  case maybeRes of
    Just a -> pureSuccEnvT a
    Nothing -> pureErrEnvT DbNotFoundErr

I haven't yet checked the laws for EnvelopeT, but it is effectively ExceptT, so I'm thinking it is probably fine.

@23Skidoo
Copy link

@23Skidoo 23Skidoo commented Jul 4, 2019

Would be nice if there was a blessed implementation of this.

@cdepillabout
Copy link
Owner Author

@cdepillabout cdepillabout commented Jul 6, 2019

@23Skidoo I'm working on putting this together for you.

@cdepillabout
Copy link
Owner Author

@cdepillabout cdepillabout commented Jul 8, 2019

@23Skidoo I just sent a PR adding an EnvelopeT transformer similar to what is in a comment above.

I also made a release to hackage with EnvelopeT:

http://hackage.haskell.org/package/servant-checked-exceptions-2.2.0.0

This doesn't add an mtl-like MonadEnvelope type class, but if someone wants to put together a PR adding something like that, I'd accept it.

@23Skidoo
Copy link

@23Skidoo 23Skidoo commented Jul 8, 2019

Awesome, thanks!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
3 participants