Main.hs

module Main where

import Data.List
import Network
import System.IO
import System.Exit
import Control.Arrow
import Control.Monad.Reader
import qualified Control.Exception as E
import Text.Printf
 
server = "irc.freenode.net"
port   = 6667
chan   = "#testing"
nick   = "tob"
response = "End of /MOTD command."
 
type Net = ReaderT Bot IO
data Bot = Bot { socket :: Handle }

main :: IO ()
main = E.bracket connect disconnect loop
  where
    disconnect = hClose . socket
    loop st = E.catch (runReaderT run st) (\(E.SomeException _) -> return ())
 
connect :: IO Bot
connect = (connectTo server $ PortNumber $ fromIntegral port)
          >>= return . Bot

run :: Net ()
run = do
    write "NICK" nick
    write "USER" $ nick ++ " 0 * :haskell bot"
    asks socket >>= listen cmd

type Eval = (String -> Net ())
 
listen :: Eval -> Handle -> Net ()
listen eval h = do
    s <- liftIO $ hGetLine h
    let t = init s
    liftIO $ putStrLn t
    if ping t then pong t else eval $ clean t
    listen eval h
  where
    clean = drop 1 . dropWhile (/= ':') . drop 1
    ping x = "PING :" `isPrefixOf` x
    pong x = write "PONG" $ ':' : drop 6 x
 
cmd :: String -> Net ()
cmd     "!quit" = write "QUIT" ":Exiting" >> (liftIO $ exitWith ExitSuccess)
cmd x | "!id " `isPrefixOf` x = privmsg $ drop 4 x
      | x == response = write "JOIN" chan
cmd _  = return ()

privmsg :: String -> Net ()
privmsg s = write "PRIVMSG" $ chan ++ " :" ++ s

write :: String -> String -> Net ()
write s t = do
    h <- asks socket
    liftIO $ hPrintf h "%s %s\n" s t
    liftIO $ printf "> %s %s\n" s t

$ ./cabal-dev/bin/tob

NICK tob
USER tob 0 * :haskell bot
:barjavel.freenode.net NOTICE * :* Looking up your hostname...
:barjavel.freenode.net NOTICE * :* Checking Ident
:barjavel.freenode.net NOTICE * :* Couldn't look up your hostname
:barjavel.freenode.net NOTICE * :* No Ident response
ERROR :Closing Link: 127.0.0.1 (Connection timed out)