The problem is that the function 'element' is ambiguous, for the reasons MigMit pointed out.

The standard solution to this problem is to add a dummy argument to fix the type argument to the type function:

data Proxy a = Proxy

class ... => ReplaceOneOf full where
    type Item full ::  *

    -- implementations can just ignore the first argument
    element :: Proxy full -> Item full -> [Item full] -> Bool

    replaceOneOf :: ...
        ...
        | element (Proxy :: Proxy full) x from = ...

Now the choice of which 'element' to use can be determined by the type of the proxy.

  -- ryan

On Sun, Sep 16, 2012 at 4:05 AM, Marco Túlio Pimenta Gontijo <marcotmarcot@gmail.com> wrote:
Hi.

I cannot make this program type check:

    {-# LANGUAGE TypeFamilies, FlexibleContexts #-}
    import qualified Data.ListLike as LL

    class LL.ListLike full (Item full) => ReplaceOneOf full where
      type Item full :: *
      replaceOneOf :: [Item full] -> full -> full -> full
      replaceOneOf from to list
        | LL.null list = list
        | x `element` from
          = LL.concat [to, replaceOneOf from to $ LL.dropWhile
(`element` from) xs]
        | otherwise = LL.cons x $ replaceOneOf from to xs
        where
          x = LL.head list
          xs = LL.tail list
      element :: Item full -> [Item full] -> Bool

The error message is:

    Line 9: 1 error(s), 0 warning(s)

    Could not deduce (Item full0 ~ Item full)
    from the context (ReplaceOneOf full)
      bound by the class declaration for `ReplaceOneOf'
      at /home/marcot/tmp/test_flymake.hs:(4,1)-(15,45)
    NB: `Item' is a type function, and may not be injective
    Expected type: [Item full0]
      Actual type: [Item full]
    In the second argument of `element', namely `from'
    In the expression: x `element` from

I have tried using asTypeOf, but it did not work:

    {-# LANGUAGE TypeFamilies, FlexibleContexts, ScopedTypeVariables #-}
    import qualified Data.ListLike as LL

    class LL.ListLike full (Item full) => ReplaceOneOf full where
      type Item full :: *
      replaceOneOf :: Item full -> [Item full] -> full -> full -> full
      replaceOneOf xt from to list
        | LL.null list = list
        | (x `asTypeOf` xt) `element` from
          = LL.concat [to, replaceOneOf xt from to $ LL.dropWhile
(`element` from) xs]
        | otherwise = LL.cons x $ replaceOneOf xt from to xs
        where
          x = LL.head list
          xs = LL.tail list
      element :: Item full -> [Item full] -> Bool

Can someone point me to a solution?

Greetings.

--
marcot
http://marcot.eti.br/

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe