[Haskell-cafe] Decoupling OpenAL/ALUT packages from OpenGL
Neil Brown
nccb2 at kent.ac.uk
Mon May 11 06:04:07 EDT 2009
Sven Panne wrote:
> Regarding Functor/Applicative: The obvious instances for e.g. a 2-dimensional
> vertex are:
>
> data Vertex2 a = Vertex2 a a
>
> instance Functor Vertex2 where
> fmap f (Vertex2 x y) = Vertex2 (f x) (f y)
>
> instance Applicative Vertex2 where
> pure a = Vertex2 a a
> Vertex2 f g <*> Vertex2 x y = Vertex2 (f x) (g y)
>
> They fulfill all required laws, but are these the only possible instances? If
> not, are they at least the most "canonical" ones in a given sense? And
> finally: Does somebody have a real-world example where the Applicative
> instance is useful? Usages of the Functor instance are much more obvious for
> me.
>
I'd say those are the right instances. Some obvious uses (perhaps more
useful for Vector2 than Vertex2, but still) are:
liftA2 (+) (Vertex2 1 3) (Vertex2 4 5) == Vertex2 5 8
pure 0 == Vertex2 0 0
The latter being a useful shorthand to get a vertex for the origin.
Also, if you define Foldable:
foldl1 (+) . liftA2 (*) v w == dotProduct v w
The useful thing being that that definition of dotProduct is the same
for 2-, 3- and 4- dimensional things, and for vertexes and vectors. So
possible additions to your type-class list are Foldable and maybe
Traversable (no harm, although I'd have to reach further for an example
for this). I guess the tricky decision might be whether to provide a
Num instance (again, probably more suitable for Vector2)?
instance Num a => Num (Vertex2 a) where
(+) = liftA2 (+)
(-) = liftA2 (-)
(*) = liftA2 (*)
abs = fmap abs
signum = fmap signum
negate = fmap negate
fromInteger = pure . fromInteger
Even if you don't want to define Num, note how easy having the
Applicative instance makes defining some of the operators :-)
Thanks,
Neil.
More information about the Haskell-Cafe
mailing list