Làm cách nào để tránh viết mã bản mẫu cho các chức năng thực hiện khớp mẫu?

Question

Trong this response đến another question, một chút phác thảo mã Haskell đã được đưa ra trong đó sử dụng hàm wrapper để yếu tố ra một số mã để thực hiện kiểm tra cú pháp trên các đối số dòng lệnh. Đây là một phần của mã mà tôi đang cố gắng để đơn giản hóa:

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 

Có cách nào (có thể sử dụng Template Haskell?) Để tránh phải viết chức năng bổ sung cho mỗi số lập luận? Lý tưởng nhất, tôi muốn để có thể viết một cái gì đó tương tự (Tôi đang làm cú pháp này lên)

generateArgumentWrapper<2, showUsageMessage> 

Và đó mở rộng để

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

Lý tưởng nhất, tôi thậm chí có thể có một số biến đối số cho các generateArgumentWrapper meta-chức năng, do đó tôi có thể làm

generateArgumentWrapper<2, asInt, asFilePath, showUsageMessage> 

Và đó mở rộng để

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

Có ai biết cách để đạt được điều này không? Nó sẽ là một cách thực sự dễ dàng để ràng buộc các đối số dòng lệnh ([String]) với các hàm tùy ý. Hay liệu có cách tiếp cận hoàn toàn khác, tốt hơn?

Answer 1

Haskell có chức năng polyvariadic. Hãy tưởng tượng bạn có một loại giống như

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

với một số chức năng để làm những gì bạn muốn

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" 

bây giờ, tất cả các bạn bạn cần là để marshal chức năng vào Act loại này. Bạn cần một số phần mở rộng

{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} 

và sau đó bạn có thể định nghĩa

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

bây giờ bạn có thể định nghĩa

takeNArgs n act = takeNargs' n (makeAct act) 

mà làm cho nó dễ dàng hơn để xác định chức năng ban đầu của bạn

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

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

Nhưng chúng ta có thể làm ngay cả tốt hơn

takeTheRightNumArgs f = takeNArgs (numberOfArgs f) f 

Thật ngạc nhiên, công trình này (GHCI)

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

---

Edit: Đoạn mã trên là phức tạp hơn nhiều so với nó cần phải được.Thực sự, tất cả những gì bạn muốn là

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

Kết hợp là bạn của bạn. Hãy thử điều này:

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

Và nếu bạn thích áp đảo mở rộng ngôn ngữ:

{-# 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

Bạn có thể muốn sử dụng các thư viện hiện có để xử lý các đối số dòng lệnh. Tôi tin tiêu chuẩn thực tế hiện tại là cmdargs, nhưng các tùy chọn khác tồn tại, chẳng hạn như ReadArgs và console-program.