[Haskell-beginners] Equivalence of Inheritance

Antoine Latter aslatter at gmail.com
Tue Dec 14 20:01:26 CET 2010


There is no such thing as inheritance built in to the language. In
this particular example, I think you would be better off having
'gender' be a field of the 'Person' type.

One thing to note is that in Haskell, a class is not a type. A type
may belong to a class, but a class is not a type. So if you have a
class 'Vehicle v', this declares that it is possible for a type 'v' to
inhabit the class 'Vehicle.' Used in a type signature:

> timeToPeakSpeed :: Vehicle v => v -> Double

What this signature means is that the first argument may be any type v
which inhabits the class 'Vehicle'.

One way to think of it is that a class is simply a mechanism for
grouping types together, which grants you the ability to write
functions which are polymorphic of these groups.

That said, the first error I can see right off is your definition of
the class 'Person'. You have:

> class Person where ...

However the proper syntax is:

> class Person p where ...

Have you been working with any of the on-line Haskell tutorials?

Thanks,
Antoine

Then the type variable 'p' is in scope for use in the definitions of
the class functions.

On Tue, Dec 14, 2010 at 12:11 PM, Russ Abbott <russ.abbott at gmail.com> wrote:
> I'm also confused about how to do the equivalence of inheritance in Haskell.
>  Here is a complete example below.  It doesn't compile. The error message
> is
>
> Class `Person' used as a type
>
> If I write "(Person p) =>" instead, I get other diagnostics.
> I would very much appreciate seeing how this should be done in Haskell.
> ---------- Example (multiple files) ------------
> --- Group.hs ---
> module Group where
> import Person
> data Group = Group { members :: [Person] }
> instance Show Group where
>   show group = unlines $ map show $ members group
> --- Person.hs ---
> module Person
>    (
>      Condition(Bad, OK, Good)
>    , Person
>    )
> where
> class Person where
>   age :: Person -> Int
>
>   name :: Person -> String
>
>   getGenderSpecificCondition :: Person -> Condition
> instance Show Person where
>   show p = name p ++ "(" ++ age p ++ ", " ++  getGenderSpecificCondition p
> ++ ")"
>
> data Condition = Bad | OK | Good
> --- Man.hs ---
> module Man
>      ( age
>      , name
>      , Man (Man)
>      )
> where
> import Person
> data Man = Man { name :: String
>                         , age  :: Int
>                         , prostateCondition :: Condition
>                         }
>
> instance Person Man where
>     getGenderSpecificCondition :: Person -> Condition
>     getGenderSpecificCondition m = prostateCondition m
> --- Woman.hs---
> module Woman
>      ( age
>      , name
>      , Woman (Woman)
>      )
> where
> import Person
>
> data Woman = Woman { name :: String
>                                  , age  :: Int
>                                  , ovaryCondition :: Condition
>                                  }
>
> instance Person Woman where
>     getGenderSpecificCondition :: Person -> Condition
>     getGenderSpecificCondition w = ovaryCondition w
> ---------- End example (multiple files) ------------
> Thanks
> -- Russ
>
>
> On Tue, Dec 14, 2010 at 12:11 AM, <beginners-request at haskell.org> wrote:
>>
>> Date: Mon, 13 Dec 2010 22:09:25 -0600
>> From: Antoine Latter <aslatter at gmail.com>
>> Subject: Re: [Haskell-beginners] Equivalent of inheritance in Haskell
>> To: C K Kashyap <ckkashyap at gmail.com>
>> Cc: beginners at haskell.org
>> Message-ID:
>>        <AANLkTinE30iTwWs8qBvWAcDoqGvy2T2_qpQqbXZKrCcm at mail.gmail.com>
>> Content-Type: text/plain; charset=UTF-8
>>
>> On Mon, Dec 13, 2010 at 9:10 PM, C K Kashyap <ckkashyap at gmail.com> wrote:
>> >>
>> >> But there is not a way to easily say (in Haskell) "type A is
>> >> everything that type B is plus these other things here ...". Haskell
>> >> is not an OO language.
>> >
>> > This captures what I had in mind. Using compound types seems ok but
>> > I'd still need to do some mechanical stuff if I had to provide a
>> > function that works on the compound type which is actually defined for
>> > a component type.
>> >
>> > If I understand you right .. you'd build a 'Man' type and 'Woman' type
>> > by using a 'Person' type. Lets say, there is a function called getName
>> > that is Person -> String
>> > I'd have to mechanically define a function getName :: Man -> String -
>> > that extracts the person inside and calls getName on it - did I
>> > understand it right?
>> > Or would you typically write extract functions that'll return the
>> > components and then the user could call the method on the component?
>> > As in .... getPerson :: Man -> Person ... then call getName on that.
>> >
>> > How do you deal with situations like that?
>> >
>>
>> Well, in this case I might just have a person type with a 'gender'
>> field :-) Then I get the polymorphism and code-reuse for free!
>>
>> But what you're talking about is something that OO-style programming
>> is particularly aligned towards, and functional programming generally
>> is not.
>>
>> One thing people do is use type-classes - this would be a bit like
>> having 'Car' and 'Truck' implement the same interface. The simple
>> building blocks would be duplicated, but the complex application-level
>> functionality could be written against the typeclass.
>>
>> Another approach is with functional lenses - these are libraries that
>> aim to make updating complex compound types easier. Off the top of my
>> head I know of fclabels[1], but I know there are others. If you're
>> interested in this approach you might be able to email the -cafe
>> mailing list to ask for more.
>>
>> Is there a particular problem you're trying to solve? we might be able
>> to take the conversation in a less speculative direction.
>>
>> Antoine
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
>



More information about the Beginners mailing list