[Haskell-cafe] Deepest functor [was: fmap for lists of lists of lists of ...]

[oleg at pobox.com]

Greg Buchholz wrote:
>     Is it possible to make a typeclass like Functor, that has a function
> (say "f_map"), which would work for the infinite hierarchy of types:
> ([],[[]],[[[]]],...)? 

You do understand that this requires overlapping instances? Because
the type [[Bool]] is still a list. In general, an instance that
matches on the type [[a]] will also match [[[a]]], etc. That's where
the IsFunction-like trick comes in handy. Please note that the
overlapping instances are only needed for the implementation of the
IsCollection predicate. The typeclass for the deep Funct needs no
overlapping instances.

The code below is more general that required. It also generic: it
works for any Functor and any combination of Functors.  It performs
fmap over arbitrarily deep `collections': lists of maybes of maps of
IOs, etc. -- arbitrarily nested fmappable things.

test3 = f_map not (Just [Just True, Nothing])
test4 = f_map not (print "here" >> 
		   return (Just (Just [Just [True], Nothing]))) 
	>>= print


> {-# OPTIONS -fglasgow-exts #-}
> {-# OPTIONS -fallow-undecidable-instances #-}
> {-# OPTIONS -fallow-overlapping-instances #-}
>
> module FMAP where
>
> data Atom
>
> -- Check if a type is a collection type. This is the only typeclass that
> -- needs overlapping instances
> class IsCollection  t coll | t -> coll
> instance IsCollection (m a)       (m ())
> instance TypeCast Atom coll => IsCollection t coll
>
> -- our common working horse
> class TypeCast   a b   | a -> b, b->a   where typeCast   :: a -> b
> class TypeCast'  t a b | t a -> b, t b -> a where typeCast'  :: t->a->b
> class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b
> instance TypeCast'  () a b => TypeCast a b where typeCast x = typeCast' () x
> instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
> instance TypeCast'' () a a where typeCast'' _ x  = x
>
> -- The desired deep functor. Needs no overlapping instances
> class Funct a b c1 c2 | c1 -> a, c1 b -> c2 where
>     f_map :: (a -> b) -> c1 -> c2
>
> instance (IsCollection c1 coll, Funct' coll a b c1 c2) 
>     => Funct a b c1 c2 where
>     f_map = f_map' (undefined::coll)
>
> class Funct' coll a b c1 c2 | coll c1 -> a, coll c1 b -> c2 where
>     f_map' :: coll -> (a -> b) -> c1 -> c2
>
> instance Funct' Atom a b a b where
>     f_map' _ = id
>
> instance (Functor m, Funct a b c d) => Funct' (m ()) a b (m c) (m d) where
>     f_map' _ = fmap . f_map
>
>
> test1 = f_map (+1) [[[1::Int,2,3]]]
> test2 = f_map not [[True], [False]]
> test3 = f_map not (Just [Just True, Nothing])
> test4 = f_map not (print "here" >> 
>                    return (Just (Just [Just [True], Nothing]))) 
>         >>= print