[Haskell-cafe] object oriented technique
Yves Parès
limestrael at gmail.com
Tue Mar 29 14:09:58 CEST 2011
Actually, Tako:
data Shape = forall a. Drawable a => Shape a
Can also be done with GADTs:
data Shape where
Shape :: Drawable a => a -> Shape
If wouldn't know if one approach is preferable to the other or if is just a
matter of taste.
Your problem, Tad, is kind of common. I ran against it several times. I know
of two ways to solve it :
- "The open way" (this is your method, with a class ShapeC and datatype
ShapeD which wraps instances of ShapeC)
- "The closed way", which can be broken in two alternatives:
* Using a plain Haskell98 ADT:
data Shape = Circle .... | Rectangle ....
draw :: Shape -> String
draw (Circle ...) = ...
draw (Rectangle ...) = ...
Flexible and simple, but not safe, since you have no way to
type-diferenciate Circles from Rectangles.
* Using a GADT and empty data declarations:
data Circle
data Rectangle
data Shape a where
Circle :: Double -> Double -> Double -> Shape Circle
Rectangle :: Double -> Double -> Double -> Double -> Shape Rectangle
And then you can both use "Shape a" or "Shape Circle/Shape Rectangle", which
enables you either to make lists of Shapes or to specifically use Circles or
Rectangles.
The drawback of it is that since you have a closed type (the GADT Shape),
you cannot add a new shape without altering it.
2011/3/29 Steffen Schuldenzucker <sschuldenzucker at uni-bonn.de>
>
> Tad,
>
> It doesn't look bad, but depending on what you want to do with the
> [ShapeD] aftewards you might not need this level of generality.
>
> Remember that the content of a ShapeD has type (forall a. ShapeC a =>
> a), so all you can do with it is call class methods from ShapeC. So if
> all you do is construct some ShapeD and pass that around, the following
> solution is equivalent:
>
> data Shape = Shape {
> draw :: String
> copyTo :: Double -> Double -> Shape
> -- ^ We loose some information here. The original method of ShapeC
> -- stated that copyTo of a Rectangle will be a rectangle again
> -- etc. Feel free to add a proxy type parameter to Shape if this
> -- information is necessary.
> }
>
> circle :: Double -> Double -> Double -> Shape
> circle x y r = Shape dc $ \x y -> circle x y r
> where dc = "Circ (" ++ show x ++ ", " ++ show y ++ ") -- "" ++ show r
>
> rectangle :: Double -> Double -> Double -> Double -> Shape
> rectangle x y w h = ... (analogous)
>
> shapes = [rectangle 1 2 3 4, circle 4 3 2, circle 1 1 1]
>
> -- Steffen
>
>
> On 03/29/2011 07:49 AM, Tad Doxsee wrote:
>
>> I've been trying to learn Haskell for a while now, and recently
>> wanted to do something that's very common in the object oriented
>> world, subtype polymorphism with a heterogeneous collection. It took
>> me a while, but I found a solution that meets my needs. It's a
>> combination of solutions that I saw on the web, but I've never seen
>> it presented in a way that combines both in a short note. (I'm sure
>> it's out there somewhere, but it's off the beaten path that I've been
>> struggling along.) The related solutions are
>>
>> 1. section 3.6 of http://homepages.cwi.nl/~ralf/OOHaskell/paper.pdf
>>
>> 2. The GADT comment at the end of section 4 of
>> http://www.haskell.org/haskellwiki/Heterogenous_collections
>>
>> I'm looking for comments on the practicality of the solution, and
>> references to better explanations of, extensions to, or simpler
>> alternatives for what I'm trying to achieve.
>>
>> Using the standard example, here's the code:
>>
>>
>> data Rectangle = Rectangle { rx, ry, rw, rh :: Double } deriving (Eq,
>> Show)
>>
>> drawRect :: Rectangle -> String drawRect r = "Rect (" ++ show (rx r)
>> ++ ", " ++ show (ry r) ++ ") -- " ++ show (rw r) ++ " x " ++ show
>> (rh r)
>>
>>
>> data Circle = Circle {cx, cy, cr :: Double} deriving (Eq, Show)
>>
>> drawCirc :: Circle -> String drawCirc c = "Circ (" ++ show (cx c) ++
>> ", " ++ show (cy c)++ ") -- " ++ show (cr c)
>>
>> r1 = Rectangle 0 0 3 2 r2 = Rectangle 1 1 4 5 c1 = Circle 0 0 5 c2 =
>> Circle 2 0 7
>>
>>
>> rs = [r1, r2] cs = [c1, c2]
>>
>> rDrawing = map drawRect rs cDrawing = map drawCirc cs
>>
>> -- shapes = rs ++ cs
>>
>> Of course, the last line won't compile because the standard Haskell
>> list may contain only homogeneous types. What I wanted to do is
>> create a list of circles and rectangles, put them in a list, and draw
>> them. It was easy for me to find on the web and in books how to do
>> that if I controlled all of the code. What wasn't immediately obvious
>> to me was how to do that in a library that could be extended by
>> others. The references noted previously suggest this solution:
>>
>>
>> class ShapeC s where draw :: s -> String copyTo :: s -> Double ->
>> Double -> s
>>
>> -- needs {-# LANGUAGE GADTs #-} data ShapeD where ShapeD :: ShapeC s
>> => s -> ShapeD
>>
>> instance ShapeC ShapeD where draw (ShapeD s) = draw s copyTo (ShapeD
>> s) x y = ShapeD (copyTo s x y)
>>
>> mkShape :: ShapeC s => s -> ShapeD mkShape s = ShapeD s
>>
>>
>>
>> instance ShapeC Rectangle where draw = drawRect copyTo (Rectangle _ _
>> rw rh) x y = Rectangle x y rw rh
>>
>> instance ShapeC Circle where draw = drawCirc copyTo (Circle _ _ r) x
>> y = Circle x y r
>>
>>
>> r1s = ShapeD r1 r2s = ShapeD r2 c1s = ShapeD c1 c2s = ShapeD c2
>>
>> shapes1 = [r1s, r2s, c1s, c2s] drawing1 = map draw shapes1
>>
>> shapes2 = map mkShape rs ++ map mkShape cs drawing2 = map draw
>> shapes2
>>
>> -- copy the shapes to the origin then draw them shapes3 = map (\s ->
>> copyTo s 0 0) shapes2 drawing3 = map draw shapes3
>>
>>
>> Another user could create a list of shapes that included triangles by
>> creating a ShapeC instance for his triangle and using mkShape to add
>> it to a list of ShapeDs.
>>
>> 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.)
>>
>> - Tad
>>
>> _______________________________________________ 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
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20110329/883dac70/attachment.htm>
More information about the Haskell-Cafe
mailing list