[Haskell-cafe] Type classes question
Roly Perera
roly.perera at dynamicaspects.org
Tue Oct 7 08:13:25 EDT 2008
Hi,
I'm reasonably well versed in Haskell but fairly new to defining type classes.
In particular I don't really understand how to arrange for all instances of X
to also be instances of Y.
It's quite possibly that my question is ill-posed, so I'll make it as concrete
as possible: in the following code, I define a Stream class, with two
instances, Stream1 and Stream2. How do I arrange for there to be one
implementation of Functor's fmap for all Stream instances? I currently rely on
delegation, but in the general case this isn't nice.
I guess I'm either misunderstanding what it is I'm trying to achieve, or how to
do this kind of thing in Haskell. Any help would be greatly appreciated.
many thanks,
Roly Perera
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,
ExistentialQuantification, FunctionalDependencies #-}
module Test where
-------------------------------------------------------------------------------
-- Just some helpers.
-------------------------------------------------------------------------------
-- Product map.
prod :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
f `prod` g = \(a, c) -> (f a, g c)
-- Diagonal.
diag :: a -> (a, a)
diag x = (x, x)
-- Mediating morphism into the product.
both :: (a -> b) -> (a -> c) -> a -> (b, c)
both f g = prod f g . diag
-------------------------------------------------------------------------------
-- "Abstract" stream.
-------------------------------------------------------------------------------
class Stream s a | s -> a where
first :: s -> a
next :: s -> s
fby :: a -> s -> s
-- I want every Stream to be a Functor.
fmap_ :: Stream s' b => (a -> b) -> s -> s'
fmap_ f = uncurry fby . both (f . first) (fmap_ f . next)
-------------------------------------------------------------------------------
-- Implementation 1.
-------------------------------------------------------------------------------
data Stream1 a = a :< Stream1 a
instance Functor Stream1 where
fmap = fmap_
instance Stream (Stream1 a) a where
first (x :< _) = x
next (_ :< xs) = xs
fby = (:<)
-------------------------------------------------------------------------------
-- Implementation 2.
-------------------------------------------------------------------------------
data Stream2 a = forall b . S b (b -> a) (b -> b)
instance Functor Stream2 where
fmap = fmap_
instance Stream (Stream2 a) a where
first (S x c _) = c x
next (S x c i) = S (i x) c i
fby y s = S (y, s) fst (uncurry (,) . both first next . snd)
More information about the Haskell-Cafe
mailing list