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
|
||||
Session.vim
|
||||
dist
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 }
|
||||
|
||||
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)
|
||||
-- | 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"
|
||||
]
|
||||
|
||||
-- | 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
|
||||
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,
|
||||
|
|
Reference in a new issue