<div dir="ltr"><div><div><div><div><div>I saw that to write liftQD you decontruct (unwrap) the type and reconstruct it. <br></div>I don't know if I can do that for my Exp (which is a full DSL)...<br><br></div>Anyway, there should be a way to encode the Effect/NoEffect semantic at type level...<br>
</div>Using Oleg's parametrized monad idea (<a href="http://hackage.haskell.org/package/monad-param-0.0.2/docs/Control-Monad-Parameterized.html">http://hackage.haskell.org/package/monad-param-0.0.2/docs/Control-Monad-Parameterized.html</a>), I tried:<br>
<br><span style="font-family:courier new,monospace">> {-# LANGUAGE KindSignatures, DataKinds, ScopedTypeVariables, GADTs<br>>   MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}<br>
<br>> module DSLEffects where<br>> import Prelude hiding (return, (>>), (>>=))<br>> import Control.Monad.Parameterized</span><br><br>This data type will be promoted to kind level (thanks to DataKinds):<br>
<span style="font-family:courier new,monospace"><br>> data Eff = Effect | NoEffect</span><br><br>This class allows to specify the semantic on Effects (Effect + NoEffect = Effect):<br><span style="font-family:courier new,monospace"><br>
> class Effects (m :: Eff) (n::Eff) (r::Eff) | m n -> r<br>> instance Effects Effect n Effect<br>> instance Effects NoEffect n n</span><br><br>This is the DSL:<br><span style="font-family:courier new,monospace"><br>
> data Exp :: Eff -> * -> * where<br>>   ReadAccount  :: Exp NoEffect Int      --ReadAccount has no effect<br>>   WriteAccount :: Int -> Exp Effect ()  --WriteAccount has effect<br>>   Const        :: a -> Exp r a<br>
>   Bind         :: Effects m n r => Exp m a -> (a -> Exp n b) -> Exp r b --Bind comes with a semantic on effects<br>>   Fmap         :: (a -> b) -> Exp m a -> Exp m b<br><br>> instance Functor (Exp r) where<br>
>   fmap = Fmap<br><br>> instance Return (Exp r) where<br>>    returnM = Const<br><br>> instance (Effects m n r) => Bind (Exp m) (Exp n) (Exp r) where<br>>    (>>=) = Bind<br><br>> noEff :: Exp NoEffect ()<br>
> noEff = returnM ()<br><br>> hasEffect :: Exp Effect ()<br>> hasEffect = ReadAccount >> (returnM () :: Exp Effect ())</span><br><br></div>This is working more or less, however I am obliged to put the type signature on the returnM (last line): why?<br>
</div><span style="font-family:arial,helvetica,sans-serif">Furthermore, I cannot write</span><span style="font-family:courier new,monospace"><span style="font-family:arial,helvetica,sans-serif"> directly:</span><br></span><br>
<span style="font-family:courier new,monospace"><span style="font-family:courier new,monospace">> hasEffect :: Exp Effect ()<br></span>> hasEffect = ReadAccount</span><div><div><div><br><br></div><div>Do you have a better idea?<br>
<br></div></div></div></div><div class="gmail_extra"><br><br><div class="gmail_quote">On Sun, Feb 2, 2014 at 8:55 PM, Lindsey Kuper <span dir="ltr"><<a href="mailto:lindsey@composition.al" target="_blank">lindsey@composition.al</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div class="im">On Sun, Feb 2, 2014 at 2:42 PM, Corentin Dupont<br>
<<a href="mailto:corentin.dupont@gmail.com">corentin.dupont@gmail.com</a>> wrote:<br>
> you should be able to run an effectless monad in an effectful one.<br>
> How to encode this semantic?<br>
<br>
</div>In LVish we just have a `liftQD` operation that will let you lift a<br>
deterministic computation to a quasi-deterministic one (recall that<br>
deterministic computations can perform fewer effects):<br>
<br>
  liftQD :: Par Det s a -> Par QuasiDet s a<br>
<br>
So, analogously, you could have a `liftEff` and then write `liftEff<br>
noEff`.  This is also a little bit ugly, but you may find you don't<br>
have to do it very often (we rarely use `liftQD`).<br>
<span class="HOEnZb"><font color="#888888"><br>
Lindsey<br>
</font></span></blockquote></div><br></div>