Reorganized the code

Network/IRC/Handlers.hs

@@ -1,51 +1,25 @@
 {-# LANGUAGE RecordWildCards #-}
 
-module Network.IRC.Handlers(listen, sendCommand) where
+module Network.IRC.Handlers(handleMessage) where
 
-import Control.Concurrent
-import Control.Monad.Reader
 import Data.List
-import System.IO
-import System.Time
-import Text.Printf
 
 import Network.IRC.Protocol
 import Network.IRC.Types
 
-io = liftIO
+handleMessage :: String -> Handler
-
+handleMessage "greeter" = greeter
-sendCommand :: Bot -> Command -> IO ()
+handleMessage "welcomer" = welcomer
-sendCommand bot@Bot{ .. } reply = do
-  let line = lineFromCommand bot reply
-  hPrintf socket "%s\r\n" line >> printf "> %s\n" line
-
-
-listen :: IRC ()
-listen = forever $ do
-  bot@Bot{ .. } <- ask
-
-  line <- fmap init $ io $ hGetLine socket
-  time <- io getClockTime
-
-  io $ printf "[%s] %s\n" (show time) line
-
-  io $ forkIO $ case msgFromLine bot time line of
-    Ping { .. }                 -> sendCommand bot $ Pong msg
-    ModeMsg { user = Self, .. } -> sendCommand bot JoinCmd
-    msg                         -> forM_ messageHandlers $ \handler -> handler bot msg
-
-messageHandlers = [greeter, welcomer]
 
 greeter bot ChannelMsg { .. } = case find (`isPrefixOf` msg) greetings of
-    Nothing       -> return ()
+    Nothing       -> return Nothing
-    Just greeting -> sendCommand bot $ ChannelMsgReply $ greeting ++ " " ++ userNick user
+    Just greeting -> return . Just . ChannelMsgReply $ greeting ++ " " ++ userNick user
   where
     greetings = ["hi", "hello", "hey", "sup", "bye"
                 , "good morning", "good evening", "good night"
                 , "ohayo", "oyasumi"]
-greeter _ _ = return ()
+greeter _ _ = return Nothing
 
-welcomer bot@Bot { .. } JoinMsg { .. }
+welcomer bot@BotConfig { .. } JoinMsg { .. }
-  | userNick user /= botNick =
+  | userNick user /= botNick = return . Just . ChannelMsgReply $ "welcome back " ++ userNick user
-      sendCommand bot $ ChannelMsgReply $ "welcome back " ++ userNick user
+welcomer _ _ = return Nothing
-welcomer _ _ = return ()

Network/IRC/Main.hs

@@ -1,45 +1,23 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
 module Network.IRC.Main(main) where
 
-import qualified Control.Exception as E
-import Control.Monad.Reader
-import Network
 import System.Environment
 import System.Exit
-import System.IO
 
-import Network.IRC.Handlers
-import Network.IRC.Protocol
 import Network.IRC.Types
+import Network.IRC.Client
 
-io = liftIO
+main :: IO ()
-
-connect server port channel botNick = do
-  putStrLn "** Connecting ..."
-  handle <- connectTo server (PortNumber (fromIntegral port))
-  hSetBuffering handle LineBuffering
-  hSetBuffering stdout LineBuffering
-  putStrLn "** Connected"
-  return $ Bot server port channel botNick handle
-
-disconnect bot = do
-  putStrLn "** Disconnecting ..."
-  hClose . socket $ bot
-  putStrLn "** Disconnected"
-
-run = do
-  bot <- ask
-  io $ sendCommand bot NickCmd >> sendCommand bot UserCmd
-  listen
-
 main = do
   args <- getArgs
   prog <- getProgName
+
+  let server   = args !! 0
+  let port     = read (args !! 1)
+  let channel  = args !! 2
+  let botNick  = args !! 3
+  let handlers = ["greeter", "welcomer"]
+
   if length args < 4
     then putStrLn ("Usage: " ++ prog ++ " <server> <port> <channel> <nick>") >> exitFailure
-    else E.bracket (connect (args !! 0) (read (args !! 1)) (args !! 2) (args !! 3))
+    else run $ BotConfig server port channel botNick handlers
-                 disconnect loop
+
-  where
-    loop st = E.catch (runReaderT run st)
-                    (\(e :: E.SomeException) -> putStrLn $ "Exception! " ++ show e)

Network/IRC/Protocol.hs

@@ -8,8 +8,8 @@ import System.Time
 
 import Network.IRC.Types
 
-msgFromLine :: Bot -> ClockTime -> String -> Message
+msgFromLine :: BotConfig -> ClockTime -> String -> Message
-msgFromLine (Bot { .. }) time line
+msgFromLine (BotConfig { .. }) time line
   | "PING :" `isPrefixOf` line = Ping time . drop 6 $ line
   | otherwise = case command of
       "JOIN"    -> JoinMsg time user
@@ -35,8 +35,8 @@ msgFromLine (Bot { .. }) time line
     mode     = splits !! 3
     modeArgs = drop 4 splits
 
-lineFromCommand :: Bot -> Command -> String
+lineFromCommand :: BotConfig -> Command -> String
-lineFromCommand (Bot { .. }) reply = case reply of
+lineFromCommand (BotConfig { .. }) reply = case reply of
   Pong { .. }                     -> "PONG :" ++ rmsg
   NickCmd                         -> "NICK " ++ botNick
   UserCmd                         -> "USER " ++ botNick ++ " 0 * :" ++ botNick

Network/IRC/Types.hs

@@ -4,8 +4,10 @@ import Control.Monad.Reader
 import System.IO
 import System.Time
 
-type Channel = String
+type Channel     = String
-type Nick    = String
+type Nick        = String
+type HandlerName = String
+type Handler     = BotConfig -> Message -> IO (Maybe Command)
 
 data User = Self | User { userNick :: Nick, userServer :: String }
             deriving (Show, Eq)
@@ -33,10 +35,12 @@ data Command =
   | JoinCmd
   deriving (Show, Eq)
 
-data Bot = Bot { server :: String
+data BotConfig = BotConfig { server :: String
-               , port :: Int
+                           , port :: Int
-               , channel :: String
+                           , channel :: String
-               , botNick :: String
+                           , botNick :: String
-               , socket :: Handle }
+                           , handlers :: [HandlerName] }
+                 deriving (Show, Eq)
+data Bot = Bot { botConfig :: BotConfig, socket :: Handle } deriving (Show, Eq)
 
 type IRC = ReaderT Bot IO