Got rid of the pseudo dynamic starting stuff, wrote a decent CLI parameters handling.
This commit is contained in:
parent
116c655fdc
commit
5cb9f9ccfc
4 changed files with 68 additions and 56 deletions
1
HsbotIrcBot/.gitignore
vendored
1
HsbotIrcBot/.gitignore
vendored
|
@ -1,2 +1,3 @@
|
||||||
.*.swp
|
.*.swp
|
||||||
Session.vim
|
Session.vim
|
||||||
|
dist
|
||||||
|
|
|
@ -2,57 +2,73 @@ module Main (main) where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Prelude hiding (catch)
|
import Prelude hiding (catch)
|
||||||
import System.Directory
|
import System.Console.GetOpt
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.FilePath
|
|
||||||
import System.Info
|
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Posix.Process (executeFile)
|
|
||||||
import System.Process
|
|
||||||
|
|
||||||
-- | Dynamic launching function
|
-- | Main function
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
case args of
|
-- Parse options, getting a list of option actions
|
||||||
[] -> buildLaunch
|
let (actions, nonOptions, errors) = getOpt RequireOrder options args
|
||||||
["--help"] -> usage
|
-- Here we thread startOptions through all supplied option actions
|
||||||
_ -> fail "unrecognized flags"
|
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 ()
|
-- | CLI options
|
||||||
usage = do
|
data Options = Options
|
||||||
self <- getProgName
|
{ optDebug :: Bool
|
||||||
putStr . unlines $
|
, optConfigFile :: Maybe String
|
||||||
concat ["Usage: ", self, " [OPTION]"] :
|
, optGroup :: Maybe String
|
||||||
"Options:" :
|
, optUser :: Maybe String
|
||||||
" --help : Print this message" :
|
, optVerbose :: Bool
|
||||||
[]
|
} deriving (Show)
|
||||||
|
|
||||||
buildLaunch :: IO ()
|
-- | CLI default options
|
||||||
buildLaunch = do
|
defaultOptions :: Options
|
||||||
_ <- recompile
|
defaultOptions = Options { optDebug = False
|
||||||
dir <- getAppUserDataDirectory "hsbot"
|
, optConfigFile = Nothing
|
||||||
args <- getArgs
|
, optGroup = Nothing
|
||||||
_ <- executeFile (dir ++ "/hsbot-" ++ arch ++ "-" ++ os) False args Nothing
|
, optUser = Nothing
|
||||||
return ()
|
, optVerbose = False }
|
||||||
|
|
||||||
recompile :: IO (Bool)
|
-- | CLI options logic
|
||||||
recompile = do
|
options :: [ OptDescr (Options -> IO Options) ]
|
||||||
dir <- getAppUserDataDirectory "hsbot"
|
options =
|
||||||
let binn = "hsbot-"++arch++"-"++os
|
[ Option "d" ["debug"]
|
||||||
base = dir </> "hsbot"
|
(NoArg (\opt -> return opt { optDebug = True, optVerbose = True }))
|
||||||
err = base ++ ".errors"
|
"Enter verbose debug mode and prevents Hsbot from forking in background"
|
||||||
src = base ++ ".hs"
|
, Option "f" ["file"]
|
||||||
errorHandle <- openFile err WriteMode
|
(ReqArg (\arg opt -> return opt { optConfigFile = return arg }) "<config_file>")
|
||||||
exitCode <- waitForProcess =<< runProcess "ghc" ["--make", "hsbot.hs", "-fforce-recomp", "-XScopedTypeVariables", "-o", binn] (Just dir)
|
"The config file to use"
|
||||||
Nothing Nothing Nothing (Just errorHandle)
|
, Option "g" ["group"]
|
||||||
hClose errorHandle
|
(ReqArg (\arg opt -> return opt { optGroup = return arg }) "<group>")
|
||||||
when (exitCode /= ExitSuccess) $ do
|
"The group hsbot will run as"
|
||||||
ghcErr <- readFile err
|
, Option "h" ["help"]
|
||||||
let msg = unlines $
|
(NoArg (\_ -> do
|
||||||
["Error detected while loading hsbot configuration file: " ++ src]
|
putStrLn $ usageInfo header options
|
||||||
++ lines ghcErr ++ ["","Please check the file for errors."]
|
exitWith ExitSuccess))
|
||||||
hPutStrLn stderr msg
|
"Print this help message"
|
||||||
return (exitCode == ExitSuccess)
|
, 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"
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | Usage header
|
||||||
|
header :: String
|
||||||
|
header = "Usage: hsbot [-dhvV] [-f config_file] [-u user] [-g group]"
|
||||||
|
|
||||||
|
|
|
@ -20,17 +20,12 @@ Executable hsbot
|
||||||
Main-is: Main.hs
|
Main-is: Main.hs
|
||||||
Ghc-options: -Wall
|
Ghc-options: -Wall
|
||||||
Extensions: DeriveDataTypeable ScopedTypeVariables
|
Extensions: DeriveDataTypeable ScopedTypeVariables
|
||||||
Build-depends: base >= 4.1 && < 5,
|
Build-depends: base >= 4.1 && < 5
|
||||||
directory >= 1.0,
|
|
||||||
filepath >= 1.1,
|
|
||||||
process >= 1.0,
|
|
||||||
unix >= 2.4
|
|
||||||
|
|
||||||
Library
|
Library
|
||||||
Ghc-options: -Wall
|
Ghc-options: -Wall
|
||||||
Extensions: DeriveDataTypeable ScopedTypeVariables
|
Extensions: DeriveDataTypeable ScopedTypeVariables
|
||||||
Exposed-modules: Hsbot.Message,
|
Exposed-modules: Hsbot.Message,
|
||||||
Hsbot.PluginUtils,
|
|
||||||
Hsbot.Types
|
Hsbot.Types
|
||||||
Build-depends: base >= 4.1 && < 5,
|
Build-depends: base >= 4.1 && < 5,
|
||||||
containers >= 0.3,
|
containers >= 0.3,
|
||||||
|
|
Reference in a new issue