10

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?

3 Answers 3

12

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"
1
  • See also Text.Printf in the standard library, which does the same thing, more or less. Note that providing the wrong number of arguments is a runtime error, not a type error. Apr 12, 2012 at 13:14
2

You might want to make use of existing libraries to deal with command line arguments. I believe the de-facto standard right now is cmdargs, but other options exist, such as ReadArgs and console-program.

1

Combinators are your friend. Try this:

take1 :: [String] -> Maybe String
take1 [x] = Just x
take1 _ = Nothing

take2 :: [String] -> Maybe (String,String)
take2 [x,y] = Just (x,y)
take2 _ = Nothing

take3 :: [String] -> Maybe ((String,String),String)
take3 [x,y,z] = Just ((x,y),z)
take3 _ = Nothing

type ErrorMsg = String

with1 :: (String -> IO ()) -> ErrorMsg -> [String] -> IO ()
with1 f msg = maybe (fail msg) f . take1

with2 :: (String -> String -> IO ()) -> ErrorMsg -> [String] -> IO ()
with2 f msg = maybe (fail msg) (uncurry f) . take2

with3 :: (String -> String -> String -> IO ()) -> ErrorMsg -> [String] -> IO ()
with3 f msg = maybe (fail msg) (uncurry . uncurry $ f) . take3

foo a b c = putStrLn $ a ++ " :: " ++ b ++ " = " ++ c

bar = with3 foo "You must send foo a name, type, definition"

main = do
  bar [ "xs", "[Int]", "[1..3]" ]
  bar [ "xs", "[Int]", "[1..3]", "What am I doing here?" ]

And if you like overpowered language extensions:

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}

foo a b c = putStrLn $ a ++ " :: " ++ b ++ " = " ++ c
foo_msg = "You must send foo a name, type, definition"

class ApplyArg a b | a -> b where
  appArg :: ErrorMsg -> a -> [String] -> IO b

instance ApplyArg (IO b) b where
  appArg _msg todo [] = todo
  appArg msg _todo _ = fail msg

instance ApplyArg v q => ApplyArg (String -> v) q where
  appArg msg todo (x:xs) = appArg msg (todo x) xs
  appArg msg _todo _ = fail msg

quux :: [String] -> IO ()
quux xs = appArg foo_msg foo xs

main = do
  quux [ "xs", "[int]", "[1..3]" ]
  quux [ "xs", "[int]", "[1..3]", "what am i doing here?" ]

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.