1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
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")
|
