Impredicative types and Lens?

Here’s a small example, which, when compiled, gives an error. Why? {-# LANGUAGE FlexibleInstances, ImpredicativeTypes, TemplateHaskell #-} import Control.Lens class Item a where name :: a -> String instance Item (String, Int) where name = fst type ItemFilter = Item a => a -> Bool data ItemBox = ItemBox { _itemFilter :: ItemFilter } makeLenses ''ItemBox The error is Couldn't match type `a0 -> Bool' with `forall a. Item a => a -> Bool' Expected type: ItemFilter Actual type: a0 -> Bool In the expression: b_aaZE In the first argument of `iso', namely `\ (ItemBox b_aaZE) -> b_aaZE' In the expression: iso (\ (ItemBox b_aaZE) -> b_aaZE) ItemBox I’m using GHC 7.6.2, if it’s important.

You can't write that lens by hand, so it isn't surprising that the template
haskell can't generate it either. =)
ImpredicativeTypes don't work all that well.
-Edward
On Sun, Sep 8, 2013 at 9:49 AM, Artyom Kazak
Here’s a small example, which, when compiled, gives an error. Why?
{-# LANGUAGE FlexibleInstances, ImpredicativeTypes, TemplateHaskell #-}
import Control.Lens
class Item a where name :: a -> String
instance Item (String, Int) where name = fst
type ItemFilter = Item a => a -> Bool
data ItemBox = ItemBox { _itemFilter :: ItemFilter } makeLenses ''ItemBox
The error is
Couldn't match type `a0 -> Bool' with `forall a. Item a => a -> Bool' Expected type: ItemFilter Actual type: a0 -> Bool In the expression: b_aaZE In the first argument of `iso', namely `\ (ItemBox b_aaZE) -> b_aaZE' In the expression: iso (\ (ItemBox b_aaZE) -> b_aaZE) ItemBox
I’m using GHC 7.6.2, if it’s important.
______________________________**_________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/**mailman/listinfo/haskell-cafehttp://www.haskell.org/mailman/listinfo/haskell-cafe
participants (2)
-
Artyom Kazak
-
Edward Kmett