Minor refactoring

Network/IRC/Client.hs

@@ -38,11 +38,23 @@ latchIt latch = putMVar latch ()
 awaitLatch :: Latch -> IO ()
 awaitLatch latch = void $ takeMVar latch
 
-type EChannel a = (Chan a, Latch)
+type Channel a = (Chan a, Latch)
 
 data Line = Timeout | EOF | Line !Message deriving (Show, Eq)
 
-sendCommandLoop :: EChannel Command -> Bot -> IO ()
+sendCommand :: Chan Command -> Command -> IO ()
+sendCommand = writeChan
+
+sendMessage :: Chan Line -> Message -> IO ()
+sendMessage = (. Line) . writeChan
+
+sendEvent :: Chan SomeEvent -> SomeEvent -> IO ()
+sendEvent = writeChan
+
+readLine :: Chan Line -> IO Line
+readLine = readChan
+
+sendCommandLoop :: Channel Command -> Bot -> IO ()
 sendCommandLoop (commandChan, latch) bot@Bot { .. } = do
   cmd       <- readChan commandChan
   time      <- getCurrentTime
@@ -56,10 +68,7 @@ sendCommandLoop (commandChan, latch) bot@Bot { .. } = do
     QuitCmd -> latchIt latch
     _       -> sendCommandLoop (commandChan, latch) bot
 
-sendCommand :: Chan Command -> Command -> IO ()
-sendCommand = writeChan
-
-readLineLoop :: MVar BotStatus -> EChannel Line -> Bot -> Int -> IO ()
+readLineLoop :: MVar BotStatus -> Channel Line -> Bot -> Int -> IO ()
 readLineLoop mvBotStatus (lineChan, latch) bot@Bot { .. } timeoutDelay = do
   botStatus <- readMVar mvBotStatus
   case botStatus of
@@ -81,12 +90,6 @@ readLineLoop mvBotStatus (lineChan, latch) bot@Bot { .. } timeoutDelay = do
               now <- getCurrentTime
               return . Line $ msgFromLine botConfig now line
 
-readLine :: Chan Line -> IO Line
-readLine = readChan
-
-sendMessage :: Chan Line -> Message -> IO ()
-sendMessage = (. Line) . writeChan
-
 listenerLoop :: Chan Line -> Chan Command -> Int -> IRC ()
 listenerLoop lineChan commandChan !idleFor = do
   status         <- get
@@ -134,16 +137,13 @@ listenerLoop lineChan commandChan !idleFor = do
             Nothing  -> return ()
             Just cmd -> sendCommand commandChan cmd
 
-sendEvent :: Chan SomeEvent -> SomeEvent -> IO ()
-sendEvent = writeChan
-
-eventProcessLoop :: EChannel SomeEvent -> Chan Line -> Chan Command -> Bot -> IO ()
+eventProcessLoop :: Channel SomeEvent -> Chan Line -> Chan Command -> Bot -> IO ()
 eventProcessLoop (eventChan, latch) lineChan commandChan bot@Bot {.. } = do
   event <- readChan eventChan
   case fromEvent event of
     Just (QuitEvent, _) -> latchIt latch
     _                   -> do
-      debug $ "** Event: " ++ pack (show event)
+      debug $ "Event: " ++ pack (show event)
       forM_ (mapToList msgHandlers) $ \(_, msgHandler) -> fork $
         handle (\(ex :: SomeException) ->
                   debug $ "Exception while processing event: " ++ pack (show ex)) $ do
@@ -155,22 +155,7 @@ eventProcessLoop (eventChan, latch) lineChan commandChan bot@Bot {.. } = do
             _                   -> return ()
       eventProcessLoop (eventChan, latch) lineChan commandChan bot
 
-loadMsgHandlers :: BotConfig -> Chan SomeEvent -> IO (Map MsgHandlerName MsgHandler)
-loadMsgHandlers botConfig@BotConfig { .. } eventChan =
-  flip (`foldM` mempty) msgHandlerNames $ \hMap msgHandlerName -> do
-    debug $ "Loading msg handler: " ++ msgHandlerName
-    mMsgHandler <- mkMsgHandler botConfig eventChan msgHandlerName
-    case mMsgHandler of
-      Nothing         -> debug ("No msg handler found with name: " ++ msgHandlerName) >> return hMap
-      Just msgHandler -> return $ insertMap msgHandlerName msgHandler hMap
-
-unloadMsgHandlers :: Bot -> IO ()
-unloadMsgHandlers Bot { .. } =
-  forM_ (mapToList msgHandlers) $ \(msgHandlerName, msgHandler) -> do
-    debug $ "Unloading msg handler: " ++ msgHandlerName
-    stopMsgHandler msgHandler botConfig
-
-connect :: BotConfig -> IO (Bot, MVar BotStatus, EChannel Line, EChannel Command, EChannel SomeEvent)
+connect :: BotConfig -> IO (Bot, MVar BotStatus, Channel Line, Channel Command, Channel SomeEvent)
 connect botConfig@BotConfig { .. } = do
   debug "Connecting ..."
   socket <- connectToWithRetry
