[Haskell-cafe] Records: Examples

Barney Hilken b.hilken at ntlworld.com
Mon Sep 17 14:01:15 EDT 2007


 >	{-# LANGUAGE TypeFamilies #-}

Hi Justin, thanks for your interest. Hope this helps!

 >	module Examples where
 >	import Records

To get started, you need to define your labels. They are just  
singleton datatypes:

 >	data FirstName = FirstName deriving (Show, Eq, Ord)
 >	data Surname = Surname deriving (Show, Eq, Ord)
 >	data Address = Address deriving (Show, Eq, Ord)
 >	data PhoneNo = PhoneNo deriving (Show, Eq, Ord)

you can define as many as you like. Next you have to define the order  
on fields. At
the moment you have to do this by hand, but I hope to get ghc to do  
this automatically:

 >	type instance NameCmp FirstName FirstName = NameEQ
 >	type instance NameCmp FirstName Surname = NameLT
 >	type instance NameCmp FirstName Address = NameLT
 >	type instance NameCmp FirstName PhoneNo = NameLT
 >	type instance NameCmp Surname FirstName = NameGT
 >	type instance NameCmp Surname Surname = NameEQ
 >	type instance NameCmp Surname Address = NameLT
 >	type instance NameCmp Surname PhoneNo = NameLT
 >	type instance NameCmp Address FirstName = NameGT
 >	type instance NameCmp Address Surname = NameGT
 >	type instance NameCmp Address Address = NameEQ
 >	type instance NameCmp Address PhoneNo = NameLT
 >	type instance NameCmp PhoneNo FirstName = NameGT
 >	type instance NameCmp PhoneNo Surname = NameGT
 >	type instance NameCmp PhoneNo Address = NameGT
 >	type instance NameCmp PhoneNo PhoneNo = NameEQ

Now we are ready to play!

To define records, use (=:) and (+:)

 >	barney = FirstName =: "Barney" +: Surname =: "Hilken" +:
 >				Address =: "Horwich" +: PhoneNo =: "697223"

You can use as many or as few of the fields as you like, and you can  
write them in any order,
but trying to use a field twice in the same record will give you a  
(rather incomprehensible)
type error.

 >	justin = Surname =: "Bailey" +: FirstName =: "Justin" +: Address  
=: "Somewhere"

To extract the value at a field use (.:)

 >	myPhone = barney.:PhoneNo

To delete part of a record, use (-:)

 >	noCallers = barney -: Address

To update existing fields in a record, use (|:)

 >	barney' = barney |: Address =: ((barney .: Address) ++ ", UK")

The power of the records system is that these five operators, =:  
+: .: -: |: are Haskell
polymorphic functions. So you can define functions like

 >	livesWith p q = p |: Address =: (q .: Address)

which returns p, but with its Address field changed to that of q.  
Note that this function
works on any records p and q with Address fields, whatever other  
fields they may have.

You can even define functions parametrised by field names:

 >	labelZip n m = zipWith (\x y -> n =: x +: m =: y)

then 'labelZip FirstName Surname' is a function which takes two lists  
and returns a list of records:

 >	names = labelZip FirstName Surname ["Barney", "Justin"] ["Hilken",  
"Bailey"]

of course, labelZip isn't restricted to the four labels we defined  
earlier, it works on anything.


The system is strongly typed, so record errors (such as missing or  
duplicated fields) are caught
at compile time. There are type operators (:=:), (:+:), (:-:), (:.:)  
corresponding to the record
operators, and classes `Contains`, `Disjoint`, `Subrecord` which  
allow you to express conditions
on types. Unfortunately, the type system sometimes decides that a  
function has a different type
from the one you expect, and won't accept the header you want to give  
it. More experience with the
system is needed before we can say whether this is a problem.


Barney.



More information about the Haskell-Cafe mailing list