Roll your own IRC bot/Source
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
The complete IRC bot source from the Roll your own IRC bot tutorial. Free for any use.
--
-- A simple, clean IRC bot in Haskell
--
-- $ ghc -O --make -o bot bot.hs
-- $ ./bot
-- or
-- $ runhaskell bot.hs
-- or
-- $ echo main | ghci bot.hs
-- or
-- $ echo main | hugs -98 bot.hs
-- or
-- $ runhugs -98 bot.hs
--
import Data.List
import Network
import System.IO
import System.Time
import System.Exit
import Control.Monad.Reader
import Control.Exception
import Text.Printf
import Prelude hiding (catch)
server = "irc.freenode.org"
port = 6667
chan = "#tutbot-testing"
nick = "tutbot"
--
-- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
-- A socket and the bot's start time.
--
type Net = ReaderT Bot IO
data Bot = Bot { socket :: Handle, starttime :: ClockTime }
--
-- Set up actions to run on start and end, and run the main loop
--
main :: IO ()
main = bracket connect disconnect loop
where
disconnect = hClose . socket
loop st = catch (runReaderT run st) (const $ return ())
--
-- Connect to the server and return the initial bot state
--
connect :: IO Bot
connect = notify $ do
t <- getClockTime
h <- connectTo server (PortNumber (fromIntegral port))
hSetBuffering h NoBuffering
return (Bot h t)
where
notify a = bracket_
(printf "Connecting to %s ... " server >> hFlush stdout)
(putStrLn "done.")
a
--
-- We're in the Net monad now, so we've connected successfully
-- Join a channel, and start processing commands
--
run :: Net ()
run = do
write "NICK" nick
write "USER" (nick++" 0 * :tutorial bot")
write "JOIN" chan
asks socket >>= listen
--
-- Process each line from the server
--
listen :: Handle -> Net ()
listen h = forever $ do
s <- init `fmap` io (hGetLine h)
io (putStrLn s)
if ping s then pong s else eval (clean s)
where
forever a = a >> forever a
clean = drop 1 . dropWhile (/= ':') . drop 1
ping x = "PING :" `isPrefixOf` x
pong x = write "PONG" (':' : drop 6 x)
--
-- Dispatch a command
--
eval :: String -> Net ()
eval "!uptime" = uptime >>= privmsg
eval "!quit" = write "QUIT" ":Exiting" >> io (exitWith ExitSuccess)
eval x | "!id " `isPrefixOf` x = privmsg (drop 4 x)
eval _ = return () -- ignore everything else
--
-- Send a privmsg to the current chan + server
--
privmsg :: String -> Net ()
privmsg s = write "PRIVMSG" (chan ++ " :" ++ s)
--
-- Send a message out to the server we're currently connected to
--
write :: String -> String -> Net ()
write s t = do
h <- asks socket
io $ hPrintf h "%s %s\r\n" s t
io $ printf "> %s %s\n" s t
--
-- Calculate and pretty print the uptime
--
uptime :: Net String
uptime = do
now <- io getClockTime
zero <- asks starttime
return . pretty $ diffClockTimes now zero
--
-- Pretty print the date in '1d 9h 9m 17s' format
--
pretty :: TimeDiff -> String
pretty td = join . intersperse " " . filter (not . null) . map f $
[(years ,"y") ,(months `mod` 12,"m")
,(days `mod` 28,"d") ,(hours `mod` 24,"h")
,(mins `mod` 60,"m") ,(secs `mod` 60,"s")]
where
secs = abs $ tdSec td ; mins = secs `div` 60
hours = mins `div` 60 ; days = hours `div` 24
months = days `div` 28 ; years = months `div` 12
f (i,s) | i == 0 = []
| otherwise = show i ++ s
--
-- Convenience.
--
io :: IO a -> Net a
io = liftIO