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

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] )绑定(bind)到任意函数将是一种非常简单的方法。或者是否有完全不同的更好的方法？

Answer 1

Haskell 具有多变量函数。想象一下你有一个像

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"