Re: [Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Olex P
Thanks for explanation Sean!

On Tue, Sep 15, 2009 at 4:30 PM, Sean Leather  wrote:

>
>
>> "Existential types" sounds a bit scary :)
>>
>>>
> It's unfortunate that they've developed a scariness feeling associated with
> them. They can be used in strange ways, but simple uses are quite
> approachable. One way to think of them is like implementing an
> object-oriented interface. You know it's an object, but you can't do
> anything with it except use the methods of the interface.
>
> ---
>
> {-# LANGUAGE ExistentialQuantification #-}
>
> data Square = Square ...
> data Circle = Circle ...
>
> class Perimeter a where perimeter :: a -> Double
> instance Perimeter Square where perimeter (Square ...) = ...
> instance Perimeter Circle where perimeter (Circle ...) = ...
>
> -- The 'a' is hidden here. The interface is defined by the class
> constraint.
> data Perimeterizable = forall a . (Perimeter a) => P a
>
> -- This is the accessor method for things Perimeterizable.
> getPerimeter (P x) = perimeter x
>
> vals :: [Perimeterizable]
> vals = [P Square, P Circle]
>
> perims = map getPerimeter vals
>
> ---
>
> Regards,
> Sean
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Sean Leather
> "Existential types" sounds a bit scary :)
>
>>
It's unfortunate that they've developed a scariness feeling associated with
them. They can be used in strange ways, but simple uses are quite
approachable. One way to think of them is like implementing an
object-oriented interface. You know it's an object, but you can't do
anything with it except use the methods of the interface.

---

