Come evitare la scrittura del codice di codice per le funzioni che eseguono la corrispondenza del modello?

Question

In this response a another question, è stato fornito un piccolo schizzo del codice Haskell che utilizza le funzioni wrapper per calcolare il codice per eseguire il controllo della sintassi sugli argomenti della riga di comando. Ecco la parte del codice che sto cercando di semplificare:

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'è un modo (magari usando Template Haskell?) Per evitare di dover scrivere funzioni extra per ogni numero di argomenti? Idealmente, mi piacerebbe essere in grado di scrivere qualcosa di simile (sto facendo questa sintassi up)

generateArgumentWrapper<2, showUsageMessage> 

E che si espande a

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

Idealmente, avrei potuto anche avere un numero variabile di argomenti della meta-funzione di generateArgumentWrapper, in modo che potessi fare

generateArgumentWrapper<2, asInt, asFilePath, showUsageMessage> 

E che si espande a

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

Qualcuno è a conoscenza di un modo per raggiungere questo obiettivo? Sarebbe un modo davvero semplice per legare gli argomenti della riga di comando() a funzioni arbitrarie. O forse esiste un approccio totalmente diverso e migliore?

Answer 1

Haskell ha funzioni polyvariadic. Immagina di avere un tipo come

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

con alcune funzioni per fare quello che vuoi

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" 

ora, tutto quello che serve è quello maresciallo funzioni in questo tipo Act. Avete bisogno di alcune estensioni

{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} 

e quindi è possibile definire

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

ora è possibile definire

takeNArgs n act = takeNargs' n (makeAct act) 

che rende più facile per definire le funzioni originali

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

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

Ma possiamo fare anche meglio

takeTheRightNumArgs f = takeNArgs (numberOfArgs f) f 

Sorprendentemente, questo funziona (GHCI)

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

---

Edit: Il codice di cui sopra è molto più complicato di quanto dovrebbe essere.In realtà, tutto quello che volete è

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

Gli abbinatori sono tuoi amici. Prova questo:

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

E se ti piace sopraffatto estensioni del linguaggio:

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

si potrebbe desiderare di fare uso di librerie esistenti a che fare con gli argomenti della riga di comando. Credo che lo standard di fatto in questo momento sia cmdargs, ma esistono altre opzioni, come ReadArgs e console-program.