[Haskell-cafe] MPTCs and extended defaulting

Tom Murphy amindfv at gmail.com
Mon Aug 29 20:23:34 UTC 2016


I've got a case in a library I'm working on where having
-XExtendedDefaultRules with MPTCs would be very, very helpful. Is it
possible?

I.e., we can now write:

```
{-# LANGUAGE ExtendedDefaultRules #-}

data AB = A | B Double deriving (Show)

class Foo x where
   foo :: x -> AB

instance Foo Double where
   foo = B

main = print $ foo 5
```

And -XExtendedDefaultRules makes sure we don't need to write "5 :: Double"


If, though, I want 'Foo' to take another parameter (here, a :: [Symbol]),
it falls apart:

```
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import GHC.TypeLits

data AB = A | B Double deriving (Show)

class Foo x (a :: [Symbol]) where
   foo :: x -> AB

instance Foo Double a where
   foo = B

main = print $ foo 5
```

Is there a reason MPTCs can't support ExtendedDefaultRules?

Thanks!
Tom
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20160829/2fbbcac7/attachment.html>


More information about the Haskell-Cafe mailing list