[Haskell-cafe] Mission: To take args from a list... generally

Joel Koerwer joelkoerwer at gmail.com
Wed Oct 4 04:13:38 EDT 2006


Haskellers,

Let's say I want to evaluate a function of type (a->a->...->a->a),
taking the arguments from a list. If know the function ahead of time,
I can simply wrap it:

foo a b c d = ...
wrapFoo (a:b:c:d:_) = foo a b c d

But, as an exercise, I challenged myself to write a function,
multApply :: (a->a->...->a->a) -> [a] -> a, that automatically does
the wrapping for any such function.

On #haskell Don Stewart suggested I look at printf, but I've yet to
put much thought into whether that method will work here.

I'm posting my solution in hopes to learn from your comments. This
solution uses fundeps, multi-parameter classes, and overlapping
instances. Note that I don't actually understand these things! :)

------------------------ MultApply.hs ------------------------------
{-# OPTIONS -fglasgow-exts -fallow-overlapping-instances #-}

module MultApply where

class MultApply func arg | func -> arg where
    multApply :: func -> [arg] -> arg

instance MultApply (a->a) a where
    multApply f (x:xs) = f x
    multApply f _      = error "MultApply: one too few args"

instance MultApply cascade a => MultApply (a -> cascade) a where
    multApply f (x:xs) = multApply (f x) xs
    multApply f _      = error "MultApply: n too few args"


-- some random examples
oneArg = multApply sqrt [25..]
twoArg = multApply (+) [1..]
fiveArg = multApply (\a b c d e -> sqrt ((a+b)^2+(d-e)^2)-5*c) [13..]

-------------------End File ------------------------

Results in ghci:

*MultApply> oneArg
5.0
*MultApply> fiveArg
-47.981487827787404

To compose your own examples in ghci, you'll need
-fallow-overlapping-instances on the command line.

Cheers,
Joel


More information about the Haskell-Cafe mailing list