{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS -fallow-undecidable-instances -fno-monomorphism-restriction -fallow-overlapping-instances #-} -- | Provide a @getArgs@ function that returns a tuple (including the 0-tuple @()@ or 1-tuple) -- if the supplied arguments match the demands of the program, in number and in type. -- The returned tuple must contain elements that are in the @Typeable@ and @Read@ classes. -- -- Here's how to do a line count, @getArgs@ takes a single argument, returning it -- as a @String@: -- -- > main = getArgs >>= readFile >>= print . length . lines -- -- Two different parameters, a @Char@ and a @String@: -- -- > main = do -- > (ch,name) <- getArgs -- > putStrLn (ch:"Name is: "++name) module System.SimpleArgs (Args, getArgs) where import qualified System.Environment as S (getArgs) import Data.Dynamic (Typeable, typeOf) class Args a where -- | Return appropriately typed program arguments. getArgs :: IO a argerror :: Typeable a => Int -> [String] -> a argerror n xs = let ret = error ("Incorrect number of arguments, got "++show (length xs)++",\n" ++"expected "++show n ++ " "++show (typeOf ret)) in ret instance Args () where getArgs = S.getArgs >>= return . g where g [] = () g xs = argerror 0 xs instance (Read b, Typeable b) => Args b where getArgs = S.getArgs >>= return . g where g [x] = myread x g xs = argerror 1 xs instance (Read x, Typeable x, Read y, Typeable y) => Args (x,y) where getArgs = S.getArgs >>= return . g where g [x1,x2] = (myread x1,myread x2) g xs = argerror 2 xs instance (Read t1, Typeable t1,Read t2, Typeable t2,Read t3, Typeable t3) => Args (t1,t2,t3) where getArgs = S.getArgs >>= return . g where g [x1,x2,x3] = (myread x1,myread x2,myread x3) g xs = argerror 3 xs instance (Read t1,Typeable t1,Read t2,Typeable t2,Read t3,Typeable t3,Read t4,Typeable t4) => Args (t1,t2,t3,t4) where getArgs = S.getArgs >>= return . g where g [x1,x2,x3,x4] = (myread x1,myread x2,myread x3,myread x4) g xs = argerror 4 xs instance (Read t1,Typeable t1,Read t2,Typeable t2,Read t3,Typeable t3,Read t4,Typeable t4,Read t5,Typeable t5) => Args (t1,t2,t3,t4,t5) where getArgs = S.getArgs >>= return . g where g [x1,x2,x3,x4,x5] = (myread x1,myread x2,myread x3,myread x4,myread x5) g xs = argerror 5 xs -- | Attempt to parse the parameter as various types myread :: (Typeable a, Read a) => String -> a myread s = let ret = case map reads [s,sq s,dq s,lq s] of ([(x,"")]:_) -> x (_:[(c,"")]:_) -> c (_:_:[(str,"")]:_) -> str (_:_:_:[(l,"")]:_) -> l _ -> error ("Couldn't parse parameter "++show s++" as type "++show (typeOf ret)) in ret where -- different types of quoting sq x = "'"++x++"'" dq x = "\""++x++"\"" lq x = "["++x++"]"