[Haskell-cafe] MapTuple is possible and easy
oleg at pobox.com
oleg at pobox.com
Thu Jan 11 23:29:33 EST 2007
Marco Tu'lio Gontijo e Silva wrote:
> is there a way to defined something as a map to use in tuples?
Yes, it is: and it is quite easy and straightforward.
Udo Stenzel
> since c would be a variable that ranges over type classes, and that
> doesn't exist.
Of course it does: please see below (as well as several earlier posts
on the Haskell list showing that Haskell classes *are* first-class).
Here's the definition of mapTuple
> mapTuple l (x,y) = (apply l x, apply l y)
and here its inferred type:
> *MapTuple> :t mapTuple
> mapTuple :: (Apply l b y1, Apply l a y) => l -> (a, b) -> (y, y1)
Our mapTuple applies to (in general) heterogeneous tuples and gives
(in general) a heterogeneous tuple.
Here's the complete code and the tests.
{-# OPTIONS -fglasgow-exts #-}
module MapTuple where
class Apply l x y | l x -> y where
apply:: l -> x -> y
data SHow = SHow
instance Apply SHow String String where
apply _ = show
instance Apply SHow Int String where
apply _ = show
instance Apply SHow Bool String where
apply _ = show
mapTuple l (x,y) = (apply l x, apply l y)
-- Here, the result is a homogeneous tuple
test1 = mapTuple SHow ("a",(1::Int))
test2 = mapTuple SHow ((1::Int),"b")
test3 = mapTuple SHow (True,"b")
-- ANother operation: SUcc
data SUcc = SUcc
instance Apply SUcc String String where
apply _ x = x ++ x
instance Apply SUcc Int Int where
apply _ = succ
instance Apply SUcc Bool Bool where
apply _ = not
-- Here, the result is a heterogeneous tuple (as is the argument)
testH1 = mapTuple SUcc ("a",(1::Int))
testH2 = mapTuple SUcc ((1::Int),"b")
testH3 = mapTuple SUcc (True,"b")
More information about the Haskell-Cafe
mailing list