diff options
Diffstat (limited to '')
| -rw-r--r-- | HsbotIrcBot/.gitignore | 1 | ||||
| -rw-r--r-- | HsbotMaster/Hsbot/Core.hs | 14 | ||||
| -rw-r--r-- | HsbotMaster/Main.hs | 102 | ||||
| -rw-r--r-- | HsbotMaster/hsbot.cabal | 7 |
4 files changed, 68 insertions, 56 deletions
diff --git a/HsbotIrcBot/.gitignore b/HsbotIrcBot/.gitignore index a5aa1b9..feb4e56 100644 --- a/HsbotIrcBot/.gitignore +++ b/HsbotIrcBot/.gitignore @@ -1,2 +1,3 @@ .*.swp Session.vim +dist diff --git a/HsbotMaster/Hsbot/Core.hs b/HsbotMaster/Hsbot/Core.hs index dad965d..d634f10 100644 --- a/HsbotMaster/Hsbot/Core.hs +++ b/HsbotMaster/Hsbot/Core.hs @@ -24,13 +24,13 @@ hsbot config txtResumeData= do Just txtData -> read txtData :: BotResumeData -- TODO : catch exception Nothing -> M.empty :: BotResumeData startTime <- case M.lookup "HSBOT" resumeData of - Just hsbotData -> do - case M.lookup "STARTTIME" hsbotData of - Just txtStartTime -> do - let gotStartTime = read txtStartTime :: UTCTime - return gotStartTime - Nothing -> getCurrentTime - Nothing -> getCurrentTime + Just hsbotData -> do + case M.lookup "STARTTIME" hsbotData of + Just txtStartTime -> do + let gotStartTime = read txtStartTime :: UTCTime + return gotStartTime + Nothing -> getCurrentTime + Nothing -> getCurrentTime let resumeData' = M.insert "HSBOT" (M.singleton "STARTTIME" $ show startTime) resumeData putStrLn "[Hsbot] Opening communication channel... " chan <- newChan :: IO (Chan BotMsg) diff --git a/HsbotMaster/Main.hs b/HsbotMaster/Main.hs index 5e528ca..ceac5d7 100644 --- a/HsbotMaster/Main.hs +++ b/HsbotMaster/Main.hs @@ -2,57 +2,73 @@ module Main (main) where import Control.Monad (when) import Prelude hiding (catch) -import System.Directory +import System.Console.GetOpt import System.Environment import System.Exit -import System.FilePath -import System.Info import System.IO -import System.Posix.Process (executeFile) -import System.Process --- | Dynamic launching function +-- | Main function main :: IO () main = do args <- getArgs - case args of - [] -> buildLaunch - ["--help"] -> usage - _ -> fail "unrecognized flags" + -- Parse options, getting a list of option actions + let (actions, nonOptions, errors) = getOpt RequireOrder options args + -- Here we thread startOptions through all supplied option actions + opts <- case (nonOptions, errors) of + ([], []) -> foldl (>>=) (return defaultOptions) actions + (_, _) -> do + hPutStrLn stderr $ concat errors ++ usageInfo header options + exitWith $ ExitFailure 1 + when (optDebug opts) . putStrLn $ "Got options : " ++ (show opts) -usage :: IO () -usage = do - self <- getProgName - putStr . unlines $ - concat ["Usage: ", self, " [OPTION]"] : - "Options:" : - " --help : Print this message" : - [] +-- | CLI options +data Options = Options + { optDebug :: Bool + , optConfigFile :: Maybe String + , optGroup :: Maybe String + , optUser :: Maybe String + , optVerbose :: Bool + } deriving (Show) -buildLaunch :: IO () -buildLaunch = do - _ <- recompile - dir <- getAppUserDataDirectory "hsbot" - args <- getArgs - _ <- executeFile (dir ++ "/hsbot-" ++ arch ++ "-" ++ os) False args Nothing - return () +-- | CLI default options +defaultOptions :: Options +defaultOptions = Options { optDebug = False + , optConfigFile = Nothing + , optGroup = Nothing + , optUser = Nothing + , optVerbose = False } + +-- | CLI options logic +options :: [ OptDescr (Options -> IO Options) ] +options = + [ Option "d" ["debug"] + (NoArg (\opt -> return opt { optDebug = True, optVerbose = True })) + "Enter verbose debug mode and prevents Hsbot from forking in background" + , Option "f" ["file"] + (ReqArg (\arg opt -> return opt { optConfigFile = return arg }) "<config_file>") + "The config file to use" + , Option "g" ["group"] + (ReqArg (\arg opt -> return opt { optGroup = return arg }) "<group>") + "The group hsbot will run as" + , Option "h" ["help"] + (NoArg (\_ -> do + putStrLn $ usageInfo header options + exitWith ExitSuccess)) + "Print this help message" + , Option "u" ["user"] + (ReqArg (\arg opt -> return opt { optUser = return arg }) "<user>") + "The user hsbot will run as" + , Option "v" ["verbose"] + (NoArg (\opt -> return opt { optVerbose = True })) + "Enable verbose messages" + , Option "V" ["version"] + (NoArg (\_ -> do + putStrLn "Hsbot version 0.3" + exitWith ExitSuccess)) + "Show version" + ] -recompile :: IO (Bool) -recompile = do - dir <- getAppUserDataDirectory "hsbot" - let binn = "hsbot-"++arch++"-"++os - base = dir </> "hsbot" - err = base ++ ".errors" - src = base ++ ".hs" - errorHandle <- openFile err WriteMode - exitCode <- waitForProcess =<< runProcess "ghc" ["--make", "hsbot.hs", "-fforce-recomp", "-XScopedTypeVariables", "-o", binn] (Just dir) - Nothing Nothing Nothing (Just errorHandle) - hClose errorHandle - when (exitCode /= ExitSuccess) $ do - ghcErr <- readFile err - let msg = unlines $ - ["Error detected while loading hsbot configuration file: " ++ src] - ++ lines ghcErr ++ ["","Please check the file for errors."] - hPutStrLn stderr msg - return (exitCode == ExitSuccess) +-- | Usage header +header :: String +header = "Usage: hsbot [-dhvV] [-f config_file] [-u user] [-g group]" diff --git a/HsbotMaster/hsbot.cabal b/HsbotMaster/hsbot.cabal index d3ee0ce..7cce1da 100644 --- a/HsbotMaster/hsbot.cabal +++ b/HsbotMaster/hsbot.cabal @@ -20,17 +20,12 @@ Executable hsbot Main-is: Main.hs Ghc-options: -Wall Extensions: DeriveDataTypeable ScopedTypeVariables - Build-depends: base >= 4.1 && < 5, - directory >= 1.0, - filepath >= 1.1, - process >= 1.0, - unix >= 2.4 + Build-depends: base >= 4.1 && < 5 Library Ghc-options: -Wall Extensions: DeriveDataTypeable ScopedTypeVariables Exposed-modules: Hsbot.Message, - Hsbot.PluginUtils, Hsbot.Types Build-depends: base >= 4.1 && < 5, containers >= 0.3, |