134 lines
5.3 KiB
Haskell
134 lines
5.3 KiB
Haskell
module Hsbot.Irc.Config
|
|
( IrcConfig(..)
|
|
, ircDefaultConfig
|
|
, getIrcConfig
|
|
) where
|
|
|
|
import Control.Monad.Error
|
|
import Data.Char (isDigit)
|
|
import qualified Data.ConfigFile as C
|
|
import Data.Either.Utils
|
|
import Network
|
|
import System.Exit
|
|
import System.Posix.Files
|
|
|
|
-- | Configuration data type
|
|
data IrcConfig = IrcConfig
|
|
{ ircConfigAddress :: String -- the server's address
|
|
, ircConfigPort :: PortID -- the server's port
|
|
, ircConfigChannels :: [String] -- the Channels to join on start
|
|
, ircConfigNickname :: String -- the hsbot's nickname
|
|
, ircConfigPassword :: String -- the hsbot's password, optional
|
|
, ircConfigRealname :: String -- the hsbot's real name, optional
|
|
, ircConfigCommandPrefix :: Char -- the prefix the ircbot will recognize as commands
|
|
, ircConfigPlugins :: [String] -- the ircPlugins to load
|
|
}
|
|
|
|
instance Show IrcConfig where
|
|
show (IrcConfig address port channels nickname password realname commandPrefix plugins) = unlines $
|
|
concat [ "Address: ", address ] :
|
|
concat [ "Port: ", case port of
|
|
PortNumber num -> show num
|
|
Service s -> show s
|
|
UnixSocket u -> show u ] :
|
|
concat [ "Channels: ", show channels ] :
|
|
concat [ "Nickname: ", nickname ] :
|
|
concat [ "Password: ", password ] :
|
|
concat [ "Realname: ", realname ] :
|
|
concat [ "CommandPrefix: ", show commandPrefix ] :
|
|
[ "Plugins: ", show plugins ]
|
|
|
|
-- | User configuration
|
|
ircDefaultConfig :: IrcConfig
|
|
ircDefaultConfig = IrcConfig
|
|
{ ircConfigAddress = "localhost"
|
|
, ircConfigPort = PortNumber 6667
|
|
, ircConfigChannels = ["#hsbot"]
|
|
, ircConfigNickname = "hsbot"
|
|
, ircConfigPassword = ""
|
|
, ircConfigRealname = "The One True bot, with it's haskell soul."
|
|
, ircConfigCommandPrefix = '@'
|
|
, ircConfigPlugins = ["Ping", "Core"]
|
|
}
|
|
|
|
-- | 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 -> getConfigFromFile 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
|
|
|
|
-- | Get configuration from config file
|
|
getConfigFromFile :: FilePath -> IO IrcConfig
|
|
getConfigFromFile fname = readfile C.emptyCP fname >>= extractConfig . forceEither
|
|
|
|
-- | A version of readfile that treats the file as UTF-8
|
|
readfile :: MonadError C.CPError m => C.ConfigParser -> FilePath -> IO (m C.ConfigParser)
|
|
readfile cp path' = do
|
|
contents <- readFile path'
|
|
return $ C.readstring cp contents
|
|
|
|
-- | config file processing
|
|
extractConfig :: C.ConfigParser -> IO IrcConfig
|
|
extractConfig cp = do
|
|
config' <- runErrorT $ do
|
|
cfAddress <- getit "address"
|
|
cfPort <- getit "port"
|
|
cfChannels <- getit "channels"
|
|
cfNickname <- getit "nickname"
|
|
cfPassword <- getit "password"
|
|
cfRealname <- getit "realname"
|
|
cfCommandPrefix <- getit "commandprefix"
|
|
cfPlugins <- getit "plugins"
|
|
return $! IrcConfig {
|
|
ircConfigAddress = cfAddress
|
|
, ircConfigPort = PortNumber . fromIntegral $ readInteger "port" cfPort
|
|
, ircConfigChannels = splitCommaList cfChannels
|
|
, ircConfigNickname = cfNickname
|
|
, ircConfigPassword = cfPassword
|
|
, ircConfigRealname = cfRealname
|
|
, ircConfigCommandPrefix = readChar "commandprefix" cfCommandPrefix
|
|
, ircConfigPlugins = splitCommaList cfPlugins }
|
|
case config' of
|
|
Left (C.ParseError e, e') -> error $ "Parse error: " ++ e ++ "\n" ++ e'
|
|
Left e -> error (show e)
|
|
Right c -> return c
|
|
where
|
|
getit = C.get cp "IRC"
|
|
|
|
readChar :: String -> String -> Char
|
|
readChar _ x | length x == 1 = head x
|
|
readChar opt _ = error $ opt ++ " must be one character long."
|
|
|
|
readInteger :: String -> String -> Int
|
|
readInteger _ x | all isDigit x = read x ::Int
|
|
readInteger opt _ = error $ opt ++ " must be an integer."
|
|
|
|
-- readNumber :: (Num a, Read a) => String -> String -> a
|
|
-- readNumber _ x | all isDigit x = read x
|
|
-- readNumber opt _ = error $ opt ++ " must be a number."
|
|
|
|
splitCommaList :: String -> [String]
|
|
splitCommaList l =
|
|
let (first, rest) = break (== ',') l
|
|
first' = lrStrip first
|
|
in case rest of
|
|
[] -> if null first' then [] else [first']
|
|
(_:rs) -> first' : splitCommaList rs
|
|
|
|
lrStrip :: String -> String
|
|
lrStrip = reverse . dropWhile isWhitespace . reverse . dropWhile isWhitespace
|
|
where isWhitespace = (`elem` " \t\n")
|
|
|