ircbot 0.3.2 → 0.4.0

raw patch · 2 files changed

+36/−27 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Network/IRC/Bot/Core.hs +35/−26
• ircbot.cabal +1/−1

@@ -10,7 +10,8 @@  import Control.Concurrent       (ThreadId, forkIO, threadDelay) import Control.Concurrent.Chan  (Chan, dupChan, newChan, readChan, writeChan)-import Control.Concurrent.MVar  (MVar, modifyMVar_, newMVar, readMVar)+import Control.Concurrent.STM   (atomically)+import Control.Concurrent.STM.TMVar  (TMVar, swapTMVar, newTMVar, readTMVar) import Control.Concurrent.QSem  (QSem, newQSem, waitQSem, signalQSem) import Control.Exception        (IOException, catch) import Control.Monad            (mplus, forever, when)@@ -18,6 +19,7 @@ import Data.Data                (Data, Typeable) import Data.Set                 (Set, empty) import Data.Time                (UTCTime, addUTCTime, getCurrentTime)+import GHC.IO.Handle            (hFlushAll) import Network                  (HostName, PortID(PortNumber), connectTo) import Network.IRC              (Message, decode, encode, joinChan, nick, user) import Network.IRC              as I@@ -26,7 +28,7 @@ import Network.IRC.Bot.BotMonad (BotMonad(logM, sendMessage), BotPartT, BotEnv(..), runBotPartT) import Network.IRC.Bot.Part.NickUser (changeNickUser) import Prelude                  hiding (catch)-import System.IO                (BufferMode(LineBuffering), Handle, hClose, hGetLine, hPutStrLn, hSetBuffering)+import System.IO                (BufferMode(NoBuffering, LineBuffering), Handle, hClose, hGetLine, hPutStrLn, hSetBuffering)  -- |Bot configuration data BotConf =@@ -76,20 +78,22 @@ -- 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 ())-connectionLoop logger mv host port nick user outgoingChan incomingChan logChan connQSem =-  do hMVar <- newMVar (undefined :: Handle)-     doConnect logger host port nick user hMVar connQSem+connectionLoop :: Logger -> TMVar UTCTime -> HostName -> PortID -> String -> User -> Chan Message -> Chan Message -> Maybe (Chan Message) -> QSem -> IO (ThreadId, ThreadId, IO ())+connectionLoop logger tmv host port nick user outgoingChan incomingChan logChan connQSem =+  do hTMVar <- atomically $ newTMVar (undefined :: Handle)+     doConnect logger host port nick user hTMVar connQSem      outgoingTid  <- forkIO $ forever $                       do msg <- readChan outgoingChan                          writeMaybeChan logChan msg-                         h <- readMVar hMVar-                         hPutStrLn h (encode msg) `catch` (reconnect logger host port nick user hMVar connQSem)-                         modifyMVar_ mv (const getCurrentTime)+                         h <- atomically $ readTMVar hTMVar+                         hPutStrLn h (encode msg) `catch` (reconnect logger host port nick user hTMVar connQSem)+                         now <- getCurrentTime+                         atomically $ swapTMVar tmv now      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)+                       do h <- atomically $ readTMVar hTMVar+                          msgStr <- (hGetLine h) `catch` (\e -> reconnect logger host port nick user hTMVar connQSem e >> return "")+                          now <- getCurrentTime+                          atomically $ swapTMVar tmv now                           case decode (msgStr ++ "\n") of                             Nothing -> logger Normal ("decode failed: " ++ msgStr)                             (Just msg) ->@@ -97,8 +101,12 @@                                  writeMaybeChan logChan msg                                  writeChan incomingChan msg      let forceReconnect =-             do h <- readMVar hMVar+             do putStrLn "forceReconnect 1"+                h <- atomically $ readTMVar hTMVar+                putStrLn "forceReconnect 2"+                writeChan outgoingChan (quit $ Just "restarting...")                 hClose h+                putStrLn "forceReconnect 3"      return (outgoingTid, incomingTid, forceReconnect)  ircConnectLoop logger host port nick user =@@ -108,19 +116,19 @@              threadDelay (60 * 10^6)              ircConnectLoop logger host port nick user) -doConnect :: (LogLevel -> String -> IO a) -> String -> PortID -> String -> User -> MVar Handle -> QSem -> IO ()-doConnect logger host port nick user hMVar connQSem =+doConnect :: (LogLevel -> String -> IO a) -> String -> PortID -> String -> User -> TMVar Handle -> QSem -> IO ()+doConnect logger host port nick user hTMVar connQSem =     do logger Normal $ showString "Connecting to " . showString host . showString " as " $ nick        h <- ircConnectLoop logger host port nick user-       modifyMVar_ hMVar (const $ return h)+       atomically $ swapTMVar hTMVar h        logger Normal $ "Connected."        signalQSem connQSem        return () -reconnect :: Logger -> String -> PortID -> String -> User -> MVar Handle -> QSem -> IOException -> IO ()-reconnect logger host port nick user hMVar connQSem e =+reconnect :: Logger -> String -> PortID -> String -> User -> TMVar Handle -> QSem -> IOException -> IO ()+reconnect logger host port nick user hTMVar connQSem e =     do logger Normal $ "IRC Connection died: " ++ show e-       doConnect logger host port nick user hMVar connQSem+       doConnect logger host port nick user hTMVar connQSem  onConnectLoop :: Logger -> String -> String -> Chan Message -> QSem -> BotPartT IO () -> IO ThreadId onConnectLoop logger botName prefix outgoingChan connQSem action =@@ -135,7 +143,7 @@ -- will be included in the logs. simpleBot :: BotConf          -- ^ Bot configuration           -> [BotPartT IO ()] -- ^ bot parts (must include 'pingPart', or equivalent)-          -> IO [ThreadId]    -- ^ 'ThreadId' for all forked handler threads+          -> IO ([ThreadId], IO ())    -- ^ 'ThreadId' for all forked handler threads and a function that forces a reconnect simpleBot BotConf{..} parts =     simpleBot' channelLogger logger host port nick commandPrefix user parts @@ -151,8 +159,8 @@           -> String           -- ^ irc nick           -> 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+          -> [BotPartT IO ()] -- ^ bot parts (must include 'pingPart', 'channelsPart', and 'nickUserPart)'+          -> IO ([ThreadId], IO ())    -- ^ 'ThreadId' for all forked handler threads and an IO action that forces a reconnect simpleBot' mChanLogger logger host port nick prefix user parts =   do (mLogTid, mLogChan) <-          case mChanLogger of@@ -164,18 +172,19 @@      -- message channels      outgoingChan <- newChan :: IO (Chan Message)      incomingChan <- newChan :: IO (Chan Message)-     mv <- newMVar =<< getCurrentTime+     now <- getCurrentTime+     tmv <- atomically $ newTMVar now      connQSem <- newQSem 0-     (outgoingTid, incomingTid, forceReconnect) <- connectionLoop logger mv host port nick user outgoingChan incomingChan mLogChan connQSem+     (outgoingTid, incomingTid, forceReconnect) <- connectionLoop logger tmv host port nick user outgoingChan incomingChan mLogChan connQSem      watchDogTid <- forkIO $ forever $                     do let timeout = 5*60                        now          <- getCurrentTime-                       lastActivity <- readMVar mv+                       lastActivity <- atomically $ readTMVar tmv                        when (now > addUTCTime (fromIntegral timeout) lastActivity) forceReconnect                        threadDelay (30*10^6) -- check every 30 seconds      ircTids     <- ircLoop logger nick prefix incomingChan outgoingChan parts      onConnectId <- onConnectLoop logger nick prefix outgoingChan connQSem onConnect-     return $ maybe id (:) mLogTid $ (incomingTid : outgoingTid : watchDogTid : ircTids)+     return $ (maybe id (:) mLogTid $ (incomingTid : outgoingTid : watchDogTid : ircTids), forceReconnect)     where       onConnect :: BotPartT IO ()       onConnect =

@@ -1,5 +1,5 @@ Name:                ircbot-Version:             0.3.2+Version:             0.4.0 Synopsis:            A library for writing irc bots Homepage:            http://patch-tag.com/r/stepcut/ircbot License:             BSD3