<div dir="ltr">With GHC 8.0.1 I get a type error:<br><br>error:<br>    • Could not deduce (Foo x a0)<br>      from the context: Foo x a<br>        bound by the type signature for:<br>                   foo :: Foo x a => x -> AB<br><br></div><div class="gmail_extra"><br><div class="gmail_quote">On Fri, Sep 23, 2016 at 8:56 AM, Christopher Allen <span dir="ltr"><<a href="mailto:cma@bitemyapp.com" target="_blank">cma@bitemyapp.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><span class="">{-# LANGUAGE DataKinds #-}<br>
{-# LANGUAGE ExtendedDefaultRules #-}<br>
</span>{-# LANGUAGE FlexibleInstances #-}<br>
<span class="">{-# LANGUAGE KindSignatures #-}<br>
{-# LANGUAGE MultiParamTypeClasses #-}<br>
</span>{-# LANGUAGE TypeFamilies #-}<br>
<span class=""><br>
import GHC.TypeLits<br>
<br>
data AB = A | B Double deriving (Show)<br>
<br>
class Foo x (a :: [Symbol]) where<br>
   foo :: x -> AB<br>
<br>
</span>instance (b ~ Double) => Foo b a where<br>
<span class="">   foo = B<br>
<br>
main = print $ foo 5<br>
<br>
</span><div><div class="h5">On Thu, Sep 22, 2016 at 6:39 PM, Tom Murphy <<a href="mailto:amindfv@gmail.com">amindfv@gmail.com</a>> wrote:<br>
> Bump -- is this feasible? It would be extremely helpful for an EDSL of mine.<br>
><br>
> Tom<br>
><br>
> On Tue, Aug 30, 2016 at 5:23 AM, Tom Murphy <<a href="mailto:amindfv@gmail.com">amindfv@gmail.com</a>> wrote:<br>
>><br>
>> I've got a case in a library I'm working on where having<br>
>> -XExtendedDefaultRules with MPTCs would be very, very helpful. Is it<br>
>> possible?<br>
>><br>
>> I.e., we can now write:<br>
>><br>
>> ```<br>
>> {-# LANGUAGE ExtendedDefaultRules #-}<br>
>><br>
>> data AB = A | B Double deriving (Show)<br>
>><br>
>> class Foo x where<br>
>>    foo :: x -> AB<br>
>><br>
>> instance Foo Double where<br>
>>    foo = B<br>
>><br>
>> main = print $ foo 5<br>
>> ```<br>
>><br>
>> And -XExtendedDefaultRules makes sure we don't need to write "5 :: Double"<br>
>><br>
>><br>
>> If, though, I want 'Foo' to take another parameter (here, a :: [Symbol]),<br>
>> it falls apart:<br>
>><br>
>> ```<br>
>> {-# LANGUAGE DataKinds #-}<br>
>> {-# LANGUAGE ExtendedDefaultRules #-}<br>
>> {-# LANGUAGE KindSignatures #-}<br>
>> {-# LANGUAGE MultiParamTypeClasses #-}<br>
>><br>
>> import GHC.TypeLits<br>
>><br>
>> data AB = A | B Double deriving (Show)<br>
>><br>
>> class Foo x (a :: [Symbol]) where<br>
>>    foo :: x -> AB<br>
>><br>
>> instance Foo Double a where<br>
>>    foo = B<br>
>><br>
>> main = print $ foo 5<br>
>> ```<br>
>><br>
>> Is there a reason MPTCs can't support ExtendedDefaultRules?<br>
>><br>
>> Thanks!<br>
>> Tom<br>
>><br>
>><br>
>><br>
>><br>
><br>
><br>
</div></div>> ______________________________<wbr>_________________<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-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
> Only members subscribed via the mailman list are allowed to post.<br>
<span class="HOEnZb"><font color="#888888"><br>
<br>
<br>
--<br>
Chris Allen<br>
Currently working on <a href="http://haskellbook.com" rel="noreferrer" target="_blank">http://haskellbook.com</a><br>
</font></span></blockquote></div><br></div>