@@ -181,8 +166,7 @@ connect botConfig@BotConfig { .. } = do
   commandChan <- newChannel
   eventChan   <- newChannel
   mvBotStatus <- newMVar Connected
-
-  msgHandlers <- loadMsgHandlers botConfig (fst eventChan)
+  msgHandlers <- loadMsgHandlers (fst eventChan)
 
   return (Bot botConfig socket msgHandlers, mvBotStatus, lineChan, commandChan, eventChan)
   where
@@ -194,8 +178,15 @@ connect botConfig@BotConfig { .. } = do
 
     newChannel = (,) <$> newChan <*> newEmptyMVar
 
-disconnect :: (Bot, MVar BotStatus, EChannel Line, EChannel Command, EChannel SomeEvent) -> IO ()
-disconnect (bot@Bot { .. }, mvBotStatus, (_, readLatch), (commandChan, sendLatch), (eventChan, eventLatch)) = do
+    loadMsgHandlers eventChan = flip (`foldM` mempty) msgHandlerNames $ \hMap msgHandlerName -> do
+      debug $ "Loading msg handler: " ++ msgHandlerName
+      mMsgHandler <- mkMsgHandler botConfig eventChan msgHandlerName
+      case mMsgHandler of
+        Nothing         -> debug ("No msg handler found with name: " ++ msgHandlerName) >> return hMap
+        Just msgHandler -> return $ insertMap msgHandlerName msgHandler hMap
+
+disconnect :: (Bot, MVar BotStatus, Channel Line, Channel Command, Channel SomeEvent) -> IO ()
+disconnect (Bot { .. }, mvBotStatus, (_, readLatch), (commandChan, sendLatch), (eventChan, eventLatch)) = do
   debug "Disconnecting ..."
   sendCommand commandChan QuitCmd
   awaitLatch sendLatch
@@ -204,13 +195,13 @@ disconnect (bot@Bot { .. }, mvBotStatus, (_, readLatch), (commandChan, sendLatch
   sendEvent eventChan =<< toEvent QuitEvent
   awaitLatch eventLatch
 
-  unloadMsgHandlers bot
+  unloadMsgHandlers
   hClose socket
   debug "Disconnected"
-
-addCoreMsgHandlers :: BotConfig -> BotConfig
-addCoreMsgHandlers botConfig =
-  botConfig { msgHandlerNames = hashNub $ msgHandlerNames botConfig ++ coreMsgHandlerNames }
+  where
+    unloadMsgHandlers = forM_ (mapToList msgHandlers) $ \(msgHandlerName, msgHandler) -> do
+      debug $ "Unloading msg handler: " ++ msgHandlerName
+      stopMsgHandler msgHandler botConfig
 
 run :: BotConfig -> IO ()
 run botConfig' = withSocketsDo $ do
@@ -225,7 +216,7 @@ run botConfig' = withSocketsDo $ do
     NickNotAvailable -> return ()
     _                -> error "Unsupported status"
   where
-    botConfig = addCoreMsgHandlers botConfig'
+    botConfig = botConfig' { msgHandlerNames = hashNub $ msgHandlerNames botConfig' ++ coreMsgHandlerNames }
 
     handleErrors :: SomeException -> IO BotStatus
     handleErrors e = case fromException e of

Network/IRC/Types.hs

@@ -9,8 +9,7 @@
 {-# LANGUAGE RecordWildCards #-}
 
 module Network.IRC.Types
-  ( Channel
-  , Nick
+  ( Nick
   , MsgHandlerName
   , User (..)
   , Message (..)
@@ -38,7 +37,6 @@ import Control.Monad.State
 import Data.Configurator.Types
 import Data.Typeable (cast)
 
-type Channel        = Text
 type Nick           = Text
 type MsgHandlerName = Text