
#14266: AllowAmbiguousTypes doesn't play well with default class methods -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:3 simonpj]:
If there was a good reason to want them, maybe we should think about it more.
I'm not chris-martin, but I do have an example of actual code he was trying to write that tickled this bug. This is what he wanted to write: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module MultiInstance where class MultiMonoid x a where multi'append :: a -> a -> a multi'empty :: a data Addition data Multiplication instance MultiMonoid Addition Int where multi'append = (+) multi'empty = 0 instance MultiMonoid Multiplication Int where multi'append = (*) multi'empty = 1 example1, example2 :: Int example1 = multi'append @Addition 2 3 -- 5 example2 = multi'append @Multiplication 2 3 -- 6 class MultiFoldable t where multi'foldMap :: forall x m a. (MultiMonoid x m) => (a -> m) -> t a -> m instance MultiFoldable [] where multi'foldMap :: forall x m a. (MultiMonoid x m) => (a -> m) -> [a] -> m multi'foldMap f = go where go :: [a] -> m go [] = multi'empty @x go (x:xs) = multi'append @x (f x) (go xs) example3, example4 :: Int example3 = multi'foldMap @[] @Addition id [1,2,3,4] -- 10 example4 = multi'foldMap @[] @Multiplication id [1,2,3,4] -- 24 }}} To explain what's going on here: `MultiMonoid` is a class where the first parameter determines what sort of `Monoid` you're working on over the second parameter, so `multi'append @Addition` uses `{(+), 0}` as the `Monoid`, and `multi'append @Multiplication` uses `{(*), 1}` as the `Monoid`. So far, nothing about this requires `AllowAmbiguousTypes`. Now we enter `MultiFoldable`. This class only has one parameter, but its method `multi'foldMap` has a given `MultiMonoid x m` constraint. Here, `x` is ambiguous, so this crucially relies on `AllowAmbiguousTypes` working. Some demonstrations of `multi'foldMap`'s use are found in `example3` and `example4`. This fails to compile: {{{ Bug.hs:32:22: error: • Could not deduce (MultiMonoid x0 m) from the context: MultiMonoid x m bound by the type signature for: multi'foldMap :: forall x m a. MultiMonoid x m => (a -> m) -> [a] -> m at Bug.hs:32:22-76 The type variable ‘x0’ is ambiguous • When checking that instance signature for ‘multi'foldMap’ is more general than its signature in the class Instance sig: forall x m a. MultiMonoid x m => (a -> m) -> [a] -> m Class sig: forall x m a. MultiMonoid x m => (a -> m) -> [a] -> m In the instance declaration for ‘MultiFoldable []’ | 32 | multi'foldMap :: forall x m a. (MultiMonoid x m) => (a -> m) -> [a] -> m | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14266#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler