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@haskell.org> wrote:
Date: Mon, 13 Dec 2010 22:09:25 -0600
From: Antoine Latter <aslatter@gmail.com>
Subject: Re: [Haskell-beginners] Equivalent of inheritance in Haskell
To: C K Kashyap <ckkashyap@gmail.com>
Cc: beginners@haskell.org
Message-ID:
       <AANLkTinE30iTwWs8qBvWAcDoqGvy2T2_qpQqbXZKrCcm@mail.gmail.com>
Content-Type: text/plain; charset=UTF-8

On Mon, Dec 13, 2010 at 9:10 PM, C K Kashyap <ckkashyap@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