{-# 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++"]"