First working commit

.gitignore

@@ -0,0 +1,3 @@
+*.hi
+*.o
+Network/IRC/Main

Network/IRC/Handlers.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.IRC.Handlers(listen, sendCommand) 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
+
+sendCommand :: Bot -> Command -> IO ()
+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 ()
+    Just greeting -> sendCommand bot $ ChannelMsgReply $ greeting ++ " " ++ userNick user
+  where
+    greetings = ["hi", "hello", "hey", "sup", "bye"
+                , "good morning", "good evening", "good night"
+                , "ohayo", "oyasumi"]
+greeter _ _ = return ()
+
+welcomer bot@Bot { .. } JoinMsg { .. }
+  | userNick user /= botNick =
+      sendCommand bot $ ChannelMsgReply $ "welcome back " ++ userNick user
+welcomer _ _ = return ()

Network/IRC/Main.hs

@@ -0,0 +1,45 @@
+{-# 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
+
+io = liftIO
+
+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
+  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))
+                 disconnect loop
+  where
+    loop st = E.catch (runReaderT run st)
+                    (\(e :: E.SomeException) -> putStrLn $ "Exception! " ++ show e)

Network/IRC/Protocol.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.IRC.Protocol where
+
+import Data.List
+import Data.List.Split
+import System.Time
+
+import Network.IRC.Types
+
+msgFromLine :: Bot -> ClockTime -> String -> Message
+msgFromLine (Bot { .. }) time line
+  | "PING :" `isPrefixOf` line = Ping time . drop 6 $ line
+  | otherwise = case command of
+      "JOIN"    -> JoinMsg time user
+      "QUIT"    -> QuitMsg time user message
+      "PART"    -> PartMsg time user message
+      "MODE"    -> if source == botNick
+        then ModeMsg time Self target message []
+        else ModeMsg time user target mode modeArgs
+      "NICK"    -> NickMsg time user (drop 1 target)
+      "PRIVMSG" -> if target == channel
+        then ChannelMsg time user message
+        else PrivMsg time user message
+      _         -> OtherMsg time source command target message
+  where
+    isSpc    = (== ' ')
+    isNotSpc = not . isSpc
+    splits   = splitWhen isSpc line
+    source   = drop 1 . takeWhile isNotSpc $ line
+    target   = splits !! 2
+    command  = splits !! 1
+    message  = drop 1 . unwords . drop 3 $ splits
+    user     = let u = splitWhen (== '!') source in User (u !! 0) (u !! 1)
+    mode     = splits !! 3
+    modeArgs = drop 4 splits
+
+lineFromCommand :: Bot -> Command -> String
+lineFromCommand (Bot { .. }) reply = case reply of
+  Pong { .. }                     -> "PONG :" ++ rmsg
+  NickCmd                         -> "NICK " ++ botNick
+  UserCmd                         -> "USER " ++ botNick ++ " 0 * :" ++ botNick
+  JoinCmd                         -> "JOIN " ++ channel
+  ChannelMsgReply { .. }          -> "PRIVMSG " ++ channel ++ " :" ++ rmsg
+  PrivMsgReply (User { .. }) rmsg -> "PRIVMSG " ++ botNick ++ " :" ++ rmsg

Network/IRC/Types.hs

@@ -0,0 +1,42 @@
+module Network.IRC.Types where
+
+import Control.Monad.Reader
+import System.IO
+import System.Time
+
+type Channel = String
+type Nick    = String
+
+data User = Self | User { userNick :: Nick, userServer :: String }
+            deriving (Show, Eq)
+
+data Message =
+    ChannelMsg { time :: ClockTime, user :: User, msg :: String }
+  | PrivMsg    { time :: ClockTime, user :: User, msg :: String }
+  | Ping       { time :: ClockTime, msg :: String }
+  | JoinMsg    { time :: ClockTime, user :: User }
+  | ModeMsg    { time :: ClockTime, user :: User, target :: String
+               , mode :: String, modeArgs :: [String] }
+  | NickMsg    { time :: ClockTime, user :: User, nick :: String }
+  | QuitMsg    { time :: ClockTime, user :: User, msg :: String }
+  | PartMsg    { time :: ClockTime, user :: User, msg :: String }
+  | OtherMsg   { time :: ClockTime, source :: String, command :: String
+               , target :: String, msg :: String }
+  deriving (Show, Eq)
+
+data Command =
+    Pong            { rmsg :: String }
+  | ChannelMsgReply { rmsg :: String }
+  | PrivMsgReply    { ruser :: User, rmsg :: String }
+  | NickCmd
+  | UserCmd
+  | JoinCmd
+  deriving (Show, Eq)
+
+data Bot = Bot { server :: String
+               , port :: Int
+               , channel :: String
+               , botNick :: String
+               , socket :: Handle }
+
+type IRC = ReaderT Bot IO