[Haskell-cafe] How to present the commonness of some objects?

Luke Palmer lrpalmer at gmail.com
Fri Jul 3 03:08:42 EDT 2009


On Thu, Jul 2, 2009 at 8:32 PM, Magicloud Magiclouds <
magicloud.magiclouds at gmail.com> wrote:

> Wow, this complex.... Thank you. I will try that.


No, don't!  There is an easier way.

Don't use a class, just use a record.

I would translate your class as:

data Widget = Widget {
    widgetRun :: IO ()
}

If you need more capabilities, add them as fields in this record.  There is
no need for typeclasses here.

Keep in mind that with this solution *and* with the
ExistentialQuantification solution, there is no possibility of downcasting.
 I.e. if you were planning on making a GraphicalWidget subclass, and them
somewhere seeing if a a Widget is actually a GraphicalWidget, you will be
disappointed.  The solution in this case is to redesign your software not to
need downcasting.  This is the point at which you are forced to move away
from OO thinking.

Luke


>
> On Fri, Jul 3, 2009 at 12:24 PM, Ross Mellgren<rmm-haskell at z.odi.ac>
> wrote:
> > You have a couple problems here.
> >
> > The first is that GHC has no idea what particular type 'w' widgetList
> has,
> > because the empty list is polymorphic.
> >
> > The second is that it looks like you probably want a heterogeneous list
> of
> > widgets -- that is, possibly different types of widget as long as they
> all
> > conform to Widget. To do this you'll need ExistentialQuantification (or
> > GADTs I guess?).
> >
> > For example:
> >
> > {-# LANGUAGE ExistentialQuantification #-}
> >
> > class Widget w where
> >    widgetRun :: w -> IO ()
> >
> > data SomeWidget = forall w. Widget w => SomeWidget w
> >
> > widgetList :: [(Integer, Integer, SomeWidget)]
> > widgetList = []
> >
> > main = mapM aux widgetList
> >    aux (x, y, sw) =
> >        case sw of
> >            SomeWidget w -> widgetRun w
> >
> > Note that the type variable for widgetList 'w' has disappeared. Before,
> with
> > the type variable 'w', all elements of the widgetList had to be of the
> same
> > type (lists being homogeneous). By wrapping up the type variable 'w'
> inside
> > SomeWidget, you can now have whatever types of widgets in that
> SomeWidget,
> > e.g.
> >
> > data Button = Button (IO ())
> > instance Widget Button where widgetRun = ...
> >
> > data Label = Label (String -> IO ())
> > instance Widget Label where widgetRun = ...
> >
> > widgetList:: [(Integer, Integer, SomeWidget)]
> > widgetList =
> >    [ SomeWidget (Button $ putStrLn "ding!")
> >    , SomeWidget (Label $ putStrLn . ("entered: " ++)) ]
> >
> > Before, without existential quantification, you had to have all the same
> > type of widget (e.g. all Button or all Label)
> >
> > Hope this makes it more clear.
> >
> > -Ross
> >
> > On Jul 3, 2009, at 12:00 AM, Magicloud Magiclouds wrote:
> >
> >> Hi,
> >>  I thought "class" was for this purpose. But it turns out not.
> >>  Code as following could not compiled.
> >>
> >> 1 main = do
> >> 2   mapM_ (\(x, y, widget) -> do
> >> 3            a <- widgetRun widget
> >> 4            putStrLn $ show a
> >> 5         ) widgetList
> >> 6
> >> 7 widgetList :: (Widget w) => [(Integer, Integer, w)]
> >> 8 widgetList = []
> >> 9
> >> 10 class Widget w where
> >> 11   widgetRun :: w -> IO ()
> >> ---
> >> % ghc --make tmp/test.hs
> >> [1 of 1] Compiling Main             ( tmp/test.hs, /tmp/Main.o )
> >>
> >> tmp/test.hs:3:16:
> >>   Ambiguous type variable `t' in the constraint:
> >>     `Widget t' arising from a use of `widgetRun' at tmp/test.hs:3:16-31
> >>   Probable fix: add a type signature that fixes these type variable(s)
> >> --
> >> 竹密岂妨流水过
> >> 山高哪阻野云飞
> >> _______________________________________________
> >> 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/20090703/4b6ebcdf/attachment.html


More information about the Haskell-Cafe mailing list