module System.SimpleArgs (Args, getArgs) where
import qualified System.Environment as S (getArgs)
import Data.Dynamic (Typeable, typeOf)
class Args a where
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
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
sq x = "'"++x++"'"
dq x = "\""++x++"\""
lq x = "["++x++"]"