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 argum

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"