Added the cli parser and a config file handler for hsbot-irc.
This commit is contained in:
parent
5cb9f9ccfc
commit
6888950b60
4 changed files with 216 additions and 4 deletions
|
@ -1,14 +1,18 @@
|
||||||
module Hsbot.Irc.Config
|
module Hsbot.Irc.Config
|
||||||
( IrcConfig(..)
|
( IrcConfig(..)
|
||||||
, ircDefaultConfig
|
, ircDefaultConfig
|
||||||
|
, getIrcConfig
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import qualified Data.ConfigFile as C
|
||||||
|
import Data.Either.Utils
|
||||||
import Network
|
import Network
|
||||||
|
import System.Exit
|
||||||
|
import System.Posix.Files
|
||||||
|
|
||||||
-- | Configuration data type
|
-- | Configuration data type
|
||||||
data IrcConfig = IrcConfig
|
data IrcConfig = IrcConfig
|
||||||
{ ircConfigName :: String -- The configuration name
|
{ ircConfigAddress :: String -- the server's address
|
||||||
, ircConfigAddress :: String -- the server's address
|
|
||||||
, ircConfigPort :: PortID -- the server's port
|
, ircConfigPort :: PortID -- the server's port
|
||||||
, ircConfigChannels :: [String] -- the Channels to join on start
|
, ircConfigChannels :: [String] -- the Channels to join on start
|
||||||
, ircConfigNickname :: String -- the hsbot's nickname
|
, ircConfigNickname :: String -- the hsbot's nickname
|
||||||
|
@ -21,8 +25,7 @@ data IrcConfig = IrcConfig
|
||||||
-- | User configuration
|
-- | User configuration
|
||||||
ircDefaultConfig :: IrcConfig
|
ircDefaultConfig :: IrcConfig
|
||||||
ircDefaultConfig = IrcConfig
|
ircDefaultConfig = IrcConfig
|
||||||
{ ircConfigName = "irc-alocalhost"
|
{ ircConfigAddress = "localhost"
|
||||||
, ircConfigAddress = "localhost"
|
|
||||||
, ircConfigPort = PortNumber 6667
|
, ircConfigPort = PortNumber 6667
|
||||||
, ircConfigChannels = ["#hsbot"]
|
, ircConfigChannels = ["#hsbot"]
|
||||||
, ircConfigNickname = "hsbot"
|
, ircConfigNickname = "hsbot"
|
||||||
|
@ -32,3 +35,70 @@ ircDefaultConfig = IrcConfig
|
||||||
, ircConfigPlugins = ["Ping"]
|
, ircConfigPlugins = ["Ping"]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | config file retrieving
|
||||||
|
getIrcConfig :: Maybe String -> IO (IrcConfig)
|
||||||
|
getIrcConfig maybePath =
|
||||||
|
case maybePath of
|
||||||
|
Just path -> do
|
||||||
|
doesFileExists <- fileExist path
|
||||||
|
case doesFileExists of
|
||||||
|
True -> do
|
||||||
|
fileStatus <- getFileStatus path
|
||||||
|
case isRegularFile $ fileStatus of
|
||||||
|
True -> compileIrcConfig ircDefaultConfig path
|
||||||
|
False -> do
|
||||||
|
putStrLn "Invalid configuration file path."
|
||||||
|
exitWith $ ExitFailure 1
|
||||||
|
False -> do
|
||||||
|
putStrLn "The specified configuration file does not exists."
|
||||||
|
exitWith $ ExitFailure 1
|
||||||
|
Nothing -> return ircDefaultConfig -- TODO : try defaults like $HOME/.hsbotrc, /etc/hsbotrc or /usr/local/etc/hsbotrc
|
||||||
|
|
||||||
|
-- | config file parsing
|
||||||
|
compileIrcConfig :: IrcConfig -> String -> IO (IrcConfig)
|
||||||
|
compileIrcConfig ircConfig path = do
|
||||||
|
val <- C.readfile C.emptyCP path
|
||||||
|
let cp = forceEither val
|
||||||
|
let address = case C.get cp "IRC" "address" of
|
||||||
|
Right this -> this
|
||||||
|
Left _ -> ircConfigAddress ircConfig
|
||||||
|
let port = case C.get cp "IRC" "port" of
|
||||||
|
Right this -> PortNumber $ fromIntegral (read this :: Int) -- TODO error handling
|
||||||
|
Left _ -> ircConfigPort ircConfig
|
||||||
|
let channels = case C.get cp "IRC" "channels" of
|
||||||
|
Right this -> map (lstrip ' ') (split this ',')
|
||||||
|
Left _ -> ircConfigChannels ircConfig
|
||||||
|
let nickname = case C.get cp "IRC" "nickname" of
|
||||||
|
Right this -> this
|
||||||
|
Left _ -> ircConfigNickname ircConfig
|
||||||
|
let password = case C.get cp "IRC" "password" of
|
||||||
|
Right this -> this
|
||||||
|
Left _ -> ircConfigPassword ircConfig
|
||||||
|
let realname = case C.get cp "IRC" "realname" of
|
||||||
|
Right this -> this
|
||||||
|
Left _ -> ircConfigRealname ircConfig
|
||||||
|
let commandPrefix = case C.get cp "IRC" "commandPrefix" of
|
||||||
|
Right this -> head this -- TODO error handling
|
||||||
|
Left _ -> ircConfigCommandPrefix ircConfig
|
||||||
|
let plugins = case C.get cp "IRC" "plugins" of
|
||||||
|
Right this -> map (lstrip ' ') (split this ',')
|
||||||
|
Left _ -> ircConfigPlugins ircConfig
|
||||||
|
return ircConfig { ircConfigAddress = address
|
||||||
|
, ircConfigPort = port
|
||||||
|
, ircConfigChannels = channels
|
||||||
|
, ircConfigNickname = nickname
|
||||||
|
, ircConfigPassword = password
|
||||||
|
, ircConfigRealname = realname
|
||||||
|
, ircConfigCommandPrefix = commandPrefix
|
||||||
|
, ircConfigPlugins = plugins }
|
||||||
|
where
|
||||||
|
split :: String -> Char -> [String]
|
||||||
|
split [] _ = [""]
|
||||||
|
split (c:cs) delim
|
||||||
|
| c == delim = "" : rest
|
||||||
|
| otherwise = (c : head rest) : tail rest
|
||||||
|
where rest = split cs delim
|
||||||
|
lstrip :: Char -> String -> String
|
||||||
|
lstrip x (c:cs) = if (x == c) then (lstrip x cs) else c:(lstrip x cs)
|
||||||
|
lstrip _ [] = []
|
||||||
|
|
||||||
|
|
30
HsbotIrcBot/LICENSE
Normal file
30
HsbotIrcBot/LICENSE
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
Copyright (c)2010, Julien Dessaux
|
||||||
|
|
||||||
|
All rights reserved.
|
||||||
|
|
||||||
|
Redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
* Redistributions of source code must retain the above copyright
|
||||||
|
notice, this list of conditions and the following disclaimer.
|
||||||
|
|
||||||
|
* Redistributions in binary form must reproduce the above
|
||||||
|
copyright notice, this list of conditions and the following
|
||||||
|
disclaimer in the documentation and/or other materials provided
|
||||||
|
with the distribution.
|
||||||
|
|
||||||
|
* Neither the name of Julien Dessaux nor the names of other
|
||||||
|
contributors may be used to endorse or promote products derived
|
||||||
|
from this software without specific prior written permission.
|
||||||
|
|
||||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||||
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||||
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||||
|
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||||
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||||
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||||
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||||
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||||
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
83
HsbotIrcBot/Main.hs
Normal file
83
HsbotIrcBot/Main.hs
Normal file
|
@ -0,0 +1,83 @@
|
||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
import Control.Monad (when)
|
||||||
|
import Prelude hiding (catch)
|
||||||
|
import System.Console.GetOpt
|
||||||
|
import System.Environment
|
||||||
|
import System.Exit
|
||||||
|
import System.IO
|
||||||
|
|
||||||
|
import Hsbot.Irc.Config
|
||||||
|
|
||||||
|
-- | Main function
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
-- 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
|
||||||
|
-- From there the initialization code truly begins
|
||||||
|
when (optDebug opts) . putStrLn $ "Got options : " ++ (show opts)
|
||||||
|
-- We find and parse the config file
|
||||||
|
ircConfig <- getIrcConfig $ optConfigFile opts
|
||||||
|
print $ ircConfigChannels ircConfig
|
||||||
|
print $ ircConfigPlugins ircConfig
|
||||||
|
|
||||||
|
-- CLI argument parting stuff {{{
|
||||||
|
-- | CLI options
|
||||||
|
data Options = Options
|
||||||
|
{ optDebug :: Bool
|
||||||
|
, optConfigFile :: Maybe String
|
||||||
|
, optGroup :: Maybe String
|
||||||
|
, optUser :: Maybe String
|
||||||
|
, optVerbose :: Bool
|
||||||
|
} deriving (Show)
|
||||||
|
|
||||||
|
-- | 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-irc version 0.3"
|
||||||
|
exitWith ExitSuccess))
|
||||||
|
"Show version"
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | Usage header
|
||||||
|
header :: String
|
||||||
|
header = "Usage: hsbot-irc [-dhvV] [-f config_file] [-u user] [-g group]"
|
||||||
|
-- }}}
|
||||||
|
|
29
HsbotIrcBot/hsbot-irc.cabal
Normal file
29
HsbotIrcBot/hsbot-irc.cabal
Normal file
|
@ -0,0 +1,29 @@
|
||||||
|
Name: hsbot-irc
|
||||||
|
Version: 0.3
|
||||||
|
Cabal-version: >=1.2
|
||||||
|
Synopsis: The irc part of a multi-purposes bot.
|
||||||
|
Description:
|
||||||
|
hsbot is a multi-purpose bot, written slowly, as long as I learned more
|
||||||
|
haskell. It features IRC integration and some plugins. I tried to design
|
||||||
|
a bot architecture as modular and as flexible as possible.
|
||||||
|
Homepage: http://hsbot.adyxax.org/
|
||||||
|
License: BSD3
|
||||||
|
License-file: LICENSE
|
||||||
|
Author: Julien Dessaux
|
||||||
|
Maintainer: judessaux@gmail.com
|
||||||
|
Copyright: Copyright (c) 2010 Julien Dessaux
|
||||||
|
Category: Hsbot
|
||||||
|
Build-type: Simple
|
||||||
|
|
||||||
|
|
||||||
|
Executable hsbot-irc
|
||||||
|
Main-is: Main.hs
|
||||||
|
Ghc-options: -Wall
|
||||||
|
Extensions: DeriveDataTypeable ScopedTypeVariables
|
||||||
|
Build-depends: base >= 4.1 && < 5,
|
||||||
|
ConfigFile,
|
||||||
|
MissingH,
|
||||||
|
mtl,
|
||||||
|
network,
|
||||||
|
unix
|
||||||
|
|
Reference in a new issue