ircbot 0.3.1 → 0.3.2
raw patch · 6 files changed
+53/−57 lines, 6 filesdep +directoryPVP ok
version bump matches the API change (PVP)
Dependencies added: directory
API changes (from Hackage documentation)
Files
- Network/IRC/Bot/BotMonad.hs +4/−4
- Network/IRC/Bot/Commands.hs +14/−14
- Network/IRC/Bot/Core.hs +18/−18
- Network/IRC/Bot/Parsec.hs +8/−8
- Network/IRC/Bot/PosixLogger.hs +4/−2
- ircbot.cabal +5/−11
Network/IRC/Bot/BotMonad.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, UndecidableInstances #-}-module Network.IRC.Bot.BotMonad +module Network.IRC.Bot.BotMonad ( BotPartT(..) , BotMonad(..) , BotEnv(..)@@ -39,7 +39,7 @@ , botName :: String , cmdPrefix :: String }- + newtype BotPartT m a = BotPartT { unBotPartT :: ReaderT BotEnv m a } deriving (Applicative, Alternative, Functor, Monad, MonadFix, MonadPlus, MonadTrans, MonadIO, MonadWriter w, MonadState s, MonadError e, MonadCont) @@ -48,10 +48,10 @@ local f = BotPartT . mapReaderT (local f) . unBotPartT instance (MonadRWS r w s m) => MonadRWS r w s (BotPartT m)- + runBotPartT :: BotPartT m a -> BotEnv -> m a runBotPartT botPartT = runReaderT (unBotPartT botPartT)- + mapBotPartT :: (m a -> n b) -> BotPartT m a -> BotPartT n b mapBotPartT f (BotPartT r) = BotPartT $ mapReaderT f r
Network/IRC/Bot/Commands.hs view
@@ -10,7 +10,7 @@ import Network.IRC.Bot.BotMonad -- * Commands- + cmd :: (Functor m, MonadPlus m, BotMonad m) => Command -> m () cmd cmdName = do command <- msg_command <$> askMessage@@ -21,29 +21,29 @@ data Ping = Ping HostName deriving (Eq, Ord, Read, Show, Data, Typeable)- + ping :: (Functor m, MonadPlus m, BotMonad m) => m Ping-ping = +ping = do cmd "PING" params <- msg_params <$> askMessage case params of (hostName:_) -> return $ Ping hostName _ -> mzero- - -data PrivMsg - = PrivMsg { prefix :: (Maybe Prefix) +++data PrivMsg+ = PrivMsg { prefix :: (Maybe Prefix) , receivers :: [String] , msg :: String } deriving (Eq, Read, Show)- + privMsg :: (Functor m, MonadPlus m, BotMonad m) => m PrivMsg privMsg = do msg <- askMessage maybe mzero return (toPrivMsg msg)- -toPrivMsg :: Message -> Maybe PrivMsg ++toPrivMsg :: Message -> Maybe PrivMsg toPrivMsg msg = let cmd = msg_command msg params = msg_params msg@@ -51,10 +51,10 @@ in case cmd of "PRIVMSG" -> Just $ PrivMsg prefix (init params) (last params) _ -> Nothing- + class ToMessage a where toMessage :: a -> Message- + sendCommand :: (ToMessage c, BotMonad m, Functor m) => c -> m () sendCommand c = sendMessage (toMessage c) @@ -78,7 +78,7 @@ _ -> return Nothing -- | figure out who to reply to for a given `Message`--- +-- -- If message was sent to a #channel reply to the channel. Otherwise reply to the sender. replyTo :: (BotMonad m) => m (Maybe String) replyTo =@@ -89,7 +89,7 @@ else askSenderNickName -- | returns the receiver of a message--- +-- -- if multiple receivers, it returns only the first askReceiver :: (Alternative m, BotMonad m) => m (Maybe String) askReceiver =
Network/IRC/Bot/Core.hs view
@@ -29,11 +29,11 @@ import System.IO (BufferMode(LineBuffering), Handle, hClose, hGetLine, hPutStrLn, hSetBuffering) -- |Bot configuration-data BotConf = +data BotConf = BotConf { channelLogger :: (Maybe (Chan Message -> IO ())) -- ^ optional channel logging function , logger :: Logger -- ^ app logging- , host :: HostName -- ^ irc server to connect + , host :: HostName -- ^ irc server to connect , port :: PortID -- ^ irc port to connect to (usually, 'PortNumber 6667') , nick :: String -- ^ irc nick , commandPrefix :: String -- ^ command prefix@@ -66,14 +66,14 @@ runBotPartT botPart (BotEnv msg outgoingChan logger botName prefix) ircLoop :: Logger -> String -> String -> Chan Message -> Chan Message -> [BotPartT IO ()] -> IO [ThreadId]-ircLoop logger botName prefix incomingChan outgoingChan parts = +ircLoop logger botName prefix incomingChan outgoingChan parts = mapM forkPart parts where forkPart botPart = do inChan <- dupChan incomingChan forkIO $ partLoop logger botName prefix inChan outgoingChan (botPart `mplus` return ()) --- reconnect loop is still a bit buggy +-- reconnect loop is still a bit buggy -- if you try to write multiple lines, and the all fail, reconnect will be called multiple times.. -- something should be done so that this does not happen connectionLoop :: Logger -> MVar UTCTime -> HostName -> PortID -> String -> User -> Chan Message -> Chan Message -> Maybe (Chan Message) -> QSem -> IO (ThreadId, ThreadId, IO ())@@ -85,24 +85,24 @@ writeMaybeChan logChan msg h <- readMVar hMVar hPutStrLn h (encode msg) `catch` (reconnect logger host port nick user hMVar connQSem)- modifyMVar_ mv (const getCurrentTime) + modifyMVar_ mv (const getCurrentTime) incomingTid <- forkIO $ forever $ do h <- readMVar hMVar msgStr <- (hGetLine h) `catch` (\e -> reconnect logger host port nick user hMVar connQSem e >> return "") modifyMVar_ mv (const getCurrentTime) case decode (msgStr ++ "\n") of Nothing -> logger Normal ("decode failed: " ++ msgStr)- (Just msg) -> + (Just msg) -> do logger Debug (show msg) writeMaybeChan logChan msg writeChan incomingChan msg- let forceReconnect = + let forceReconnect = do h <- readMVar hMVar hClose h return (outgoingTid, incomingTid, forceReconnect) ircConnectLoop logger host port nick user =- (ircConnect host port nick user) `catch` + (ircConnect host port nick user) `catch` (\e -> do logger Normal $ "irc connect failed ... retry in 60 seconds: " ++ show (e :: IOException) threadDelay (60 * 10^6)@@ -118,18 +118,18 @@ return () reconnect :: Logger -> String -> PortID -> String -> User -> MVar Handle -> QSem -> IOException -> IO ()-reconnect logger host port nick user hMVar connQSem e = +reconnect logger host port nick user hMVar connQSem e = do logger Normal $ "IRC Connection died: " ++ show e doConnect logger host port nick user hMVar connQSem onConnectLoop :: Logger -> String -> String -> Chan Message -> QSem -> BotPartT IO () -> IO ThreadId onConnectLoop logger botName prefix outgoingChan connQSem action =- forkIO $ forever $ + forkIO $ forever $ do waitQSem connQSem runBotPartT action (BotEnv undefined outgoingChan logger botName prefix) -- |simpleBot connects to the server and handles messages using the supplied BotPartTs--- +-- -- the 'Chan Message' for the optional logging function will include -- all received and sent messages. This means that the bots output -- will be included in the logs.@@ -146,15 +146,15 @@ -- will be included in the logs. simpleBot' :: (Maybe (Chan Message -> IO ())) -- ^ optional logging function -> Logger -- ^ application logging- -> HostName -- ^ irc server to connect + -> HostName -- ^ irc server to connect -> PortID -- ^ irc port to connect to (usually, 'PortNumber 6667') -> String -- ^ irc nick- -> String -- ^ command prefix + -> String -- ^ command prefix -> User -- ^ irc user info -> [BotPartT IO ()] -- ^ bot parts (must include 'pingPart', 'channelsPart', and 'nickUserPart') -> IO [ThreadId] -- ^ 'ThreadId' for all forked handler threads-simpleBot' mChanLogger logger host port nick prefix user parts = - do (mLogTid, mLogChan) <- +simpleBot' mChanLogger logger host port nick prefix user parts =+ do (mLogTid, mLogChan) <- case mChanLogger of Nothing -> return (Nothing, Nothing) (Just chanLogger) ->@@ -167,7 +167,7 @@ mv <- newMVar =<< getCurrentTime connQSem <- newQSem 0 (outgoingTid, incomingTid, forceReconnect) <- connectionLoop logger mv host port nick user outgoingChan incomingChan mLogChan connQSem- watchDogTid <- forkIO $ forever $ + watchDogTid <- forkIO $ forever $ do let timeout = 5*60 now <- getCurrentTime lastActivity <- readMVar mv@@ -178,10 +178,10 @@ return $ maybe id (:) mLogTid $ (incomingTid : outgoingTid : watchDogTid : ircTids) where onConnect :: BotPartT IO ()- onConnect = + onConnect = changeNickUser nick (Just user) -- | call 'writeChan' if 'Just'. Do nothing for Nothing. writeMaybeChan :: Maybe (Chan a) -> a -> IO ()-writeMaybeChan Nothing _ = return () +writeMaybeChan Nothing _ = return () writeMaybeChan (Just chan) a = writeChan chan a
Network/IRC/Bot/Parsec.hs view
@@ -6,7 +6,7 @@ The parsec part is supposed to make it easy to use Parsec to parse the command arguments. We would also like to be able to generate a help menu. But the help-menu should not be for only Parsec commands. Or do we? Maybe all interactive commands should be implementing through parsec part. +menu should not be for only Parsec commands. Or do we? Maybe all interactive commands should be implementing through parsec part. Some commands like @seen (and @tell) are two part. There is the part that collects the data. And there is the command itself. How would that integrate@@ -16,11 +16,11 @@ Each top-level part is run in a separate thread. But if we only have one thread for all the parsecParts, then blocking could occur. -We could run every handler for every message, even though we only expect at most one command to match. That seems bogus. Do we really want to allow to different parts to respond to @foo ? +We could run every handler for every message, even though we only expect at most one command to match. That seems bogus. Do we really want to allow to different parts to respond to @foo ? -Seems better to have each part register. +Seems better to have each part register. -data Part m = +data Part m = Part { name :: String , description :: String , backgroundParts :: [BotPartT m ()]@@ -81,14 +81,14 @@ -- -- see 'dicePart' for an example usage. parsecPart :: (BotMonad m) =>- (ParsecT String () m a) + (ParsecT String () m a) -> m a-parsecPart p = - do priv <- privMsg +parsecPart p =+ do priv <- privMsg logM Debug $ "I got a message: " ++ msg priv ++ " sent to " ++ show (receivers priv) ma <- runParserT p () (msg priv) (msg priv) case ma of- (Left e) -> + (Left e) -> do logM Debug $ "Parse error: " ++ show e target <- maybeZero =<< replyTo reportError target e
Network/IRC/Bot/PosixLogger.hs view
@@ -6,6 +6,7 @@ import Data.Time.Format (formatTime) import Network.IRC (Command, Message(Message, msg_prefix, msg_command, msg_params), Prefix(NickName), UserName, encode, decode, joinChan, nick, user) import Network.IRC.Bot.Commands+import System.Directory (createDirectoryIfMissing) import System.FilePath ((</>)) import System.Locale (defaultTimeLocale) import System.Posix ( Fd, OpenMode(WriteOnly), OpenFileFlags(append), closeFd, defaultFileFlags@@ -28,6 +29,7 @@ Nothing -> return Nothing (Just logDir) -> do let logPath = logDir </> (formatTime defaultTimeLocale ((dropWhile (== '#') channel) ++ "-%Y-%m-%d.txt") now)+ createDirectoryIfMissing True logDir fd <- openFd logPath WriteOnly (Just 0o0644) (defaultFileFlags { append = True }) return (Just fd) updateLogHandle :: UTCTime -> Day -> Maybe Fd -> IO (Day, Maybe Fd)@@ -37,11 +39,11 @@ | otherwise = do closeFd logFd nowHandle <- openLog now return (utctDay now, nowHandle)- + logLoop :: Day -> Maybe Fd -> IO () logLoop logDay mLogFd = do msg <- readChan logChan- now <- getCurrentTime + now <- getCurrentTime (logDay', mLogFd') <- updateLogHandle now logDay mLogFd let mPrivMsg = toPrivMsg msg case mPrivMsg of
ircbot.cabal view
@@ -1,19 +1,19 @@ Name: ircbot-Version: 0.3.1+Version: 0.3.2 Synopsis: A library for writing irc bots Homepage: http://patch-tag.com/r/stepcut/ircbot License: BSD3 License-file: LICENSE Author: Jeremy Shaw Maintainer: jeremy@seereason.com--- Copyright: +Copyright: 2012 SeeReason Partners LLC Stability: Experimental Category: Network Build-type: Simple Cabal-version: >=1.6 Library- Exposed-modules: + Exposed-modules: Network.IRC.Bot Network.IRC.Bot.BotMonad Network.IRC.Bot.Core@@ -28,9 +28,10 @@ Network.IRC.Bot.Parsec Network.IRC.Bot.PosixLogger Network.IRC.Bot.Types- + Build-depends: base >= 4 && <5, containers == 0.4.*,+ directory < 1.2, filepath >= 1.2 && < 1.4, irc == 0.5.*, mtl == 2.0.*,@@ -41,10 +42,3 @@ unix >= 2.4 && < 2.6, random == 1.0.*, stm == 2.2.*-- -- Modules not exported by this package.- -- Other-modules: - - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.- -- Build-tools: -