{-# LANGUAGE ExistentialQuantification #-}

data Square = Square ...
data Circle = Circle ...

class Perimeter a where perimeter :: a -> Double
instance Perimeter Square where perimeter (Square ...) = ...
instance Perimeter Circle where perimeter (Circle ...) = ...

-- The 'a' is hidden here. The interface is defined by the class constraint.
data Perimeterizable = forall a . (Perimeter a) => P a

-- This is the accessor method for things Perimeterizable.
getPerimeter (P x) = perimeter x

vals :: [Perimeterizable]
vals = [P Square, P Circle]

perims = map getPerimeter vals

---

Regards,
Sean
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Olex P
It's hard to say what really is 2d or 3d. Think about closed 3d curve
(points placed in 3d space somehow). Is it 2d or 3d? Depends on the
interpretation.
Usually DCC packages don't care about this. And I wouldn't too :p Who needs
extra level of complexity without any reason?

On Tue, Sep 15, 2009 at 3:48 PM, Tom Nielsen  wrote:

> I think you are in trouble because you have mixed 2D and 3D shapes in
> one data type.
>
> --not checked for typos, syntax, idiocy etc.
> {-# LANGUAGE GADTs #-}
>
> data Z
> data S n
>
> type Two = S (S Z)
> type Three = S Two
>
> data Geometry dims where
>Sphere :: Position -> Radius -> Geometry Three
>Cylinder :: Position -> Radius -> Height -> Geometry Three
>Circle :: Position -> Radius -> Geometry Two
>
>Postcard :: Position -> Orientation -> Geometry Two -> Geometry Three
>
> perimeter :: Geometry Two -> Double
> perimeter (Circle _ r) = 2*pi*r
>
> Tom
>
> On Tue, Sep 15, 2009 at 11:29 AM, Olex P  wrote:
> > Hey guys,
> >
> > It's a dumb question but I'd like to know a right answer...
> > Let's say we have some geometry data that can be Sphere, Cylinder, Circle
> > and so on. We can implement it as new data type plus a bunch of functions
> > that work on this data:
> >
> > data Geometry = Sphere Position Radius
> > | Cylinder Position Radius Height
> > | Circle Position Radius
> > deriving (Show)
> >
> > perimeter (Sphere _ r) = 0.0
> > perimeter (Cylinder _ r h) = 0.0
> > perimeter (Circle _ r) = 2.0 * pi * r
> >
> > Perimeter doesn't make sense for Sphere or Cylinder. So we could define a
> > type class for objects that have perimeter and make an instance of it
> only
> > for Circle (data Circle = Circle Position Radius). Make sense. But these
> > three functions above have desired behaviour. If user has a list of
> objects
> > like [Sphere, Circle, Circle, Cylinder] he would like to calculate
> > perimeters of each object using map perimerer list (in this case we also
> > have to modify Geometry data type).
> > So we could make instances of "perimeter" type class for all objects and
> > return zero in case if perimeter doesn't make sense.
> > Same as previous version but with typeclasses and with additional
> > constructors (constructors for each type of object + constructors in
> > Geometry data). Looks a bit overcomplicated.
> > Any reasons to use type classes in this case? Maybe there is something
> I'm
> > missing?
> >
> > Cheers,
> > -O
> >
> > ___
> > Haskell-Cafe mailing list
> > Haskell-Cafe@haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
> >
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Tom Nielsen
I think you are in trouble because you have mixed 2D and 3D shapes in
one data type.

--not checked for typos, syntax, idiocy etc.
{-# LANGUAGE GADTs #-}

data Z
data S n

type Two = S (S Z)
type Three = S Two

data Geometry dims where
Sphere :: Position -> Radius -> Geometry Three
Cylinder :: Position -> Radius -> Height -> Geometry Three
Circle :: Position -> Radius -> Geometry Two

Postcard :: Position -> Orientation -> Geometry Two -> Geometry Three

perimeter :: Geometry Two -> Double
perimeter (Circle _ r) = 2*pi*r

Tom

On Tue, Sep 15, 2009 at 11:29 AM, Olex P  wrote:
> Hey guys,
>
> It's a dumb question but I'd like to know a right answer...
> Let's say we have some geometry data that can be Sphere, Cylinder, Circle
> and so on. We can implement it as new data type plus a bunch of functions
> that work on this data:
>
> data Geometry = Sphere Position Radius
>                         | Cylinder Position Radius Height
>                         | Circle Position Radius
>     deriving (Show)
>
> perimeter (Sphere _ r) = 0.0
> perimeter (Cylinder _ r h) = 0.0
> perimeter (Circle _ r) = 2.0 * pi * r
>
> Perimeter doesn't make sense for Sphere or Cylinder. So we could define a
> type class for objects that have perimeter and make an instance of it only
> for Circle (data Circle = Circle Position Radius). Make sense. But these
> three functions above have desired behaviour. If user has a list of objects
> like [Sphere, Circle, Circle, Cylinder] he would like to calculate
> perimeters of each object using map perimerer list (in this case we also
> have to modify Geometry data type).
> So we could make instances of "perimeter" type class for all objects and
> return zero in case if perimeter doesn't make sense.
> Same as previous version but with typeclasses and with additional
> constructors (constructors for each type of object + constructors in
> Geometry data). Looks a bit overcomplicated.
> Any reasons to use type classes in this case? Maybe there is something I'm
> missing?
>
> Cheers,
> -O
>
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Olex P
Cool. It's more and more clear guys.
Thanks a lot. I'll check that "expression problem".
"Existential types" sounds a bit scary :)


On Tue, Sep 15, 2009 at 3:26 PM, Sean Leather  wrote:

>
>
>> Perimeter doesn't make sense for Sphere or Cylinder. So we could define a
>> type class for objects that have perimeter and make an instance of it only
>> for Circle (data Circle = Circle Position Radius). Make sense. But these
>> three functions above have desired behaviour. If user has a list of objects
>> like [Sphere, Circle, Circle, Cylinder] he would like to calculate
>> perimeters of each object using map perimerer list (in this case we also
>> have to modify Geometry data type).
>> So we could make instances of "perimeter" type class for all objects and
>> return zero in case if perimeter doesn't make sense.
>> Same as previous version but with typeclasses and with additional
>> constructors (constructors for each type of object + constructors in
>> Geometry data). Looks a bit overcomplicated.
>> Any reasons to use type classes in this case? Maybe there is something I'm
>> missing?
>>
>
> If you're talking about a single datatype with multiple constructors, then
> the function 'perimeter :: Geometry -> Maybe Double' makes sense. If you're
> talking about multiple datatypes, then you probably want to go type class
> route.
>
> data Sphere = Sphere ...
> data Circle = Circle ...
>
> class Perimeter a where perimeter :: a -> Double
> instance Perimeter Circle where perimeter (Circle ...) = ...
> -- No instance for Sphere
>
> class Volume a where volume :: a -> Double
> instance Volume Sphere where volume (Sphere ...) = ...
> -- No instance for Circle
>
> You have to decide whether (1) a datatype Geometry makes sense or (2) a
> datatype per geometric entity is better. One advantage to #1 is that writing
> functions over the datatype is easy. One advantage to #2 is that you have
> fewer (partial) 'Maybe' functions. This is also related to the "expression
> problem," a Googleable term.
>
> As for having a list of objects, you can do it with either approach. The
> second approach may require existential types.
>
> Regards,
> Sean
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Sean Leather
> Perimeter doesn't make sense for Sphere or Cylinder. So we could define a
> type class for objects that have perimeter and make an instance of it only
> for Circle (data Circle = Circle Position Radius). Make sense. But these
> three functions above have desired behaviour. If user has a list of objects
> like [Sphere, Circle, Circle, Cylinder] he would like to calculate
> perimeters of each object using map perimerer list (in this case we also
> have to modify Geometry data type).
> So we could make instances of "perimeter" type class for all objects and
> return zero in case if perimeter doesn't make sense.
> Same as previous version but with typeclasses and with additional
> constructors (constructors for each type of object + constructors in
> Geometry data). Looks a bit overcomplicated.
> Any reasons to use type classes in this case? Maybe there is something I'm
> missing?
>

If you're talking about a single datatype with multiple constructors, then
the function 'perimeter :: Geometry -> Maybe Double' makes sense. If you're
talking about multiple datatypes, then you probably want to go type class
route.

data Sphere = Sphere ...
data Circle = Circle ...

class Perimeter a where perimeter :: a -> Double
instance Perimeter Circle where perimeter (Circle ...) = ...
-- No instance for Sphere

class Volume a where volume :: a -> Double
instance Volume Sphere where volume (Sphere ...) = ...
-- No instance for Circle

You have to decide whether (1) a datatype Geometry makes sense or (2) a
datatype per geometric entity is better. One advantage to #1 is that writing
functions over the datatype is easy. One advantage to #2 is that you have
fewer (partial) 'Maybe' functions. This is also related to the "expression
problem," a Googleable term.

As for having a list of objects, you can do it with either approach. The
second approach may require existential types.

Regards,
Sean
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread John Dorsey
> perimeter :: Geometry -> Double
> perimeter (Sphere _ r) = 0.0
> perimeter (Circle _ r) = 2.0 * pi * r
> 
> The latter is even simpler because there is no need in extraction of Double
> value from Maybe.

I'd strongly advise against this last one on style grounds.  (0 :: Double)
isn't nearly as suitable as a distinguished value indicating an invalid
result as Nothing.  It can be made to work, in the same way that you can
write complex code in asm; instead, use a solution that gives you
type-level help in getting it right.  I'd use Maybe.

Regards,
John

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Lyndon Maydwell
-- Forwarded message --
From: Lyndon Maydwell 
Date: Tue, Sep 15, 2009 at 10:03 PM
Subject: Re: [Haskell-cafe] Typeclasses vs simple functions?
To: Olex P 


I think it depends on what is going to be using the functions, data.
As far as I can tell, type classes seem to be used in code designed
for reuse. So if it is just for a small part of a project that is
hidden behind an interface or something, then it's probably fine to
just use data/functions without type classes.

Keep in mind that these are the musings of someone who only recently
began using Haskell. If someone else has a better explanation, then
I'd be interested as well :)

On Tue, Sep 15, 2009 at 9:57 PM, Olex P  wrote:
> Well... How this:
>
> instance Encircled Geometry where
>        perimeter (Sphere _ r) = Nothing
>        perimeter (Circle _ r) = Just $ 2.0 * pi * r
>
> differs from this:
>
> perimeter :: Geometry -> Maybe Double
> perimeter (Sphere _ r) = Nothing
> perimeter (Circle _ r) = Just $ 2.0 * pi * r
>
> and from this:
>
> perimeter :: Geometry -> Double
> perimeter (Sphere _ r) = 0.0
> perimeter (Circle _ r) = 2.0 * pi * r
>
> The latter is even simpler because there is no need in extraction of Double
> value from Maybe.
> So the question is still there: do I need a type class?
>
> On Tue, Sep 15, 2009 at 12:21 PM, Olex P  wrote:
>>
>> Sure! I completely forgot about Maybe. The only one question is is it good
>> from the point of view of ordinary user who doesn't know about such things
>> like functional programming, monads etc. Imagine average user who is looking
>> into a spreadsheet and sees values 0.1, 1.4, Nothing... From other side it
>> seems to be logical. Why not.
>> Thanks for the idea :)
>>
>> On Tue, Sep 15, 2009 at 12:05 PM, Lyndon Maydwell 
>> wrote:
>>>
>>> I think the problem is that you want to compose a list with no
>>> indication of weather one member can have a perimeter or not. I'm not
>>> sure if this is a good solution or not, but I immediately think to
>>> make all Geometry objects instances of a class that return a Maybe
>>> value for the perimeter:
>>>
>>> e.g.
>>>
>>> ---
>>>
>>> import Data.Maybe
>>>
>>> data Geometry = Sphere Position Radius | Circle Position Radius deriving
>>> (Show)
>>>
>>> type Position = (Double, Double)
>>> type Radius = Double
>>> type Height = Double
>>>
>>> class Encircled x where
>>>        perimeter :: x -> Maybe Double
>>>
>>> instance Encircled Geometry where
>>>        perimeter (Sphere _ r) = Nothing
>>>        perimeter (Circle _ r) = Just $ 2.0 * pi * r
>>>
>>> list = [Sphere (1,1) 1, Circle (2,2) 2]
>>>
>>> main = (print . catMaybes . map perimeter) list
>>>
>>> --- [12.566370614359172]
>>>
>>> On Tue, Sep 15, 2009 at 6:29 PM, Olex P  wrote:
>>> > Hey guys,
>>> >
>>> > It's a dumb question but I'd like to know a right answer...
>>> > Let's say we have some geometry data that can be Sphere, Cylinder,
>>> > Circle
>>> > and so on. We can implement it as new data type plus a bunch of
>>> > functions
>>> > that work on this data:
>>> >
>>> > data Geometry = Sphere Position Radius
>>> >                         | Cylinder Position Radius Height
>>> >                         | Circle Position Radius
>>> >     deriving (Show)
>>> >
>>> > perimeter (Sphere _ r) = 0.0
>>> > perimeter (Cylinder _ r h) = 0.0
>>> > perimeter (Circle _ r) = 2.0 * pi * r
>>> >
>>> > Perimeter doesn't make sense for Sphere or Cylinder. So we could define
>>> > a
>>> > type class for objects that have perimeter and make an instance of it
>>> > only
>>> > for Circle (data Circle = Circle Position Radius). Make sense. But
>>> > these
>>> > three functions above have desired behaviour. If user has a list of
>>> > objects
>>> > like [Sphere, Circle, Circle, Cylinder] he would like to calculate
>>> > perimeters of each object using map perimerer list (in this case we
>>> > also
>>> > have to modify Geometry data type).
>>> > So we could make instances of "perimeter" type class for all objects
>>> > and
>>> > return zero in case if perimeter doesn't make sense.
>>> > Same as previous version but with typeclasses and with additional
>>> > constructors (constructors for each type of object + constructors in
>>> > Geometry data). Looks a bit overcomplicated.
>>> > Any reasons to use type classes in this case? Maybe there is something
>>> > I'm
>>> > missing?
>>> >
>>> > Cheers,
>>> > -O
>>> >
>>> > ___
>>> > Haskell-Cafe mailing list
>>> > Haskell-Cafe@haskell.org
>>> > http://www.haskell.org/mailman/listinfo/haskell-cafe
>>> >
>>> >
>>
>
>
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Olex P
Well... How this:

instance Encircled Geometry where
   perimeter (Sphere _ r) = Nothing
   perimeter (Circle _ r) = Just $ 2.0 * pi * r

differs from this:

perimeter :: Geometry -> Maybe Double
perimeter (Sphere _ r) = Nothing
perimeter (Circle _ r) = Just $ 2.0 * pi * r

and from this:

perimeter :: Geometry -> Double
perimeter (Sphere _ r) = 0.0
perimeter (Circle _ r) = 2.0 * pi * r

The latter is even simpler because there is no need in extraction of Double
value from Maybe.
So the question is still there: do I need a type class?

On Tue, Sep 15, 2009 at 12:21 PM, Olex P  wrote:

> Sure! I completely forgot about Maybe. The only one question is is it good
> from the point of view of ordinary user who doesn't know about such things
> like functional programming, monads etc. Imagine average user who is looking
> into a spreadsheet and sees values 0.1, 1.4, Nothing... From other side it
> seems to be logical. Why not.
> Thanks for the idea :)
>
> On Tue, Sep 15, 2009 at 12:05 PM, Lyndon Maydwell wrote:
>
>> I think the problem is that you want to compose a list with no
>> indication of weather one member can have a perimeter or not. I'm not
>> sure if this is a good solution or not, but I immediately think to
>> make all Geometry objects instances of a class that return a Maybe
>> value for the perimeter:
>>
>> e.g.
>>
>> ---
>>
>> import Data.Maybe
>>
>> data Geometry = Sphere Position Radius | Circle Position Radius deriving
>> (Show)
>>
>> type Position = (Double, Double)
>> type Radius = Double
>> type Height = Double
>>
>> class Encircled x where
>>perimeter :: x -> Maybe Double
>>
>> instance Encircled Geometry where
>>perimeter (Sphere _ r) = Nothing
>>perimeter (Circle _ r) = Just $ 2.0 * pi * r
>>
>> list = [Sphere (1,1) 1, Circle (2,2) 2]
>>
>> main = (print . catMaybes . map perimeter) list
>>
>> --- [12.566370614359172]
>>
>> On Tue, Sep 15, 2009 at 6:29 PM, Olex P  wrote:
>> > Hey guys,
>> >
>> > It's a dumb question but I'd like to know a right answer...
>> > Let's say we have some geometry data that can be Sphere, Cylinder,
>> Circle
>> > and so on. We can implement it as new data type plus a bunch of
>> functions
>> > that work on this data:
>> >
>> > data Geometry = Sphere Position Radius
>> > | Cylinder Position Radius Height
>> > | Circle Position Radius
>> > deriving (Show)
>> >
>> > perimeter (Sphere _ r) = 0.0
>> > perimeter (Cylinder _ r h) = 0.0
>> > perimeter (Circle _ r) = 2.0 * pi * r
>> >
>> > Perimeter doesn't make sense for Sphere or Cylinder. So we could define
>> a
>> > type class for objects that have perimeter and make an instance of it
>> only
>> > for Circle (data Circle = Circle Position Radius). Make sense. But these
>> > three functions above have desired behaviour. If user has a list of
>> objects
>> > like [Sphere, Circle, Circle, Cylinder] he would like to calculate
>> > perimeters of each object using map perimerer list (in this case we also
>> > have to modify Geometry data type).
>> > So we could make instances of "perimeter" type class for all objects and
>> > return zero in case if perimeter doesn't make sense.
>> > Same as previous version but with typeclasses and with additional
>> > constructors (constructors for each type of object + constructors in
>> > Geometry data). Looks a bit overcomplicated.
>> > Any reasons to use type classes in this case? Maybe there is something
>> I'm
>> > missing?
>> >
>> > Cheers,
>> > -O
>> >
>> > ___
>> > Haskell-Cafe mailing list
>> > Haskell-Cafe@haskell.org
>> > http://www.haskell.org/mailman/listinfo/haskell-cafe
>> >
>> >
>>
>
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Olex P
Sure! I completely forgot about Maybe. The only one question is is it good
from the point of view of ordinary user who doesn't know about such things
like functional programming, monads etc. Imagine average user who is looking
into a spreadsheet and sees values 0.1, 1.4, Nothing... From other side it
seems to be logical. Why not.
Thanks for the idea :)

