函数定义中的模板数据类型

Question

I have two functions in my program:

getWidth :: Size -> GLint
getWidth (Size a b) = a

getXPos :: Position -> GLint
getXPos (Position a b) = a

I realized that those two functions are doing the same thing and the only difference is parameter type. Question is: how do i write such a generic function:

getFirst :: ANYTHING -> a
getFirst (ANYTHING a b) -> a

Answer 1

This is probably a little bit overkill for your problem, but maybe it'll be useful for someone else that stumbles upon this question.

You can implement a truly generic function that works on any datatype that has a single constructor with two fields by using GHC's generic programming .

Let's look at the type signature first. You'd like to write a function such as

getFirst :: ANYTHING -> a

In Haskell, a type that can be "anything" is signified with a type variable (just like the result type a ), so let's write

getFirst :: t -> a

However, having a fully polymorphic type doesn't let us operate on the type in any way since we can't make any assumptions about its internal structure. Therefore we need to write in some constraints about the type t .

The second thing is that a polymorphic return type (the a above) means that the return type is inferred based on the call site, essentially meaning that the caller is able to "request" any possible type for the first field. This is clearly impossible, since for example for Size the only valid return type is GLint . So we need to declare the return type so that it depends on the type t .

getFirst :: (Generic t, GPair (Rep t)) => t -> FirstT (Rep t)

Now, this is a rather complicated type signature, but the essence is that for any type t that is generic and has a generic representation Rep t that is a valid, generic pair ( GPair ), we can access the first field of the pair which has the type FirstT (Rep t) .

The type-class GPair can be defined like this

class GPair g where
    type FirstT g   -- type of the first field in the pair
    type SecondT g  -- type of the second field in the pair

    gGetFirst  :: g x -> FirstT g
    gGetSecond :: g x -> SecondT g

This type-class introduces the function gGetFirst and gGetSecond that do not operate on the pair type itself but its generic representation. The type delcarations FirstT and SecondT are so called associated type synonyms that are part of the TypeFamilies language extension. What we declare here is that FirstT and SecondT are a synonym for some existing, unknown type that is determined by the type g .

The generic representations of types are wrapped in meta-data descriptions that contain information such as the data type name, constructor names, record field names etc. We are not going to need any of that information for this case, so the first instance of GPair simply strips out the meta-data layer.

instance GPair f => GPair (M1 i c f) where
    type FirstT (M1 i c f) = FirstT f
    type SecondT (M1 i c f) = SecondT f

    gGetFirst  = gGetFirst . unM1
    gGetSecond = gGetSecond . unM1

Next we need to make an instance for the generic constuctor with two fields.

instance (GField l, GField r) => GPair (l :*: r) where
    type FirstT  (l :*: r) = FieldT l
    type SecondT (l :*: r) = FieldT r

    gGetFirst  (l :*: _) = gGet l
    gGetSecond (_ :*: r) = gGet r

And then we define the generic field type-class GField which operates on a single field of the pair.

class GField g where
    type FieldT g

    gGet :: g x -> FieldT g

We strip out the meta-data layer from GField as we did above

instance GField f => GField (M1 i c f) where
    type FieldT (M1 i c f) = FieldT f

    gGet = gGet . unM1

And now we just need to add an instance for generic constructor fields.

instance GField (K1 r t) where
    type FieldT (K1 r t) = t

    gGet (K1 x) = x

Now we can implement the truly generic accessor functions getFirst and getSecond .

getFirst :: (Generic t, GPair (Rep t)) => t -> FirstT (Rep t)
getFirst = gGetFirst . from

getSecond :: (Generic t, GPair (Rep t)) => t -> SecondT (Rep t)
getSecond = gGetSecond . from

The function from is part of GHC.Generics and it converts a value to its generic form. For this, the data types Size and Position need to implement the Generic type-class.

{-# LANGUAGE DeriveGeneric #-}

data Position = Position GLInt GLInt deriving Generic
data Size     = Size GLInt GLInt deriving Generic

Let's test it out:

> let sz = Size 1 2
> let pos = Position 4 6
> getFirst sz
1
> getSecond pos
6

The functions also work automatically for appropriate built-in types, such as tuples:

> getSecond (1, "foo")
"foo"

Now, you might think that this is an awful lot of code for a simple, generic function and that's a valid concern. However, in practice the generic instances are rather easy and quick to write once you are familiar with how the generic representation types are structured.

Also, the great thing about GHC's generic programming is that it's completely type-safe (unlike, for example, the reflection APIs in Java). This means that if you try to use the generic functions with incompatible types, you get a compile time error instead of a run-time exception.

For example:

a = getFirst (1,2,3) -- compile error because value has more than two fields

data Foo = Foo Int Int | Bar Float Float deriving Generic

b = getFirst $ Foo 1 2 -- compile error because the type has multiple constuctors

Here's the complete code for trying this out:

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics

class GPair g where
    type FirstT g
    type SecondT g

    gGetFirst  :: g x -> FirstT g
    gGetSecond :: g x -> SecondT g

instance GPair f => GPair (M1 i c f) where
    type FirstT (M1 i c f) = FirstT f
    type SecondT (M1 i c f) = SecondT f

    gGetFirst  = gGetFirst . unM1
    gGetSecond = gGetSecond . unM1

instance (GField l, GField r) => GPair (l :*: r) where
    type FirstT (l :*: r) = FieldT l
    type SecondT (l :*: r) = FieldT r

    gGetFirst  (l :*: _) = gGet l
    gGetSecond (_ :*: r) = gGet r

class GField g where
    type FieldT g

    gGet :: g x -> FieldT g

instance GField f => GField (M1 i c f) where
    type FieldT (M1 i c f) = FieldT f

    gGet = gGet . unM1

instance GField (K1 r t) where
    type FieldT (K1 r t) = t

    gGet (K1 x) = x

getFirst :: (Generic t, GPair (Rep t)) => t -> FirstT (Rep t)
getFirst = gGetFirst . from

getSecond :: (Generic t, GPair (Rep t)) => t -> SecondT (Rep t)
getSecond = gGetSecond . from

Answer 2

You need a type class (although IMO it isn't a good idea to generalize these two functions):

class Dimension d where
    getX :: d -> GLint
    getY :: d -> GLint

instance Dimension Size where
    getX (Size x y) = x
    getY (Size x y) = y

instance Dimension Position where
    getX (Position x y) = x
    getY (Position x y) = y

If you just want to write less code, employ record syntax :

data Size = Size { getWidth :: GLint, getHeight :: GLint }
data Position = Position { getXPos :: GLint, getYPos :: GLint }