diff --git a/Network/IRC/Bot/BotMonad.hs b/Network/IRC/Bot/BotMonad.hs --- a/Network/IRC/Bot/BotMonad.hs +++ b/Network/IRC/Bot/BotMonad.hs @@ -12,7 +12,7 @@ import Control.Arrow (first) import Control.Monad (MonadPlus(mplus, mzero), forever, replicateM, when) import Control.Monad.Cont (MonadCont) -import Control.Monad.Error (MonadError) +import Control.Monad.Except (MonadError) import Control.Monad.Reader (MonadReader(ask, local), MonadTrans, ReaderT(runReaderT), mapReaderT) import Control.Monad.Writer (MonadWriter) import Control.Monad.State (MonadState) diff --git a/demo.hs b/demo.hs new file mode 100644 --- /dev/null +++ b/demo.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, GeneralizedNewtypeDeriving, RankNTypes, RecordWildCards, OverloadedStrings #-} +module Main where + +import Control.Concurrent (killThread) +import Control.Concurrent.Chan (Chan) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as C +import Data.Set (Set, insert) +import Network (HostName, PortID(PortNumber), connectTo) +import Network.IRC (Message) +import Network.IRC.Bot.BotMonad (BotMonad(..)) +import Network.IRC.Bot.Core (BotConf(..), User(..), nullBotConf, simpleBot) +import Network.IRC.Bot.Log (LogLevel(..), nullLogger, stdoutLogger) +import Network.IRC.Bot.Part.Dice (dicePart) +import Network.IRC.Bot.Part.Hello (helloPart) +import Network.IRC.Bot.Part.Ping (pingPart) +import Network.IRC.Bot.Part.NickUser (nickUserPart) +import Network.IRC.Bot.Part.Channels (initChannelsPart) +import System.Console.GetOpt +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure) +import System.IO (stdout) + +data Flag + = BotConfOpt { unBotConfOpt :: (BotConf -> BotConf) } + +botOpts :: [OptDescr Flag] +botOpts = + [ Option [] ["irc-server"] (ReqArg setIrcServer "hostname or IP") "irc server to connect to" + , Option [] ["port"] (ReqArg setPort "port") "port to connect to on server" + , Option [] ["nick"] (ReqArg setNick "name") "irc nick" + , Option [] ["username"] (ReqArg setUsername "username") "ident username" + , Option [] ["hostname"] (ReqArg setHostname "hostname") "hostname of machine bot is connecting from" + , Option [] ["realname"] (ReqArg setRealname "name") "bot's real name" + , Option [] ["cmd-prefix"] (ReqArg setCmdPrefix "prefix") "prefix to bot commands (e.g., ?, @, bot: )" + , Option [] ["channel"] (ReqArg addChannel "channel name") "channel to join after connecting. (can be specified more than once to join multiple channels)" + , Option [] ["log-level"] (ReqArg setLogLevel "debug, normal, important, quiet") "set the logging level" + , Option [] ["limit"] (ReqArg setLimit "int,int") "enable rate limiter. burst length, delay in microseconds" + ] + where + setIrcServer n = BotConfOpt $ \c -> c { host = n, user = (user c) { servername = n } } + setPort str = BotConfOpt $ \c -> c { port = PortNumber (fromIntegral $ read str) } + setNick n = BotConfOpt $ \c -> c { nick = C.pack n } + setUsername n = BotConfOpt $ \c -> c { user = (user c) { username = C.pack n } } + setHostname n = BotConfOpt $ \c -> c { user = (user c) { hostname = n } } + setRealname n = BotConfOpt $ \c -> c { user = (user c) { realname = (C.pack n) } } + setCmdPrefix p = BotConfOpt $ \c -> c { commandPrefix = p } + addChannel ch = BotConfOpt $ \c -> c { channels = insert (C.pack ch) (channels c) } + setLogLevel l = BotConfOpt $ \c -> + case l of + "debug" -> c { logger = stdoutLogger Debug } + "normal" -> c { logger = stdoutLogger Normal } + "important" -> c { logger = stdoutLogger Important } + "quiet" -> c { logger = nullLogger } + _ -> error $ "unknown log-level: " ++ l + setLimit s = BotConfOpt $ \c -> + case break (== ',') s of + (burstStr, delayStr) -> + case reads burstStr of + [(burstLen,[])] -> + case reads (drop 1 $ delayStr) of + [(delay,[])] -> + c { limits = Just (burstLen, delay) } + _ -> error $ "unabled to parse delay: " ++ delayStr + _ -> error $ "unabled to parse burst length: " ++ burstStr + +getBotConf :: Maybe (Chan Message -> IO ()) -> IO BotConf +getBotConf mLogger = + do args <- getArgs + case getOpt Permute botOpts args of + (f,_,[]) -> + do let conf = (foldr ($) nullBotConf (map unBotConfOpt f)) { channelLogger = mLogger } + checkConf conf + return conf + (_,_,errs) -> + do progName <- getProgName + putStr (helpMessage progName) + exitFailure + +exitHelp msg = + do progName <- getProgName + putStrLn msg + putStr (helpMessage progName) + exitFailure + +checkConf :: BotConf -> IO () +checkConf BotConf{..} + | null host = exitHelp "must specify --irc-server" + | C.null nick = exitHelp "must specify --nick" + | C.null (username user) = exitHelp "must specify --username" + | null (hostname user) = exitHelp "must specify --hostname" + | C.null (realname user) = exitHelp "must specify --realname" + | otherwise = return () + +helpMessage progName = usageInfo header botOpts + where + header = "Usage: "++progName++" [OPTION...]\n" ++ "e.g.\n" ++ + progName ++ " --irc-server irc.freenode.net --nick stepbot --username stepbot --hostname happstack.com --realname \"happstack bot\" --channel \"#stepbot\"" + +main :: IO () +main = + do botConf <- getBotConf Nothing + ircParts <- initParts (channels botConf) + (tids, reconnect) <- simpleBot botConf ircParts + (logger botConf) Important "Press enter to force reconnect." + getLine + reconnect + (logger botConf) Important "Press enter to quit." + getLine + + mapM_ killThread tids + +initParts :: (BotMonad m) => + Set ByteString -- ^ set of channels to join + -> IO [m ()] +initParts chans = + do (_, channelsPart) <- initChannelsPart chans + return [ pingPart + , nickUserPart + , channelsPart + , dicePart + , helloPart + ] diff --git a/ircbot.cabal b/ircbot.cabal --- a/ircbot.cabal +++ b/ircbot.cabal @@ -1,5 +1,5 @@ Name: ircbot -Version: 0.6.5.2 +Version: 0.6.5.3 Synopsis: A library for writing IRC bots Description: A simple library for an IRC bot License: BSD3 @@ -10,7 +10,7 @@ Stability: Experimental Category: Network Build-type: Simple -Cabal-version: >=1.6 +Cabal-version: >=1.10 Homepage: https://github.com/stepcut/ircbot tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC==8.0.2 @@ -19,6 +19,7 @@ location: https://github.com/stepcut/ircbot Library + Default-language: Haskell2010 Exposed-modules: Network.IRC.Bot Network.IRC.Bot.BotMonad @@ -50,3 +51,39 @@ random >= 1.0 && < 1.2, stm >= 2.2 && < 2.5, SafeSemaphore >= 0.10 && < 0.11 + +Executable demo + main-is: demo.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base >= 4 && <5, + bytestring >= 0.10 && < 0.11, + containers >= 0.4 && < 0.6, + directory < 1.4, + filepath >= 1.2 && < 1.5, + irc == 0.6.*, + mtl >= 2.0 && < 2.3, + network >= 2.3 && < 2.7, + parsec == 3.1.*, + time >= 1.5 && < 1.10, + unix >= 2.4 && < 2.8, + random >= 1.0 && < 1.2, + stm >= 2.2 && < 2.5, + SafeSemaphore >= 0.10 && < 0.11 + other-modules: + Network.IRC.Bot + Network.IRC.Bot.BotMonad + Network.IRC.Bot.Core + Network.IRC.Bot.Commands + Network.IRC.Bot.ErrorCodes + Network.IRC.Bot.Limiter + Network.IRC.Bot.Log + Network.IRC.Bot.Part.Channels + Network.IRC.Bot.Part.Dice + Network.IRC.Bot.Part.Hello + Network.IRC.Bot.Part.Ping + Network.IRC.Bot.Part.NickUser + Network.IRC.Bot.Parsec + Network.IRC.Bot.PosixLogger + Network.IRC.Bot.Types + + default-language: Haskell2010