[Haskell-cafe] Client-extensible heterogeneous types
Gregory Collins
greg at gregorycollins.net
Thu Oct 14 03:46:01 EDT 2010
Jacek Generowicz <jacek.generowicz at cern.ch> writes:
> Could you explain this a bit more? heterogeneousProcessor was extremely boring:
> its only interesting feature was the dot between "datum" and "method()" Here
> it is again:
>
> def heterogeneousProcessor(data):
> return [datum.method() for datum in data]
Typically we use an existential type for this:
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
data A = A
data B = B
class HasFooMethod a where
foo :: a -> String
instance HasFooMethod A where
foo _ = "This is A's foo method"
instance HasFooMethod B where
foo _ = "This is B's foo method"
data SomeFoo = forall a . (HasFooMethod a) => SomeFoo a
printFoo :: SomeFoo -> IO ()
printFoo (SomeFoo x) = putStrLn $ foo x
----------------------------------------------------------------------
main :: IO ()
main = do
let foos = [SomeFoo A, SomeFoo B, SomeFoo A]
mapM_ printFoo foos
Running main:
*Main> main
This is A's foo method
This is B's foo method
This is A's foo method
There is more information about the different ways of doing this kind of
thing in Haskell in the OOHaskell paper:
http://homepages.cwi.nl/~ralf/OOHaskell/
Unfortunately, this model of programming is a little awkward in Haskell
which is why (for the most part) it isn't used as much as it could or
should be. N.B. that the Control.Exception module from the standard
library (from GHC 6.8 on at least) uses this technique to provide
extensible exceptions.
Hope this helps,
G.
--
Gregory Collins <greg at gregorycollins.net>
More information about the Haskell-Cafe
mailing list