如何避免为执行模式匹配的函数编写样板代码？

Question

在this response到another question，给出了一个小Haskell代码草图，它使用包装函数来分解一些代码，用于在命令行参数上进行语法检查。下面是我正在试图简化代码的一部分：

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 

有没有一种方法（可能使用Template Haskell？），以避免编写额外的函数的参数各是多少？理想情况下，我想能够写类似（我在做这个语法上）

generateArgumentWrapper<2, showUsageMessage> 

这扩展到

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

理想情况下，我甚至可以有不同数量的参数传递给generateArgumentWrapper元的功能，这样我就可以做

generateArgumentWrapper<2, asInt, asFilePath, showUsageMessage> 

这扩展到

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

有没有人知道一种方法来实现这一目标？将命令行参数（[String]）绑定到任意函数将是一种非常简单的方法。或者可能有一个完全不同的，更好的方法？

Answer 1

Haskell有polyvariadic功能。想象一下，你有一个像类型

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

一些功能做你想做

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" 

现在是怎样，你所有你需要的是元帅功能集成到这个Act类型。你需要一些扩展

{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} 

，然后你可以定义

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 "") 

现在你可以定义

takeNArgs n act = takeNargs' n (makeAct act) 

这使得它更容易地定义你的原有功能

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

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

但我们甚至可以做到更好

takeTheRightNumArgs f = takeNArgs (numberOfArgs f) f 

令人惊讶的是，这个工程（GHCI）

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

---

编辑：上面的代码要复杂得多它需要。真的，所有你想要的是

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" 

Answer 2

Combinators是你的朋友。试试这个：

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?" ] 

，如果你喜欢制服语言扩展：

{-# 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?" ] 

Answer 3

你可能想要利用现有的库来处理命令行参数。我相信现在的实际标准是cmdargs，但也有其他选择，例如ReadArgs和console-program。