<div dir="ltr">I think monad-control is what I was looking for but was missing when trying to come up with a solution involving lift. Thanks!<div><br></div><div>Paul</div></div><br><div class="gmail_quote"><div dir="ltr">On Tue, May 29, 2018 at 11:15 PM Li-yao Xia <<a href="mailto:lysxia@gmail.com">lysxia@gmail.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Hi Paul,<br>
<br>
We can use Data.Coerce.coerce to do the (un)wrapping and defer to the <br>
Alternative/MonadPlus instance at the right level.<br>
<br>
(MyMonad a) is representationally equivalent to (Stack (Either String <br>
a)), where Stack is defined as<br>
<br>
type Stack = ReaderT Env (StateT Store (ListT Identity))<br>
<br>
Thus, we can coerce Stack's MonadPlus methods (which lift ListT's <br>
methods) as follows:<br>
<br>
<br>
import Data.Coerce<br>
<br>
instance MonadPlus MyMonad where<br>
   mzero :: forall a. MyMonad a<br>
   mzero = coerce (mzero @Stack @(Either String a))<br>
<br>
   mplus :: forall a. MyMonad a -> MyMonad a -> MyMonad a<br>
   mplus = coerce (mplus @Stack @(Either String a))<br>
<br>
<br>
The upcoming DerivingVia generalizes this pattern somewhat, although it <br>
will be necessary to pick a different equivalent type than above.<br>
<br>
<br>
newtype MyMonad = MyMonad {<br>
   runMyMonad :: ((ReaderT Env (ExceptT String<br>
     (StateT Store (ListT Identity)))) a) }<br>
   deriving (Functor, Applicative, Monad)<br>
   deriving (Alternative, MonadPlus)<br>
     via (ReaderT Env (ExceptT' String (StateT Store (ListT Identity))))<br>
<br>
<br>
where ExceptT' is a transformer identical to ExceptT, but it lifts the <br>
transformed monad's MonadPlus instance instead of providing its own.<br>
<br>
A different solution is monad-control, which generalizes MonadTrans. <br>
Like `lift`, `liftWith` moves an action "up" one level in a transformer <br>
stack, but in addition, it provides a way to move "down" as well, as a <br>
continuation given to the wrapped action.<br>
<br>
Although powerful, it is certainly not an easy interface to grasp, but <br>
my point here is to demonstrate one use of it.<br>
<br>
<br>
liftControl<br>
   :: (MonadTransControl t, Monad m, Monad (t m))<br>
   => (Run t -> m (StT t a)) -> t m a<br>
liftControl f = liftWith f >>= restoreT . return<br>
<br>
instance Alternative MyMonad where<br>
   empty = MyMonad ((lift . lift) empty)<br>
   MyMonad a <|> MyMonad b = MyMonad $<br>
     liftControl $ \run1 -> liftControl $ \run2 -><br>
       (run2 . run1) a <|> (run2 . run1) b<br>
<br>
<br>
It's also not quite obvious this does the right thing so here are some <br>
QuickCheck tests that these two implementations are equivalent to the <br>
original one:<br>
<br>
<a href="https://lpaste.net/2697355636458389504" rel="noreferrer" target="_blank">https://lpaste.net/2697355636458389504</a><br>
<br>
Cheers,<br>
Li-yao<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div>