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

Magicloud Magiclouds magicloud.magiclouds at gmail.com
Fri Jul 3 00:32:37 EDT 2009


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

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
>
>



-- 
竹密岂妨流水过
山高哪阻野云飞


More information about the Haskell-Cafe mailing list