[Haskell-cafe] polyvariadic function for Applicative instances
Xiao-Yong Jin
xj2106 at columbia.edu
Mon May 10 10:30:23 EDT 2010
Thanks, Chris and Bartek. It was quite a read. I finally
arrived at an implementation as follows.
--8<---------------cut here---------------start------------->8---
{-# LANGUAGE MultiParamTypeClasses
, FunctionalDependencies
, FlexibleInstances
, UndecidableInstances
#-}
module FuncApply (funcApply) where
import Control.Applicative
class Applicative a => F a f af | a af -> f where
_f :: a (x -> f) -> a x -> af
instance Applicative a => F a f (a f) where
_f g x = g <*> x
instance F a f af => F a (y -> f) (a y -> af) where
_f g x y = _f (g <*> x) y
funcApply :: F a f af => (x -> f) -> a x -> af
funcApply = _f . pure
testFunc :: Int -> Double -> Double -> Double
testFunc x y z = (y ^ x) + z
test :: [Double]
test = pure testFunc <*> [0..2] <*> [10..12] <*> [-1..1]
test' :: [Double]
test' = funcApply testFunc [0..2] [10..12] [-1..1]
--8<---------------cut here---------------end--------------->8---
I am happy with the code. And I would appreciate if there
is any suggestions or criticism.
On Mon, 10 May 2010 15:14:56 +0200, Chris Eidhof wrote:
> Maybe this is what you are looking for: http://www.haskell.org/haskellwiki/Idiom_brackets
> -chris
> On 9 mei 2010, at 18:39, Xiao-Yong Jin wrote:
>> Hi,
>>
>> Is it possible to have a function accept variable number of
>> arguments, such that 'f' can be instantiated to different
>> concrete types as
>>
>> f :: Applicative a => (e1 -> f) -> a e1 -> A f
>> f g a = pure g <*> a
>>
>> f :: Applicative a => (e1 -> e2 -> f) -> a e1 -> a e2 -> A f
>> f g a b = pure g <*> a <*> b
>>
>> Thanks,
>> Xiao-Yong
--
J c/* __o/*
X <\ * (__
Y */\ <
More information about the Haskell-Cafe
mailing list