The problem is that the function &#39;element&#39; is ambiguous, for the reasons MigMit pointed out.<br><br>The standard solution to this problem is to add a dummy argument to fix the type argument to the type function:<br>
<br>data Proxy a = Proxy<br><br>class ... =&gt; ReplaceOneOf full where<br>    type Item full ::  *<br><br>    -- implementations can just ignore the first argument<br>    element :: Proxy full -&gt; Item full -&gt; [Item full] -&gt; Bool<br>
<br>    replaceOneOf :: ...<br>        ...<br>        | element (Proxy :: Proxy full) x from = ...<br><br>Now the choice of which &#39;element&#39; to use can be determined by the type of the proxy.<br><br>  -- ryan<br><br>
<div class="gmail_quote">On Sun, Sep 16, 2012 at 4:05 AM, Marco Túlio Pimenta Gontijo <span dir="ltr">&lt;<a href="mailto:marcotmarcot@gmail.com" target="_blank">marcotmarcot@gmail.com</a>&gt;</span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
Hi.<br>
<br>
I cannot make this program type check:<br>
<br>
    {-# LANGUAGE TypeFamilies, FlexibleContexts #-}<br>
    import qualified Data.ListLike as LL<br>
<br>
    class LL.ListLike full (Item full) =&gt; ReplaceOneOf full where<br>
      type Item full :: *<br>
      replaceOneOf :: [Item full] -&gt; full -&gt; full -&gt; full<br>
      replaceOneOf from to list<br>
        | LL.null list = list<br>
        | x `element` from<br>
          = LL.concat [to, replaceOneOf from to $ LL.dropWhile<br>
(`element` from) xs]<br>
        | otherwise = LL.cons x $ replaceOneOf from to xs<br>
        where<br>
          x = LL.head list<br>
          xs = LL.tail list<br>
      element :: Item full -&gt; [Item full] -&gt; Bool<br>
<br>
The error message is:<br>
<br>
    Line 9: 1 error(s), 0 warning(s)<br>
<br>
    Could not deduce (Item full0 ~ Item full)<br>
    from the context (ReplaceOneOf full)<br>
      bound by the class declaration for `ReplaceOneOf&#39;<br>
      at /home/marcot/tmp/test_flymake.hs:(4,1)-(15,45)<br>
    NB: `Item&#39; is a type function, and may not be injective<br>
    Expected type: [Item full0]<br>
      Actual type: [Item full]<br>
    In the second argument of `element&#39;, namely `from&#39;<br>
    In the expression: x `element` from<br>
<br>
I have tried using asTypeOf, but it did not work:<br>
<br>
    {-# LANGUAGE TypeFamilies, FlexibleContexts, ScopedTypeVariables #-}<br>
    import qualified Data.ListLike as LL<br>
<br>
    class LL.ListLike full (Item full) =&gt; ReplaceOneOf full where<br>
      type Item full :: *<br>
      replaceOneOf :: Item full -&gt; [Item full] -&gt; full -&gt; full -&gt; full<br>
      replaceOneOf xt from to list<br>
        | LL.null list = list<br>
        | (x `asTypeOf` xt) `element` from<br>
          = LL.concat [to, replaceOneOf xt from to $ LL.dropWhile<br>
(`element` from) xs]<br>
        | otherwise = LL.cons x $ replaceOneOf xt from to xs<br>
        where<br>
          x = LL.head list<br>
          xs = LL.tail list<br>
      element :: Item full -&gt; [Item full] -&gt; Bool<br>
<br>
Can someone point me to a solution?<br>
<br>
Greetings.<br>
<span class="HOEnZb"><font color="#888888"><br>
--<br>
marcot<br>
<a href="http://marcot.eti.br/" target="_blank">http://marcot.eti.br/</a><br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
</font></span></blockquote></div><br>