throw envelope errors in a short-circuiting monad

[cdepillabout]

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]

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

[3noch]

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]

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.