Re: [Haskell-cafe] object oriented technique

Greg,
Thanks for your help. Is there any significant difference between
using existential quantification
data ShapeD = forall s. ShapeC => ShapeD s
versus a GADT
data ShapeD where
ShapeD :: ShapeC s => s -> ShapeD
I'm not sure I understood what you meant by "You don't need to write
more typeclass instances this way."
Thanks for pointing out the Control.Exception library. It was very
helpful. Earlier, I was trying to figure out
how to use Data.Dynamic for down-casting and couldn't get what I
wanted. The Data.Typeable usage in Control.Exception is what I was
looking for.
Tad
On Tue, Mar 29, 2011 at 12:57 AM, Gregory Collins
On Tue, Mar 29, 2011 at 7:49 AM, Tad Doxsee
wrote: class ShapeC s where draw :: s -> String copyTo :: s -> Double -> Double -> s
-- needs {-# LANGUAGE GADTs #-} data ShapeD where ShapeD :: ShapeC s => s -> ShapeD
Is the above the standard method in Haskell for creating an extensible heterogeneous list of "objects" that share a common interface? Are there better approaches? (I ran into a possible limitation to this approach that I plan to ask about later if I can't figure it out myself.)
The usual way to do this is:
{-# LANGUAGE ExistentialQuantification #-} data SomeShape = forall s . ShapeClass s => SomeShape s
You don't need to write more typeclass instances this way. If you give "SomeShape" a "ShapeClass" instance also, you can treat them uniformly. The downside to these approaches is that any additional information about the original concrete type is obliterated -- to get OO-style downcasting you need "Typeable" support, and it isn't free.
For an example of code which uses this idiom, see the exceptions support from the base library: http://www.haskell.org/ghc/docs/latest/html/libraries/base/Control-Exception...
G -- Gregory Collins

On Wed, Mar 30, 2011 at 6:52 AM, Tad Doxsee
Greg,
Thanks for your help. Is there any significant difference between using existential quantification
data ShapeD = forall s. ShapeC => ShapeD s
versus a GADT
data ShapeD where ShapeD :: ShapeC s => s -> ShapeD
The difference is purely syntactical. Use whichever you like better. (There may be portability ramifications. I'm not sure if other compilers implement ExistentialQuantification and/or GADTs.)
I'm not sure I understood what you meant by "You don't need to write more typeclass instances this way."
Thanks for pointing out the Control.Exception library. It was very helpful. Earlier, I was trying to figure out how to use Data.Dynamic for down-casting and couldn't get what I wanted. The Data.Typeable usage in Control.Exception is what I was looking for.
Tad
On Tue, Mar 29, 2011 at 12:57 AM, Gregory Collins
wrote: On Tue, Mar 29, 2011 at 7:49 AM, Tad Doxsee
wrote: class ShapeC s where draw :: s -> String copyTo :: s -> Double -> Double -> s
-- needs {-# LANGUAGE GADTs #-} data ShapeD where ShapeD :: ShapeC s => s -> ShapeD
Is the above the standard method in Haskell for creating an extensible heterogeneous list of "objects" that share a common interface? Are there better approaches? (I ran into a possible limitation to this approach that I plan to ask about later if I can't figure it out myself.)
The usual way to do this is:
{-# LANGUAGE ExistentialQuantification #-} data SomeShape = forall s . ShapeClass s => SomeShape s
You don't need to write more typeclass instances this way. If you give "SomeShape" a "ShapeClass" instance also, you can treat them uniformly. The downside to these approaches is that any additional information about the original concrete type is obliterated -- to get OO-style downcasting you need "Typeable" support, and it isn't free.
For an example of code which uses this idiom, see the exceptions support from the base library: http://www.haskell.org/ghc/docs/latest/html/libraries/base/Control-Exception...
G -- Gregory Collins
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Work is punishment for failing to procrastinate effectively.

On Wed, Mar 30, 2011 at 6:52 AM, Tad Doxsee
Greg,
Thanks for your help. Is there any significant difference between using existential quantification
data ShapeD = forall s. ShapeC => ShapeD s
versus a GADT
data ShapeD where ShapeD :: ShapeC s => s -> ShapeD
I'm not sure I understood what you meant by "You don't need to write more typeclass instances this way."
Sorry, I misspoke -- they're equivalent. Personally I find the
existential easier to read.
G
--
Gregory Collins
participants (3)
-
Gregory Collins
-
Gábor Lehel
-
Tad Doxsee