[Haskell-cafe] automatically deriving Map and Filter on datatypes etc.

Miguel Mitrofanov miguelimo38 at yandex.ru
Thu Jun 5 04:49:06 EDT 2008


It can be even worse:

data X a b = X (X b a -> b)

Here (X a) is certainly a functor, but the implementation must also  
act on "a" contravariantly:

mapX :: (a -> a') -> X a' b -> X a b
mapX f (X h) = X $ h . fmap f
instance Functor (X a) where fmap f (X h) = X $ f . h . mapX f

On 5 Jun 2008, at 12:39, Thomas Davie wrote:

> Even deriving an instance of Functor seems rather implausable, what  
> should it do for
>
> data Wierd a b = Nil | A a (Wierd a b) | B b (Wierd a b)
>
> Should fmap's function argument operate on 'a's, 'b's, or both?
>
> Bob
>
> On 5 Jun 2008, at 10:28, Miguel Mitrofanov wrote:
>
>> Well, it's certainly not possible for "filter", at least, not  
>> without additional hints to the compiler. For example, consider  
>> this type:
>>
>> data Weird a = A | B a (Weird a) (Weird a)
>>
>> filter p A = A
>> filter p (B x w1 w2) | p x = B x (filter p w1) (filter p w2)
>>                    | otherwise = ?????
>>
>> On 5 Jun 2008, at 12:03, Cetin Sert wrote:
>>
>>> Hi ^_^,
>>>
>>> Let's say we have the following data type and functions:
>>> data Tab a =      (:↺:)
>>>
>>>          |     a :↓:   Tab a
>>>          | Tab a :↙↘: (Tab a,Tab a)
>>>          deriving (Eq, Show, Read)
>>>
>>> map f (:↺:)          = (:↺:)
>>> map f (a :↓: t)      = f a :↓: map f t
>>> map f (h :↙↘: (l,r)) = map f h :↙↘: (map f l, map f r)
>>>
>>>
>>> filter p (:↺:)          = (:↺:)
>>> filter p (a :↓: t)      | p a       = filter p t
>>>                       | otherwise = a :↓: filter p t
>>> filter p (h :↙↘: (l,r)) = filter p h :↙↘: (filter p l,  
>>> filter p r)
>>>
>>> is it possible to automatically derive map and filter?
>>> data Tab a =      (:↺:)
>>>          |     a :↓:   Tab a
>>>          | Tab a :↙↘: (Tab a,Tab a)
>>>          deriving (Eq, Show, Read, Map, Filter)
>>>
>>> If not, do you think it might be nice to have something like this  
>>> in the future?
>>>
>>> Best Regards,
>>> Cetin Sert
>>> _______________________________________________
>>> Haskell-Cafe mailing list
>>> Haskell-Cafe at haskell.org
>>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
> _______________________________________________
> 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