<html>
  <head>
    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
  </head>
  <body text="#000000" bgcolor="#FFFFFF">
    <p>Hi,</p>
    <p>It looks like an effect of ExtendedDefaultRules:
<a class="moz-txt-link-freetext" href="https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html#extension-ExtendedDefaultRules">https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html#extension-ExtendedDefaultRules</a></p>
    <p>It's hard to tell without the code but maybe something like that
      will do:</p>
    <p><tt>{-# LANGUAGE ScopedTypeVariables #-}</tt><tt><br>
      </tt><tt>{-# LANGUAGE TypeApplications #-}</tt><tt><br>
      </tt><tt><br>
      </tt><tt>add :: forall a b1 b2 b3. (Num a, Newtype a b1, Newtype a
        b2, Newtype a b3) => b2 -> b3 -> b1</tt><tt><br>
      </tt><tt>add x y = wrap @a @b1 $ unwrap @a x + unwrap @a y</tt><tt><br>
      </tt><br>
    </p>
    <p>-Sylvain<br>
    </p>
    <div class="moz-cite-prefix">On 10/04/2019 12:32, Michel Haber
      wrote:<br>
    </div>
    <blockquote type="cite"
cite="mid:CAEYibMcHaX6f+rx675GxcQgajoK5-+vA30K88_syA9j2rBitZA@mail.gmail.com">
      <meta http-equiv="content-type" content="text/html; charset=UTF-8">
      <div dir="ltr">
        <div dir="ltr">
          <div dir="ltr">
            <div dir="ltr">
              <div>Hello Cafe,</div>
              <div><br>
              </div>
              <div>I was trying to load a module containing this
                function in ghci:<br>
                "add x y = wrap $ unwrap x + unwrap y"<br>
              </div>
              <div>with the following extensions activated:</div>
              <div><br>
              </div>
              <div>ConstraintKinds<br>
                DataKinds<br>
                DeriveFunctor<br>
                DuplicateRecordFields<br>
                FlexibleContexts<br>
                FlexibleInstances<br>
                GADTs<br>
                KindSignatures<br>
                MultiParamTypeClasses<br>
                PolyKinds<br>
                TypeFamilies<br>
                TypeOperators<br>
                AllowAmbiguousTypes<br>
              </div>
              <div><br>
              </div>
              <div>And it loaded without problem.</div>
              <div><br>
              </div>
              <div>So then I tested its type with ":t add", which gave:</div>
              <div>add :: (Num a, Newtype a b1, Newtype a b2, Newtype a
                b3) => b2 -> b3 -> b1</div>
              <div><br>
              </div>
              <div>Then I added this signature to the function in the
                module. This caused ghci</div>
              <div>to refuse to load it and give the following error:</div>
              <div><br>
              </div>
              <div>src/Exercises.hs:55:11: error:<br>
                    • Could not deduce (Newtype Integer b1)<br>
                        arising from a use of ‘wrap’<br>
                      from the context: (Num a, Newtype a b1, Newtype a
                b2, Newtype a b3)<br>
                        bound by the type signature for:<br>
                                   add :: forall a b1 b2 b3.<br>
                                          (Num a, Newtype a b1, Newtype
                a b2, Newtype a b3) =><br>
                                          b2 -> b3 -> b1<br>
                        at src/Exercises.hs:54:1-74<br>
                    • In the expression: wrap $ unwrap x + unwrap y<br>
                      In an equation for ‘add’: add x y = wrap $ unwrap
                x + unwrap y<br>
                   |<br>
                55 | add x y = wrap $ unwrap x + unwrap y<br>
                   |           ^^^^^^^^^^^^^^^^^^^^^^^^^^<br>
                <br>
                src/Exercises.hs:55:18: error:<br>
                    • Could not deduce (Newtype Integer b2)<br>
                        arising from a use of ‘unwrap’<br>
                      from the context: (Num a, Newtype a b1, Newtype a
                b2, Newtype a b3)<br>
                        bound by the type signature for:<br>
                                   add :: forall a b1 b2 b3.<br>
                                          (Num a, Newtype a b1, Newtype
                a b2, Newtype a b3) =><br>
                                          b2 -> b3 -> b1<br>
                        at src/Exercises.hs:54:1-74<br>
                    • In the first argument of ‘(+)’, namely ‘unwrap x’<br>
                      In the second argument of ‘($)’, namely ‘unwrap x
                + unwrap y’<br>
                      In the expression: wrap $ unwrap x + unwrap y<br>
                   |<br>
                55 | add x y = wrap $ unwrap x + unwrap y<br>
                   |                  ^^^^^^^^<br>
                <br>
                src/Exercises.hs:55:29: error:<br>
                    • Could not deduce (Newtype Integer b3)<br>
                        arising from a use of ‘unwrap’<br>
                      from the context: (Num a, Newtype a b1, Newtype a
                b2, Newtype a b3)<br>
                        bound by the type signature for:<br>
                                   add :: forall a b1 b2 b3.<br>
                                          (Num a, Newtype a b1, Newtype
                a b2, Newtype a b3) =><br>
                                          b2 -> b3 -> b1<br>
                        at src/Exercises.hs:54:1-74<br>
                    • In the second argument of ‘(+)’, namely ‘unwrap y’<br>
                      In the second argument of ‘($)’, namely ‘unwrap x
                + unwrap y’<br>
                      In the expression: wrap $ unwrap x + unwrap y<br>
                   |<br>
                55 | add x y = wrap $ unwrap x + unwrap y<br>
                   |                             ^^^^^^^^<br>
                Failed, no modules loaded.</div>
              <div><br>
              </div>
              <div>This does not make sense to me, since I only used the
                signature that ghci itself gave me.</div>
              <div><br>
              </div>
              <div>Is this a bug? if not, could someone please explain
                this behaviour to me?</div>
              <div><br>
              </div>
              Thanks,
              <div>Michel<br>
              </div>
            </div>
          </div>
        </div>
      </div>
      <br>
      <fieldset class="mimeAttachmentHeader"></fieldset>
      <pre class="moz-quote-pre" wrap="">_______________________________________________
Haskell-Cafe mailing list
To (un)subscribe, modify options or view archives go to:
<a class="moz-txt-link-freetext" href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a>
Only members subscribed via the mailman list are allowed to post.</pre>
    </blockquote>
  </body>
</html>