[Haskell-cafe] Accepting and returning polyvariadic functions
Tillmann Rendel
rendel at Mathematik.Uni-Marburg.de
Wed Aug 11 14:50:35 EDT 2010
Will Jones wrote:
> > f :: Int -> IO ()
> > f = undefined
>
> > g :: Int -> Int -> IO ()
> > g = undefined
>
> > h :: Int -> Int -> Int -> IO ()
> > h = undefined
>
> vtuple f :: IO (Int -> (Int, ()))
> vtuple g :: IO (Int -> Int -> (Int, (Int, ())))
>
> I've tried to type vtuple using a type class; [...]
>
> I've thought about it and it seems impossible to solve this problem
> -- you keep needing to ``split'' the function type one arrow further on.
So you need to use recursion to handle the arbitrary deeply nested
arrows in the type of vtuple's argument. I tried it with type families,
but I don't see a reason why functional dependencies should not work.
{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
module VTupleWithTypeFamilies where
We use two type families to handle the two places where the result type
of vtuple changes for different argument types.
type family F a
type family G a r
So the intention is that the type of vtuple is as follows.
class VTuple a where
vtuple :: a -> IO (G a (F a))
The base case:
type instance F (IO ()) = ()
type instance G (IO ()) r = r
instance VTuple (IO ()) where
vtuple = undefined
And the step case:
type instance F (a -> b) = (a, F b)
type instance G (a -> b) r = a -> G b r
instance VTuple b => VTuple (a -> b) where
vtuple = undefined
A test case:
f :: Int -> Bool -> Char -> Double -> IO ()
f = undefined
test = do
vt <- vtuple f
return (vt 5 True 'x' 1.3)
Testing it with ghci yields the following type for test, which looks
good to me.
test :: IO (Int, (Bool, (Char, (Double, ()))))
HTH, Tillmann
More information about the Haskell-Cafe
mailing list