[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