[Haskell-beginners] containers and extensibility, typeclasses vs. multiple value constructors

Greg greglists at me.com
Tue Sep 7 05:39:37 EDT 2010


Ok, I got basic implementations of both methods to work, and what's interesting is how similar the syntax is.  I'm going to post it here for anyone who wants to comment, but also for anyone who stumbles upon this thread and wants to see where it leads.

Here's the relevant parts of the Existential Types implementation:

{-# LANGUAGE ExistentialQuantification #-}

data RenderContext = RenderContext {}

class Plottable a where
  renderPlot  :: a -> RenderContext -> IO ()

data PlotWrap = forall a. Plottable a => PlotWrap a

instance Plottable PlotWrap where
  renderPlot (PlotWrap a) = renderPlot a

data ScatterPlot = ScatterPlot {scatterPoints :: [(Double,Double)]
                               ,pointColor :: Color 
                               ,pointSize :: GL.GLfloat}

defScatterPlot = ScatterPlot {scatterPoints=[]
                             ,pointColor = red
                             ,pointSize = 1}

instance Plottable ScatterPlot where
  renderPlot plot@(ScatterPlot {}) context = do
    GL.color $ pointColor plot
    GL.pointSize $= pointSize plot
    GL.renderPrimitive GL.Points $ mapM_ GL.vertex (map pair2vertex $ scatterPoints plot)

Which I use by creating ScatterPlots (the noise functions aren't worth showing here, but they let me plot random data):

testScatter=defScatterPlot {scatterPoints=zip (map (*1) (take 2000 $ uniformNoise 0)) 
                                              (map (*1) (take 2000 $ uniformNoise 1))}

testScatter2=defScatterPlot {scatterPoints=zip (map (\x -> 5 + x ) (take 2000 $ gaussianNoise 0)) 
                                               (map (\x -> 5 + x ) (take 2000 $ gaussianNoise 1))}

and then calling this in the OpenGL display callback:

mapM_ (($ RenderContext) . renderPlot) [PlotWrap testScatter,PlotWrap testScatter2]

-----------------------------------------------------------------------------------------------------
Now here's the "thunked" version (perhaps I'm abusing the term?):

data RenderContext = RenderContext {}

data PlotThunk = PlotThunk {renderer :: RenderContext -> IO ()}

class Plottable a where
  renderPlot  :: a -> RenderContext -> IO ()
  createThunk :: a -> PlotThunk
  createThunk x = PlotThunk {renderer = renderPlot x}

instance Plottable PlotThunk where
  renderPlot p context=(renderer p) context
  createThunk x = x

data ScatterPlot = ScatterPlot {scatterPoints :: [(Double,Double)]
                               ,pointColor :: Color 
                               ,pointSize :: GL.GLfloat}

defScatterPlot = ScatterPlot {scatterPoints=[]
                             ,pointColor = red
                             ,pointSize = 1}

instance Plottable ScatterPlot where
  renderPlot plot@(ScatterPlot {}) context = do
    GL.color $ pointColor plot
    GL.pointSize $= pointSize plot
    GL.renderPrimitive GL.Points $ mapM_ GL.vertex (map pair2vertex $ scatterPoints plot)

I create the ScatterPlots in exactly the same way:

testScatter=defScatterPlot {scatterPoints=zip (map (*1) (take 2000 $ uniformNoise 0)) 
                                              (map (*1) (take 2000 $ uniformNoise 1))}

testScatter2=defScatterPlot {scatterPoints=zip (map (\x -> 5 + x ) (take 2000 $ gaussianNoise 0)) 
                                               (map (\x -> 5 + x ) (take 2000 $ gaussianNoise 1))}

and then use this to in the OpenGL callback:

mapM_ (($ RenderContext) . renderPlot) [createThunk testScatter,createThunk testScatter2]

------------------------------------------------------------

The principle differences I see so far (more may appear as I add more plot styles) are these:

Both versions require creating one additional data type and an added function call when creating the list (creating the thunk, or wrapping the data).  The existential type version requires the use of a language extension, but has less confusing syntax and looks like a value construction when forming that list.  The thunked version has a slightly more complex class definition, but the calling code is no more complex than the existential typed version.


Cheers--
 Greg





On Sep 6, 2010, at 11:44 PM, Greg Best wrote:

> Two great suggestions (attached below for context), thanks to Daniel and Stephen, both.
> 
> Since a large part of my goal here is to learn the language, I'll probably try both of these just to make sure I can.
> 
>> From a cultural standpoint, is there a preferred approach?  Existential Types sits more nicely with my OO background and is a more exact interpretation of what I was trying to do, but is that seen as "impure" under Haskell?  More generally, what should I keep in mind when using language extensions?  Are Existential Types supported across implementations?  Are they a likely candidate for adoption into the language proper?  Are there performance implications (such as future parallelization)?
> 
> Stephen's solution is obvious now that it's been presented.  I'm not planning on using GnuPlot, I'm mucking around with the OpenGL bindings, but the point is, I think, the same: don't make a list of of objects, make a list of functions.  In this case, they'd be more along the lines of ApplicationContext -> IO ().
> 
> I suppose I could also create a type that contains the disembodied methods from the various plot styles:
> 
> data PlotThunks = PlotThunks { render:: Context -> IO ()
>                                                       , hitTest:: Point -> Bool
>                                                       , extents:: Context -> Rect}
> 
> then functions (perhaps a typeclass method) that build values of that type from each of the various plot styles.
> 
> plotList :: [PlotThunks]
> 
> renderAll :: Context -> [PlotThunks] ->  IO ()
> renderAll context plots= mapM_ (($ context) . render) plots
> 
> 
> Thanks again--
> Greg
> 
> 
> 
> On Sep 6, 2010, at 6:14 AM, Daniel Fischer wrote:
> 
>> you can combine the approaches. As long as all you want to do with your 
>> container is rendering the contents, 
>> 
>> {-# LANGUAGE ExistentialQuantification #-}
>> 
>> class Plot a where
>>   render :: a -> IO ()
>>   describe :: a -> String
>> 
>> data SomePlot = forall p. Plot p => SomePlot p
>> 
>> instance Plot SomePlot where
>>   render (SomePlot p) = render p
>>   describe (SomePlot p) = describe p
>> 
>> gives you a class, so you can define new plot types without modifying the 
>> library, and a wrapper type, so you can stick plots of different types in 
>> the same container after wrapping them.
>> Once they're wrapped, you can't use anything but the methods of the Plot 
>> class on them, though, so if you want to do anything else with the 
>> container's contents, that won't work (you can do something with an 
>> additional Typeable constraint).
>> 
>> http://www.haskell.org/haskellwiki/Existential_type for more.
> 
> On Sep 6, 2010, at 7:57 AM, Stephen Tetley wrote:
> 
>> Supposing you are working with GnuPlot - one option is to make Plot a
>> functional type that takes a list of some polymorphic input data and
>> generates a 'GnuPlot' - where GnuPlot is a type representing output in
>> the GnuPlot format.
>> 
>> type Plot a = [a] -> GnuPlot
>> 
>> Or if GnuPlot accepts drawing styles...
>> 
>> type Plot a = [a] -> DrawingStyle -> GnuPlot
>> 
>> Plots are just functions, so clearly you can define as many as you
>> like and they are all the same type.
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/beginners/attachments/20100907/4dd71279/attachment-0001.html


More information about the Beginners mailing list