This works if you enable NoMonomorphismRestriction.

Cheers,
Adam


On Thu, 22 Feb 2018 at 23:41 Tom Ellis <tom-lists-haskell-cafe-2013@jaguarpaw.co.uk> wrote:
I'm puzzled by GHC's behaviour in the following program.

'baz = bar . foo' does not work because there is "no instance for ...".  But
if I manually assume those instances in the context all is fine.  Why can
GHC not infer that context?  Is there any extension or clever trick I can
use to get this to infer like I want?

Thanks,

Tom



{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

class Foo a b
class Bar a b
type family Quux a

foo :: ( Foo a b
       , b ~ Quux a )
    => a
    -> Quux a
foo = undefined

bar :: Bar a b
    => a
    -> b
bar = undefined

-- Doesn't work
-- No instance for (Bar (Quux a0) c0) arising from a use of ‘bar’
-- No instance for (Foo a0 (Quux a0)) arising from a use of ‘foo’
--baz = bar . foo

baz' :: ( Foo a (Quux a)
        , Bar (Quux a) b )
     => a
     -> b
baz' = bar . foo
_______________________________________________
Haskell-Cafe mailing list
To (un)subscribe, modify options or view archives go to:
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
Only members subscribed via the mailman list are allowed to post.