[Haskell-cafe] Type error with Type families

MigMit miguelimo38 at yandex.ru
Sun Sep 16 13:44:18 CEST 2012


It shoudn't typecheck.

Suppose you have instances like

instance ReplaceOneOf Foo where
  type Item Foo = Baz
  element  = elementFoo

instance ReplaceOneOf Bar where
  type Item Bar = Baz
  element = elementBar

Now if you call replaceOneOf manyBazs foo1 foo2, Haskell should consult "element :: Baz -> [Baz] -> Baz" — but which one, elementBar or elementFoo?

The error message is a bit criptic, but what it really means is that Haskell sees the possibility of such confusion and has to resort to the general "element" function of type Item something -> [Item something] -> Item something, and then fails to unify this "Item something" with "Item full". It correctly notes that the type function "Item" is not injective, which means that "Item Foo ~ Item Bar" is possible even if "Foo ~ Bar".

For the solution. I assume that the standard "elementOf" function doesn't suit you. If so, you can make your Items instances of another class:

class Element item where element :: item -> [item] -> Bool

and change ReplaceOneOf declaration to

class (LL.ListLike full (Item full), Element (Item full)) => ReplaceOneOf full where
...

On Sep 16, 2012, at 3:05 PM, 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




More information about the Haskell-Cafe mailing list