11.11.2010 16:53, Stephen Tetley пишет:
On 11 November 2010 13:10, Lauri Alanko<l...@iki.fi>  wrote:

{-# LANGUAGE EmptyDataDecls, MultiParamTypeClasses, FunctionalDependencies #-}

data PetOwner
data FurnitureOwner

data Cat = Cat { catOwner :: PetOwner }
data Chair = Chair { chairOwner :: FurnitureOwner }

class Owned a b | a ->  b where
  owner :: a ->  b

instance Owned Cat PetOwner where
  owner = catOwner

instance Owned Chair FurnitureOwner where
  owner = chairOwner

This is fairly onerous for people who are programming to an outside
schema (i.e. a relational database) as it leads to boiler plate along
two axes - data type definitions plus class definitions for accessors.

I don't like the details current TDNR proposal, but if improved
records are never going to happen, TDNR has benefit for this
situation.

That's kinda the point, it can work the other way: ugly solution like TDNR can 
prevent improved records from ever appearing.

Incidentally there is now a member of the ML family with a
sophisticated record system - MLPolyR:
http://ttic.uchicago.edu/~wchae/wiki/pmwiki.php
_______________________________________________
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

Reply via email to