<div dir="ltr">Hi Chris,<div><br></div><div>thanks for your answer!</div><div><br></div><div>I checked both of your solutions and when I apply either I still get errors.</div><div><br></div><div>If I add arguments to my local definitions I get the following errors:</div><div><br></div><div><div>Main.hs:27:3:</div><div> Couldn't match kind ‘*’ with ‘[*]’</div><div> When matching types</div><div> m0 :: * -> * -> *</div><div> State :: [*] -> * -> *</div><div> Expected type: m0 f0 Bool</div><div> -> (Bool -> m0 (E.Unit m0) (Either Tree [Int]))</div><div> -> State '["flatten" :-> (Bool :! 'R)] (Either Tree [Int])</div><div> Actual type: m0 f0 Bool</div><div> -> (Bool -> m0 (E.Unit m0) (Either Tree [Int]))</div><div> -> m0 (E.Plus m0 f0 (E.Unit m0)) (Either Tree [Int])</div><div> Relevant bindings include</div><div> return :: forall a. a -> m0 (E.Unit m0) a (bound at Main.hs:35:9)</div><div> In a stmt of a 'do' block: flatten <- get (Var :: Var "flatten")</div><div> In the expression:</div><div> do { flatten <- get (Var :: Var "flatten");</div><div> if flatten then return $ Right [i] else return $ Left $ Leaf i }</div><div> In an equation for ‘process’:</div><div> process (Leaf i)</div><div> = do { flatten <- get (Var :: Var "flatten");</div><div> if flatten then return $ Right [...] else return $ Left $ Leaf i }</div><div> where</div><div> (>>=) m f = (E.>>=) m f</div><div> (>>) m n = (E.>>) m n</div><div> return = E.return</div><div> fail = E.fail</div><div><br></div><div>Main.hs:35:18:</div><div> No instance for (E.Effect m0) arising from a use of ‘E.return’</div><div> In the expression: E.return</div><div> In an equation for ‘return’: return = E.return</div><div> In an equation for ‘process’:</div><div> process (Leaf i)</div><div> = do { flatten <- get (Var :: Var "flatten");</div><div> if flatten then return $ Right [...] else return $ Left $ Leaf i }</div><div> where</div><div> (>>=) m f = (E.>>=) m f</div><div> (>>) m n = (E.>>) m n</div><div> return = E.return</div><div> fail = E.fail</div><div><br></div><div>Main.hs:47:18:</div><div> No instance for (E.Effect m1) arising from a use of ‘E.return’</div><div> In the expression: E.return</div><div> In an equation for ‘return’: return = E.return</div><div> In an equation for ‘process’:</div><div> process (Branch tl tr)</div><div> = do { eitherL <- process tl;</div><div> eitherR <- process tr;</div><div> case (eitherL, eitherR) of {</div><div> (Left l, Left r) -> return $ Left $ Branch l r</div><div> (Right l, Right r) -> return $ Right $ l ++ r } }</div><div> where</div><div> (>>=) m f = (E.>>=) m f</div><div> (>>) m n = (E.>>) m n</div><div> return = E.return</div><div> fail = E.fail</div></div><div><br></div><div>Which again I can't explain for myself.</div><div><br></div><div>If I add NoMonomorphismRestriction, I get the following errors:</div><div><br></div><div><div>Main.hs:27:3:</div><div> Couldn't match kind ‘*’ with ‘[*]’</div><div> When matching types</div><div> m0 :: * -> * -> *</div><div> State :: [*] -> * -> *</div><div> Expected type: m0 f0 Bool</div><div> -> (Bool -> m0 (E.Unit m0) (Either Tree [Int]))</div><div> -> State '["flatten" :-> (Bool :! 'R)] (Either Tree [Int])</div><div> Actual type: m0 f0 Bool</div><div> -> (Bool -> m0 (E.Unit m0) (Either Tree [Int]))</div><div> -> m0 (E.Plus m0 f0 (E.Unit m0)) (Either Tree [Int])</div><div> In a stmt of a 'do' block: flatten <- get (Var :: Var "flatten")</div><div> In the expression:</div><div> do { flatten <- get (Var :: Var "flatten");</div><div> if flatten then return $ Right [i] else return $ Left $ Leaf i }</div><div> In an equation for ‘process’:</div><div> process (Leaf i)</div><div> = do { flatten <- get (Var :: Var "flatten");</div><div> if flatten then return $ Right [...] else return $ Left $ Leaf i }</div><div> where</div><div> (>>=) = (E.>>=)</div><div> (>>) = (E.>>)</div><div> return = E.return</div><div> fail = E.fail</div></div><div><br></div><div>This seems as if data kinds is not able to infer the proper kinds for the involved types without type signatures.</div><div><br></div><div>So adding NoMonomorphismRestriction does seem to solve some problems, but adding parameters does not seem to be a solution to the problems related to the monomorphism restriction.</div><div><br></div><div>Any advice?</div><div><br></div><div>Best,</div><div>Jan</div><div class="gmail_extra"><br><div class="gmail_quote">2015-10-28 2:31 GMT+00:00 Chris Wong <span dir="ltr"><<a href="mailto:lambda.fairy@gmail.com" target="_blank">lambda.fairy@gmail.com</a>></span>:<br><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left-width:1px;border-left-color:rgb(204,204,204);border-left-style:solid;padding-left:1ex">Hi Jan,<br><br>Looks like the monomorphism restriction to me. This article [1] is a<br>great explanation of this quirk.<br><br>[1] <a href="http://lambda.jstolarek.com/2012/05/towards-understanding-haskells-monomorphism-restriction/" rel="noreferrer" target="_blank">http://lambda.jstolarek.com/2012/05/towards-understanding-haskells-monomorphism-restriction/</a><br><br>There are two solutions:<br><br>1. Add {-# LANGUAGE NoMonomorphismRestriction #-} to your code.<br><br>2. Give each binding explicit arguments:<br><br> process = ... -- as before<br> where<br> m >>= k = m E.>>= k<br> m >> n = m E.>> n<br> return x = E.return x<br><br> Since the monomorphism restriction doesn't apply to declarations<br>with arguments, this change should make the bindings polymorphic<br>again.<br><br>Hope this helps.<br><div><div class="h5"><br>On Wed, Oct 28, 2015 at 3:14 AM, Jan Bracker <<a href="mailto:jan.bracker@googlemail.com">jan.bracker@googlemail.com</a>> wrote:<br>> Hello,<br>><br>> I am currently playing around with RebindableSyntax and having several<br>> bind/return/sequence functions in scope at the same time. I thought that it<br>> would be enough to just pick the right one to use in each do-block by using<br>> a "where" or a "let".<br>> Surprisingly, I get some type related issues I can only fix by adding in<br>> some type signatures, but I don't understand why these signatures are<br>> actually necessary.<br>><br>> Here is my example program:<br>><br>> {-# LANGUAGE RebindableSyntax #-}<br>> {-# LANGUAGE DataKinds #-}<br>> {-# LANGUAGE TypeOperators #-}<br>><br>> import Prelude<br>> import qualified Prelude as P<br>> import qualified Control.Effect as E<br>> import Control.Effect.State<br>><br>> ifThenElse :: Bool -> a -> a -> a<br>> ifThenElse True t e = t<br>> ifThenElse False t e = e<br>><br>> main :: IO ()<br>> main = do<br>> return ()<br>> where<br>> return = P.return<br>><br>> data Tree = Leaf Int<br>> | Branch Tree Tree<br>><br>> process :: Tree -> State '[ "flatten" :-> Bool :! 'R ] (Either Tree [Int])<br>> process (Leaf i) = do<br>> flatten <- get (Var :: (Var "flatten"))<br>> if flatten<br>> then return $ Right [i]<br>> else return $ Left $ Leaf i<br>> where --(>>=) :: (E.Inv State f g) => State f a -> (a -> State g b) -><br>> State (E.Plus State f g) b<br>> (>>=) = (E.>>=)<br>> (>>) :: (E.Inv State f g) => State f a -> State g b -> State (E.Plus<br>> State f g) b<br>> (>>) = (E.>>)<br>> return = E.return<br>> fail = E.fail<br>> process (Branch tl tr) = do<br>> eitherL <- process tl<br>> eitherR <- process tr<br>> case (eitherL, eitherR) of<br>> (Left l, Left r) -> return $ Left $ Branch l r<br>> (Right l, Right r) -> return $ Right $ l ++ r<br>> where (>>=) :: (E.Inv State f g) => State f a -> (a -> State g b) -> State<br>> (E.Plus State f g) b<br>> (>>=) = (E.>>=)<br>> (>>) :: (E.Inv State f g) => State f a -> State g b -> State (E.Plus<br>> State f g) b<br>> (>>) = (E.>>)<br>> return = E.return<br>> fail = E.fail<br>><br>> The program uses the "effect-monad" package in version 0.6.1.<br>><br>> 1) The type signatures in the "where" following each do-block of the<br>> "process" function are required. If I remove the type signature of the<br>> sequence functions I get a type error of the following nature:<br>><br>> examples/effect/Test.hs:33:16:<br>> Could not deduce (E.Inv m0 f0 g0) arising from a use of ‘E.>>’<br>> Relevant bindings include<br>> (>>) :: m0 f0 a -> m0 g0 b -> m0 (E.Plus m0 f0 g0) b<br>> (bound at examples/effect/Test.hs:33:9)<br>> In the expression: (E.>>)<br>> In an equation for ‘>>’: (>>) = (E.>>)<br>> In an equation for ‘process’:<br>> process (Leaf i)<br>> = do { flatten <- get (Var :: Var "flatten");<br>> if flatten then return $ Right [...] else return $ Left $<br>> Leaf i }<br>> where<br>> (>>=) = (E.>>=)<br>> (>>) = (E.>>)<br>> return = E.return<br>> fail = E.fail<br>><br>> examples/effect/Test.hs:33:16:<br>> No instance for (E.Effect m0) arising from a use of ‘E.>>’<br>> In the expression: (E.>>)<br>> In an equation for ‘>>’: (>>) = (E.>>)<br>> In an equation for ‘process’:<br>> process (Leaf i)<br>> = do { flatten <- get (Var :: Var "flatten");<br>> if flatten then return $ Right [...] else return $ Left $<br>> Leaf i }<br>> where<br>> (>>=) = (E.>>=)<br>> (>>) = (E.>>)<br>> return = E.return<br>> fail = E.fail<br>><br>> Which I interpret as the inability to infer the "E.Effect" and "E.Inv"<br>> constraints that are implied by the use of "E.>>". But why can't those<br>> constraints be inferred correctly? Shouldn't a definition like "(>>) =<br>> (E.>>)" just propagate the type signature and specialize it as needed?<br>><br>> 2) If I remove the type signature for the bind operation, I get the<br>> following type error:<br>><br>> examples/effect/Test.hs:38:3:<br>> Couldn't match type ‘'["flatten" :-> (Bool :! 'R)]’ with ‘'[]’<br>> Expected type: State<br>> '["flatten" :-> (Bool :! 'R)] (Either Tree [Int])<br>> -> (Either Tree [Int] -> State '[] (Either Tree [Int]))<br>> -> State '[] (Either Tree [Int])<br>> Actual type: State<br>> '["flatten" :-> (Bool :! 'R)] (Either Tree [Int])<br>> -> (Either Tree [Int] -> State '[] (Either Tree [Int]))<br>> -> State<br>> (E.Plus State '["flatten" :-> (Bool :! 'R)] '[])<br>> (Either Tree [Int])<br>> In a stmt of a 'do' block: eitherR <- process tr<br>> In the expression:<br>> do { eitherL <- process tl;<br>> eitherR <- process tr;<br>> case (eitherL, eitherR) of {<br>> (Left l, Left r) -> return $ Left $ Branch l r<br>> (Right l, Right r) -> return $ Right $ l ++ r } }<br>> In an equation for ‘process’:<br>> process (Branch tl tr)<br>> = do { eitherL <- process tl;<br>> eitherR <- process tr;<br>> case (eitherL, eitherR) of {<br>> (Left l, Left r) -> return $ Left $ Branch l r<br>> (Right l, Right r) -> return $ Right $ l ++ r } }<br>> where<br>> (>>=) = (E.>>=)<br>> (>>) ::<br>> (E.Inv State f g) =><br>> State f a -> State g b -> State (E.Plus State f g) b<br>> (>>) = (E.>>)<br>> return = E.return<br>><br>> Which tells me that GHC is expecting the wrong type, but inferring the<br>> correct type. Again I don't see why this wrong type is expected and the<br>> right type is ignored.<br>><br>> In either case, why does adding or removing the type signature for the local<br>> definitions make a difference at all? I suspect the issue has to do with the<br>> language extensions I enabled or the type-level computations that are done<br>> by the "effect-monad" package, but I cannot find a satisfying answer. Does<br>> anybody have a good explanation?<br>><br>> I am working with GHC 7.10.2.<br>><br>> Best,<br>> Jan<br>><br>><br></div></div>> _______________________________________________<br>> Haskell-Cafe mailing list<br>> <a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><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>><br><span class=""><font color="#888888"><br><br><br>--<br>Chris Wong (<a href="https://lambda.xyz/" rel="noreferrer" target="_blank">https://lambda.xyz</a>)<br><br>"I fear that Haskell is doomed to succeed."<br> -- Tony Hoare<br></font></span></blockquote><div><span class=""><font color="#888888"><br></font></span></div></div></div></div><div class="gmail_extra"><br><div class="gmail_quote">2015-10-28 2:31 GMT+00:00 Chris Wong <span dir="ltr"><<a href="mailto:lambda.fairy@gmail.com" target="_blank">lambda.fairy@gmail.com</a>></span>:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Hi Jan,<br>
<br>
Looks like the monomorphism restriction to me. This article [1] is a<br>
great explanation of this quirk.<br>
<br>
[1] <a href="http://lambda.jstolarek.com/2012/05/towards-understanding-haskells-monomorphism-restriction/" rel="noreferrer" target="_blank">http://lambda.jstolarek.com/2012/05/towards-understanding-haskells-monomorphism-restriction/</a><br>
<br>
There are two solutions:<br>
<br>
1. Add {-# LANGUAGE NoMonomorphismRestriction #-} to your code.<br>
<br>
2. Give each binding explicit arguments:<br>
<br>
process = ... -- as before<br>
where<br>
m >>= k = m E.>>= k<br>
m >> n = m E.>> n<br>
return x = E.return x<br>
<br>
Since the monomorphism restriction doesn't apply to declarations<br>
with arguments, this change should make the bindings polymorphic<br>
again.<br>
<br>
Hope this helps.<br>
<div><div class="h5"><br>
On Wed, Oct 28, 2015 at 3:14 AM, Jan Bracker <<a href="mailto:jan.bracker@googlemail.com">jan.bracker@googlemail.com</a>> wrote:<br>
> Hello,<br>
><br>
> I am currently playing around with RebindableSyntax and having several<br>
> bind/return/sequence functions in scope at the same time. I thought that it<br>
> would be enough to just pick the right one to use in each do-block by using<br>
> a "where" or a "let".<br>
> Surprisingly, I get some type related issues I can only fix by adding in<br>
> some type signatures, but I don't understand why these signatures are<br>
> actually necessary.<br>
><br>
> Here is my example program:<br>
><br>
> {-# LANGUAGE RebindableSyntax #-}<br>
> {-# LANGUAGE DataKinds #-}<br>
> {-# LANGUAGE TypeOperators #-}<br>
><br>
> import Prelude<br>
> import qualified Prelude as P<br>
> import qualified Control.Effect as E<br>
> import Control.Effect.State<br>
><br>
> ifThenElse :: Bool -> a -> a -> a<br>
> ifThenElse True t e = t<br>
> ifThenElse False t e = e<br>
><br>
> main :: IO ()<br>
> main = do<br>
> return ()<br>
> where<br>
> return = P.return<br>
><br>
> data Tree = Leaf Int<br>
> | Branch Tree Tree<br>
><br>
> process :: Tree -> State '[ "flatten" :-> Bool :! 'R ] (Either Tree [Int])<br>
> process (Leaf i) = do<br>
> flatten <- get (Var :: (Var "flatten"))<br>
> if flatten<br>
> then return $ Right [i]<br>
> else return $ Left $ Leaf i<br>
> where --(>>=) :: (E.Inv State f g) => State f a -> (a -> State g b) -><br>
> State (E.Plus State f g) b<br>
> (>>=) = (E.>>=)<br>
> (>>) :: (E.Inv State f g) => State f a -> State g b -> State (E.Plus<br>
> State f g) b<br>
> (>>) = (E.>>)<br>
> return = E.return<br>
> fail = E.fail<br>
> process (Branch tl tr) = do<br>
> eitherL <- process tl<br>
> eitherR <- process tr<br>
> case (eitherL, eitherR) of<br>
> (Left l, Left r) -> return $ Left $ Branch l r<br>
> (Right l, Right r) -> return $ Right $ l ++ r<br>
> where (>>=) :: (E.Inv State f g) => State f a -> (a -> State g b) -> State<br>
> (E.Plus State f g) b<br>
> (>>=) = (E.>>=)<br>
> (>>) :: (E.Inv State f g) => State f a -> State g b -> State (E.Plus<br>
> State f g) b<br>
> (>>) = (E.>>)<br>
> return = E.return<br>
> fail = E.fail<br>
><br>
> The program uses the "effect-monad" package in version 0.6.1.<br>
><br>
> 1) The type signatures in the "where" following each do-block of the<br>
> "process" function are required. If I remove the type signature of the<br>
> sequence functions I get a type error of the following nature:<br>
><br>
> examples/effect/Test.hs:33:16:<br>
> Could not deduce (E.Inv m0 f0 g0) arising from a use of ‘E.>>’<br>
> Relevant bindings include<br>
> (>>) :: m0 f0 a -> m0 g0 b -> m0 (E.Plus m0 f0 g0) b<br>
> (bound at examples/effect/Test.hs:33:9)<br>
> In the expression: (E.>>)<br>
> In an equation for ‘>>’: (>>) = (E.>>)<br>
> In an equation for ‘process’:<br>
> process (Leaf i)<br>
> = do { flatten <- get (Var :: Var "flatten");<br>
> if flatten then return $ Right [...] else return $ Left $<br>
> Leaf i }<br>
> where<br>
> (>>=) = (E.>>=)<br>
> (>>) = (E.>>)<br>
> return = E.return<br>
> fail = E.fail<br>
><br>
> examples/effect/Test.hs:33:16:<br>
> No instance for (E.Effect m0) arising from a use of ‘E.>>’<br>
> In the expression: (E.>>)<br>
> In an equation for ‘>>’: (>>) = (E.>>)<br>
> In an equation for ‘process’:<br>
> process (Leaf i)<br>
> = do { flatten <- get (Var :: Var "flatten");<br>
> if flatten then return $ Right [...] else return $ Left $<br>
> Leaf i }<br>
> where<br>
> (>>=) = (E.>>=)<br>
> (>>) = (E.>>)<br>
> return = E.return<br>
> fail = E.fail<br>
><br>
> Which I interpret as the inability to infer the "E.Effect" and "E.Inv"<br>
> constraints that are implied by the use of "E.>>". But why can't those<br>
> constraints be inferred correctly? Shouldn't a definition like "(>>) =<br>
> (E.>>)" just propagate the type signature and specialize it as needed?<br>
><br>
> 2) If I remove the type signature for the bind operation, I get the<br>
> following type error:<br>
><br>
> examples/effect/Test.hs:38:3:<br>
> Couldn't match type ‘'["flatten" :-> (Bool :! 'R)]’ with ‘'[]’<br>
> Expected type: State<br>
> '["flatten" :-> (Bool :! 'R)] (Either Tree [Int])<br>
> -> (Either Tree [Int] -> State '[] (Either Tree [Int]))<br>
> -> State '[] (Either Tree [Int])<br>
> Actual type: State<br>
> '["flatten" :-> (Bool :! 'R)] (Either Tree [Int])<br>
> -> (Either Tree [Int] -> State '[] (Either Tree [Int]))<br>
> -> State<br>
> (E.Plus State '["flatten" :-> (Bool :! 'R)] '[])<br>
> (Either Tree [Int])<br>
> In a stmt of a 'do' block: eitherR <- process tr<br>
> In the expression:<br>
> do { eitherL <- process tl;<br>
> eitherR <- process tr;<br>
> case (eitherL, eitherR) of {<br>
> (Left l, Left r) -> return $ Left $ Branch l r<br>
> (Right l, Right r) -> return $ Right $ l ++ r } }<br>
> In an equation for ‘process’:<br>
> process (Branch tl tr)<br>
> = do { eitherL <- process tl;<br>
> eitherR <- process tr;<br>
> case (eitherL, eitherR) of {<br>
> (Left l, Left r) -> return $ Left $ Branch l r<br>
> (Right l, Right r) -> return $ Right $ l ++ r } }<br>
> where<br>
> (>>=) = (E.>>=)<br>
> (>>) ::<br>
> (E.Inv State f g) =><br>
> State f a -> State g b -> State (E.Plus State f g) b<br>
> (>>) = (E.>>)<br>
> return = E.return<br>
><br>
> Which tells me that GHC is expecting the wrong type, but inferring the<br>
> correct type. Again I don't see why this wrong type is expected and the<br>
> right type is ignored.<br>
><br>
> In either case, why does adding or removing the type signature for the local<br>
> definitions make a difference at all? I suspect the issue has to do with the<br>
> language extensions I enabled or the type-level computations that are done<br>
> by the "effect-monad" package, but I cannot find a satisfying answer. Does<br>
> anybody have a good explanation?<br>
><br>
> I am working with GHC 7.10.2.<br>
><br>
> Best,<br>
> Jan<br>
><br>
><br>
</div></div>> _______________________________________________<br>
> Haskell-Cafe mailing list<br>
> <a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><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>
><br>
<span class="HOEnZb"><font color="#888888"><br>
<br>
<br>
--<br>
Chris Wong (<a href="https://lambda.xyz" rel="noreferrer" target="_blank">https://lambda.xyz</a>)<br>
<br>
"I fear that Haskell is doomed to succeed."<br>
-- Tony Hoare<br>
</font></span></blockquote></div><br></div>