On Tue, Sep 15, 2009 at 12:05 PM, Lyndon Maydwell wrote:

> I think the problem is that you want to compose a list with no
> indication of weather one member can have a perimeter or not. I'm not
> sure if this is a good solution or not, but I immediately think to
> make all Geometry objects instances of a class that return a Maybe
> value for the perimeter:
>
> e.g.
>
> ---
>
> import Data.Maybe
>
> data Geometry = Sphere Position Radius | Circle Position Radius deriving
> (Show)
>
> type Position = (Double, Double)
> type Radius = Double
> type Height = Double
>
> class Encircled x where
>perimeter :: x -> Maybe Double
>
> instance Encircled Geometry where
>perimeter (Sphere _ r) = Nothing
>perimeter (Circle _ r) = Just $ 2.0 * pi * r
>
> list = [Sphere (1,1) 1, Circle (2,2) 2]
>
> main = (print . catMaybes . map perimeter) list
>
> --- [12.566370614359172]
>
> On Tue, Sep 15, 2009 at 6:29 PM, Olex P  wrote:
> > Hey guys,
> >
> > It's a dumb question but I'd like to know a right answer...
> > Let's say we have some geometry data that can be Sphere, Cylinder, Circle
> > and so on. We can implement it as new data type plus a bunch of functions
> > that work on this data:
> >
> > data Geometry = Sphere Position Radius
> > | Cylinder Position Radius Height
> > | Circle Position Radius
> > deriving (Show)
> >
> > perimeter (Sphere _ r) = 0.0
> > perimeter (Cylinder _ r h) = 0.0
> > perimeter (Circle _ r) = 2.0 * pi * r
> >
> > Perimeter doesn't make sense for Sphere or Cylinder. So we could define a
> > type class for objects that have perimeter and make an instance of it
> only
> > for Circle (data Circle = Circle Position Radius). Make sense. But these
> > three functions above have desired behaviour. If user has a list of
> objects
> > like [Sphere, Circle, Circle, Cylinder] he would like to calculate
> > perimeters of each object using map perimerer list (in this case we also
> > have to modify Geometry data type).
> > So we could make instances of "perimeter" type class for all objects and
> > return zero in case if perimeter doesn't make sense.
> > Same as previous version but with typeclasses and with additional
> > constructors (constructors for each type of object + constructors in
> > Geometry data). Looks a bit overcomplicated.
> > Any reasons to use type classes in this case? Maybe there is something
> I'm
> > missing?
> >
> > Cheers,
> > -O
> >
> > ___
> > Haskell-Cafe mailing list
> > Haskell-Cafe@haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
> >
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Typeclasses vs simple functions?

2009-09-15 Thread Olex P
Hey guys,

It's a dumb question but I'd like to know a right answer...
Let's say we have some geometry data that can be Sphere, Cylinder, Circle
and so on. We can implement it as new data type plus a bunch of functions
that work on this data:

data Geometry = Sphere Position Radius
| Cylinder Position Radius Height
| Circle Position Radius
deriving (Show)

perimeter (Sphere _ r) = 0.0
perimeter (Cylinder _ r h) = 0.0
perimeter (Circle _ r) = 2.0 * pi * r

Perimeter doesn't make sense for Sphere or Cylinder. So we could define a
type class for objects that have perimeter and make an instance of it only
for Circle (data Circle = Circle Position Radius). Make sense. But these
three functions above have desired behaviour. If user has a list of objects
like [Sphere, Circle, Circle, Cylinder] he would like to calculate
perimeters of each object using map perimerer list (in this case we also
have to modify Geometry data type).
So we could make instances of "perimeter" type class for all objects and
return zero in case if perimeter doesn't make sense.
Same as previous version but with typeclasses and with additional
constructors (constructors for each type of object + constructors in
Geometry data). Looks a bit overcomplicated.
Any reasons to use type classes in this case? Maybe there is something I'm
missing?

Cheers,
-O
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe