How can I avoid writing boilerplate code for functions performing pattern matching?

Question

In this response to another question, a little Haskell code sketch was given which uses wrapper functions to factor out some code for doing syntax checking on command line arguments. Here's the part of the code which I'm trying to simplify:

takesSingleArg :: (String -> IO ()) -> [String] -> IO ()
takesSingleArg act [arg] = act arg
takesSingleArg _   _     = showUsageMessage

takesTwoArgs :: (String -> String -> IO ()) -> [String] -> IO ()
takesTwoArgs act [arg1, arg2] = act arg1 arg2
takesTwoArgs _   _            = showUsageMessage

Is there a way (maybe using Template Haskell?) to avoid having to write extra functions for each number of arguments? Ideally, I'd like to be able to write something like (I'm making this syntax up)

generateArgumentWrapper<2, showUsageMessage>

And that expands to

\fn args -> case args of
                 [a, b] -> fn a b
                 _      -> showUsageMessage

Ideally, I could even have a variable number of arguments to the generateArgumentWrapper meta-function, so that I could do

generateArgumentWrapper<2, asInt, asFilePath, showUsageMessage>

And that expands to

\fn args -> case args of
                 [a, b] -> fn (asInt a) (asFilePath b)
                 _      -> showUsageMessage

Is anybody aware of a way to achieve this? It would be a really easy way to bind command line arguments ([String]) to arbitrary functions. Or is there maybe a totally different, better approach?

Answer 1

Haskell has polyvariadic functions. Imagine you had a type like

data Act = Run (String -> Act) | Res (IO ())

with some functions to do what you want

runAct (Run f) x = f x
runAct (Res _) x = error "wrong function type"

takeNargs' 0 (Res b) _ = b
takeNargs' 0 (Run _) _ = error "wrong function type"
takeNargs' n act (x:xs) = takeNargs' (n-1) (runAct act x) xs
takeNargs' _ _ [] = error "not long enough list"

now, all you you need is to marshal functions into this Act type. You need some extensions

{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}

and then you can define

class Actable a where
  makeAct :: a -> Act
  numberOfArgs :: a -> Int

instance Actable (String -> IO ()) where
  makeAct f = Run $ Res . f
  numberOfArgs _ = 1

instance Actable (b -> c) => Actable (String -> (b -> c)) where
  makeAct f = Run $ makeAct . f
  numberOfArgs f = 1 + numberOfArgs (f "")

now you can define

takeNArgs n act = takeNargs' n (makeAct act) 

which makes it easier to define your original functions

takesSingleArg :: (String -> IO ()) -> [String] -> IO ()
takesSingleArg = takeNArgs 1

takesTwoArgs :: (String -> String -> IO ()) -> [String] -> IO ()
takesTwoArgs = takeNArgs 2

But we can do even better

takeTheRightNumArgs f = takeNArgs (numberOfArgs f) f

Amazingly, this works (GHCI)

*Main> takeTheRightNumArgs putStrLn ["hello","world"]
hello
*Main> takeTheRightNumArgs (\x y -> putStrLn x >> putStrLn y)  ["hello","world"] 
hello
world

---

Edit: The code above is much more complicated than it needs to be. Really, all you want is

class TakeArgs a where
   takeArgs :: a -> [String] -> IO ()

instance TakeArgs (IO ()) where
   takeArgs a _ = a

instance TakeArgs a => TakeArgs (String -> a) where
   takeArgs f (x:xs) = takeArgs (f x) xs
   takeArgs f [] = error "end of list"