[Haskell-cafe] Accepting and returning polyvariadic functions
Will Jones
will at sacharissa.co.uk
Wed Aug 11 11:50:55 EDT 2010
Hi all,
I'm trying to write a function (I'll call it `vtuple' for lack of a better
name)
that returns a function that itself returns multiple arguments in the form
of a
tuple. For example:
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE FunctionalDependencies #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> 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; my current effort is something
like:
> class VTuple ia ir a r | r -> a, a -> ia where
> vtuple :: (ia -> ir) -> IO (a -> r)
> instance VTuple Int (IO ()) Int (Int, ()) where
> --vtuple :: (Int -> IO ()) -> IO (Int -> (Int, ()))
> vtuple = undefined
> instance VTuple ia ir a r
> => VTuple Int (ia -> ir) Int (a -> (Int, r)) where
> --vtuple :: (Int -> ia -> ir) -> IO (Int -> a -> (Int, r))
> vtuple = undefined
But this is problematic, since arrows creep in:
For one argument (fine):
vtuple :: (Int -> IO ()) -> IO (Int -> (Int, ()))
> vf :: IO (Int -> (Int, ()))
> vf = vtuple f
For two arguments (also fine):
vtuple :: (Int -> Int -> IO ())
-> IO (Int -> Int -> (Int, (Int, ())))
> vg :: IO (Int -> Int -> (Int, (Int, ())))
> vg = vtuple g
For three (noooo!):
vtuple :: (Int -> Int -> IO ())
-> IO (Int -> Int -> (Int, (Int -> (Int32, (Int32, ())))))
And so on. 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. Is
this a job for Template Haskell or is there a solution I'm missing here?
Note
that I'd also like to use types other than Int, but I don't think this is
the
primary complication here (touch wood).
Any help much appreciated, thanks,
Will
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100811/59253caf/attachment.html
More information about the Haskell-Cafe
mailing list