Debug.hs

-----------------------------------------------------------------------------
-- |
-- 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 ++ " <input file> [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  }) "<number>") "set the verbosity level. Requires a number between 0 (off) and 3"
optOutDir         = Option [   ] ["outdir","output-directory"] (ReqArg (\value cfg -> cfg { outputDIR        = value }) "<output-directory>")              "set the output directory of the pre-processor (Default current folder)"
optOutFile        = Option ['o'] ["out","outFile"            ] (ReqArg (\value cfg -> cfg { outputFile       = value }) "<output-file>")                   "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 ()