[Haskell-cafe] Adding a field to a data record

José Pedro Magalhães jpm at cs.uu.nl
Wed Jul 29 05:20:49 EDT 2009


Hello Henry,

The paper "A Lightweight Approach To Datatype-Generic Rewriting" [1]
describes a way to generically add a constructor to any regular datatype
using type-indexed datatypes [2]. A similar technique could be used to add a
new field to each constructor. Then you get something like:

data Foo
> type Extended f = ...
>

|Extended Foo| represents your |Foo| datatype with an added |z| field of
type |Int|. Since the underlying generic programming library used (regular
[3]) has Template Haskell generation, you don't even have to write the
generic representations for your many datatypes.

(As far as I know, SYB does not mix with type-indexed datatypes.)


Cheers,
Pedro

[1] Thomas van Noort, Alexey Rodriguez, Stefan Holdermans, Johan Jeuring,
Bastiaan Heeren. A Lightweight Approach to Datatype-Generic Rewriting.
Submitted to the Workshop on Generic Programming 2008.
http://www.cs.uu.nl/wiki/bin/view/Alexey/ALightweightApproachToDatatype-GenericRewriting
[2] http://www.iai.uni-bonn.de/~ralf/publications/SCP2004.pdf
[3] http://www.cs.uu.nl/wiki/GenericProgramming/Regular

On Tue, Jul 28, 2009 at 16:29, Henry Laxen <nadine.and.henry at pobox.com>wrote:

> Dear Group,
>
> It seems to me this should be easy, but I can't quite figure out
> how to do it without a lot of typing.  Here is the question:
>
> Suppose you have a data type like:
> Data Foo = Foo { a :: Int, b :: Int,
>   ... many other fields ...
>  y :: Int } deriving (Eq, Read, Show, Typeable, Data)
>
> Now I would like to add a field z :: Int to the end of Foo.  If
> I have a ton of data out on disk, which I wrote with, say
> writeFile "a.data" (show foo) -- where foo is a [Foo] say 1000
> long, I would like to get a new "a.data" file which has a new
> z::Int field.
>
> So far the only way I can think of is to make a new Data Foo1,
> which includes the z::Int, read in a.data as a list of Foo,
> write a function like:
>
> fooTofoo1 :: Foo -> Foo1
> fooTofoo1 xx = Foo1 {a = a xx, ... y = y xx, z = 1}
>
> then write the file back out, and perhaps use emacs to
> query-replace all the Foo1's back to Foo's, add the z::Int field
> back into Foo, and read it back.
>
> Please tell me there is a better way.  Thanks in advance.
> Best wishes,
> Henry Laxen
>
> PS:
> I have read syb1, and syb2 a couple of times now, but so far
> haven't been able to connect it with this kind of problem.
>
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090729/50cf7ec9/attachment.html


More information about the Haskell-Cafe mailing list