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