----------------------------------------------------------------------------- -- | -- Module : Windll -- Copyright : (c) Tamar Christina 2009 - 2010 -- License : BSD3 -- -- Maintainer : tamar@zhox.com -- Stability : experimental -- Portability : portable -- -- A module to handle commandline arguments and parsing -- for the main program. -- ----------------------------------------------------------------------------- module WinDll.CmdArgs.Debug where import WinDll.Session.Debug import WinDll.Version.Debug import System.Directory import System.Environment import System.FilePath import System.Console.GetOpt import System.Exit import Data.Maybe import Data.Char import Data.List import Control.Monad -- | just renaming it to something that might make more sense to read in this module type Config = Session -- | The parse mode for processArgs type Mode = Platform -- | Process args tries to parse the commandline arguments for either the client or the server. -- 1 = The session to initialize things with -- 2 = Mode to parse for -- 3 = arguments to parse -- return = Parsed config or error message processArgs :: Config -> Mode -> [String] -> IO (Config, [String]) processArgs cfg mode argv= case getOpt Permute opt argv of (o,n,[]) -> process (foldl (flip id) cfg o) n opt (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header opt)) where header = "Usage: " ++ name ++ " [OPTION...]" name = if mode == Windows then exename ++ ".exe" else exename opt = optDescr --if mode == Windows then optDescrClient else optDescrServer process a r opt = case Help `elem` opts of True -> ioError (userError $ usageInfo header opt) False -> case Version `elem` opts of True -> putStrLn versionmsg >> exitSuccess False -> case r of (x:[]) -> do base <- getCurrentDirectory let dir = takeDirectory (normalise x) bin = combine base dir path <- guessPath x return (a { mainFile = x , absPath = path , baseDir = bin },[]) _ -> ioError (userError $ usageInfo header opt) where opts = options a -- | Create a boolean flag boolFlag :: String -> String -> (a->Bool->a) -> String -> [OptDescr (a->a)] boolFlag short long update descr = [ template (update' True) short long descr , template (update' False) "" ("no"++long) [] ] where template value short long descr = Option short [long] (NoArg value) descr update' = flip update -- | Collection of options available optDescr = optVerbose : optOutDir : optOutFile : optVersion : [optHelp] -- | Collection of simple actions optVerbose = Option ['v'] ["verbose","verbosity" ] (OptArg (\value cfg -> cfg { verbosity = fread (verbosity cfg) value }) "") "set the verbosity level. Requires a number between 0 (off) and 3" optOutDir = Option [ ] ["outdir","output-directory"] (ReqArg (\value cfg -> cfg { outputDIR = value }) "") "set the output directory of the pre-processor (Default current folder)" optOutFile = Option ['o'] ["out","outFile" ] (ReqArg (\value cfg -> cfg { outputFile = value }) "") "set the name of the output file (Default derived from input and platform)" optHelp = Option ['?'] ["h","help" ] (NoArg (\cfg -> cfg {options = Help:(options cfg)}) ) "Show this help screen" optVersion = Option [ ] ["version" ] (NoArg (\cfg -> cfg {options = Version:(options cfg)}) ) "Show program version information" fread :: Int -> Maybe String -> Int fread c q = let p = maybe 1 (read' 1) q in if (p + c) > 3 || (c + p) < 0 then 1 else (c+p) cread c q = let p = reads q hasValue = not $ null p value = if hasValue then fst $ head p else c in value -- | Get the read in namespace name into a useable format correct :: String -> String correct [] = [] correct (x:xs) = toUpper x : filter isAlphaNum xs -- | Because read can fail for parsing stuff other than strings. -- this function is used to either accept the change. or use the default read' :: Int -> String -> Int read' def str = let r = reads str in if null r then def else (fst.head) r -- | The main parse function to call. It takes a mode as parameters and takes a pointer -- to a function to call should it all succeed. goArgs :: Mode -> (Config -> IO ()) -> IO () goArgs mode call = do args <- getArgs (result,errs) <- processArgs newSession mode args if (not.null) errs then putStrLn " Errors:" else do return () mapM_ (\i -> putStrLn (" -> unrecognized input '"++i++"')")) errs if null errs then call result else do return ()