<div dir="ltr">Hi all,<br><br>I&#39;ve come across some code I just can&#39;t figure out how to write appropriately. Below is a silly example that demonstrates what I&#39;m trying to do. I don&#39;t really have the appropriate vocabulary to describe the issue, so I&#39;ll let the code speak for itself. In particular, I&#39;m trying to understand what the correct type signatures for unwrapMyData and bin should be.<br>
<br>Thanks,<br>Michael<br><br>---<br><br>{-# LANGUAGE MultiParamTypeClasses #-}<br>{-# LANGUAGE ExistentialQuantification #-}<br>{-# LANGUAGE FlexibleInstances #-}<br>{-# LANGUAGE FlexibleContexts #-}<br>class Monad m =&gt; MonadFoo x m where<br>
    foo :: x -&gt; m a<br><br>data MyData a = forall i. Integral i =&gt; MyLeft i<br>              | MyRight a<br><br>instance Monad MyData where<br>    return = MyRight<br>    (MyLeft i) &gt;&gt;= _ = MyLeft i<br>    (MyRight x) &gt;&gt;= f = f x<br>
instance Integral i =&gt; MonadFoo i MyData where<br>    foo = MyLeft<br><br>bar :: MonadFoo Int m =&gt; Int -&gt; m String<br>bar 0 = return &quot;zero&quot;<br>bar i = foo i<br><br>baz :: String -&gt; MyData String<br>baz &quot;zero&quot; = MyRight &quot;Zero&quot;<br>
baz _ = MyLeft (-1 :: Integer)<br><br>--This works: unwrapMyData (MyLeft i) = foo (fromIntegral i :: Integer)<br>unwrapMyData (MyLeft i) = foo i -- This is what I&#39;d like to work<br>unwrapMyData (MyRight a) = return a<br>
<br>bin i = do<br>    a &lt;- bar i<br>    b &lt;- unwrapMyData $ baz a<br>    return $ b ++ &quot;!!!&quot;<br><br>instance Show a =&gt; MonadFoo a IO where<br>    foo = fail . show -- I know, it&#39;s horrible...<br><br>
main = do<br>    res &lt;- bin 0<br>    putStrLn res<br><br></div>