[Haskell-cafe] Type error with Type families

Ryan Ingram ryani.spam at gmail.com
Mon Sep 17 19:59:39 CEST 2012


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 at 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 at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120917/b50edc09/attachment.htm>


More information about the Haskell-Cafe mailing list