[Haskell-cafe] Generics for constructing Rows

Max Desyatov explicitcall at googlemail.com
Thu Aug 20 10:54:40 EDT 2009


Sean Leather <leather at cs.uu.nl> writes:

> I'm not sure the problem you're running into is strictly a generic
> programming (GP) one. Typically, GP takes code that is often written
> and generalizes it, so that it doesn't have to be written for multiple
> datatypes.

That seems to be GP problem, as your solution doesn't scale well when I
wan't to add/remove/change fields in the `Row` record.  The perfect way
as I see it, would be just editing `Row` data declaration, nothing else.
Studying few papers about GP in Haskell, I reckon this could be
represented as generic traversal, using my `Row` declaration with
`Either`.  I don't see really good way to write a generic producer from
`[String]` to version of `Row` without `Either`.  But SYB doesn't
provide a way for passing type-class-parametric functions to gmapT, and
SYB-with-class has large overhead of its usage.  I don't have enough
time to find out how this can be written in SYB-with-class, if it really can be
written.  The restriction of EMGM was described in my initial message.

> For your problem, I think the first issue is figuring out how to write
> the non-generic function. I don't know if this is exactly what you
> want, but you can write a version of gmap using GADTs and rank-2
> types. I've simplified some types, but it should be easily
> transferable to your code. For example, change the String, Float,
> etc. to your Salary, Department, whatever.

> ---
>
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE Rank2Types #-}
>
> module Main where
>
> data T a where
>   String  :: T String
>   Float   :: T Float
>   Integer :: T Integer
>
> data Row = Row (Maybe String) (Maybe Float) (Maybe Integer)
>   deriving Show
>
> f :: T a -> Maybe a -> Maybe a
> f String (Just "a") = Just "z"
> f _      x = x
>
> gmap :: (forall a . T a -> Maybe a -> Maybe a) -> Row -> Row
> gmap f (Row x y z) = Row (f String x) (f Float y) (f Integer z)
>
> main = do
>   print $ gmap f $ Row Nothing (Just 5.4) (Just 3) -- ==> Row Nothing (Just 5.4) (Just 3)
>   print $ gmap f $ Row (Just "a") Nothing Nothing -- ==> Row (Just "z") Nothing Nothing
>

> If this is what you're looking for, then I think it might be possible to do this more generally, though I haven't looked
> into it.

Many thanks for this code, I'll try to integrate it at this point.  It
seems to remove the burden of managing row indices list and implements
some intended restrictions that will make my code less error prone, I
hope.

WBR, Max.


More information about the Haskell-Cafe mailing list