Difference between revisions of "Roll your own IRC bot"
DonStewart (talk | contribs) m (small clarification) |
DonStewart (talk | contribs) (And done. First draft.) |
||
Line 35: | Line 35: | ||
Using runhaskell: |
Using runhaskell: |
||
+ | |||
− | <code> |
||
$ runhaskell 1.hs |
$ runhaskell 1.hs |
||
"NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** |
"NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** |
||
Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ... |
Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ... |
||
− | </code> |
||
Or we can just compile it to an executable with GHC: |
Or we can just compile it to an executable with GHC: |
||
+ | |||
− | <code> |
||
$ ghc --make 1.hs -o tutbot |
$ ghc --make 1.hs -o tutbot |
||
Chasing modules from: 1.hs |
Chasing modules from: 1.hs |
||
Line 50: | Line 49: | ||
"NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** |
"NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** |
||
Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ... |
Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ... |
||
+ | |||
− | </code> |
||
Or using GHCi: |
Or using GHCi: |
||
+ | |||
− | <code> |
||
$ ghci 1.hs |
$ ghci 1.hs |
||
*Main> main |
*Main> main |
||
"NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** |
"NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** |
||
Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ... |
Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ... |
||
− | </code> |
||
Or in Hugs: |
Or in Hugs: |
||
+ | |||
− | <code> |
||
$ runhugs 1.hs |
$ runhugs 1.hs |
||
"NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** |
"NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** |
||
Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ... |
Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ... |
||
− | </code> |
||
Great! We're on the network. |
Great! We're on the network. |
||
Line 152: | Line 149: | ||
Let's run this thing: |
Let's run this thing: |
||
+ | |||
− | <code> |
||
$ runhaskell 2.hs |
$ runhaskell 2.hs |
||
> NICK tutbot |
> NICK tutbot |
||
Line 168: | Line 165: | ||
:orwell.freenode.net 353 tutbot @ #tutbot-testing :@tutbot |
:orwell.freenode.net 353 tutbot @ #tutbot-testing :@tutbot |
||
:orwell.freenode.net 366 tutbot #tutbot-testing :End of /NAMES list. |
:orwell.freenode.net 366 tutbot #tutbot-testing :End of /NAMES list. |
||
− | </code> |
||
And we're in business! From an irc client, we can watch the bot connect: |
And we're in business! From an irc client, we can watch the bot connect: |
||
+ | |||
− | <code> |
||
15:02 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing |
15:02 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing |
||
15:02 dons> hello |
15:02 dons> hello |
||
− | </code> |
||
And the bot logs to standard output: |
And the bot logs to standard output: |
||
+ | |||
− | <code> |
||
:dons!i=dons@my.net PRIVMSG #tutbot-testing :hello |
:dons!i=dons@my.net PRIVMSG #tutbot-testing :hello |
||
− | </code> |
||
We can now implement some commands. |
We can now implement some commands. |
||
Line 255: | Line 249: | ||
Here's a transcript from our minimal bot running in channel: |
Here's a transcript from our minimal bot running in channel: |
||
+ | |||
− | <code> |
||
15:12 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing |
15:12 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing |
||
15:13 dons> !id hello, world! |
15:13 dons> !id hello, world! |
||
Line 263: | Line 257: | ||
15:13 dons> !quit |
15:13 dons> !quit |
||
15:13 -- tutbot [n=tutbot@aa.bb.cc.dd] has quit [Client Quit] |
15:13 -- tutbot [n=tutbot@aa.bb.cc.dd] has quit [Client Quit] |
||
− | </code> |
||
Now, before we go further, let's refactor the code a bit. |
Now, before we go further, let's refactor the code a bit. |
||
Line 458: | Line 451: | ||
Note that we threw in a new control structure, <hask>notify</hask>, for |
Note that we threw in a new control structure, <hask>notify</hask>, for |
||
− | fun. Now we're almost done! Let's run this bot. |
+ | fun. Now we're almost done! Let's run this bot. Using GHC/runhaskell: |
− | + | $ runhaskell 4.hs |
|
− | <code> |
||
− | $ runhaskell 4.hs |
||
− | </code> |
||
+ | $ ghc --make 4.hs -o tutbot |
||
− | <code> |
||
+ | Chasing modules from: 4.hs |
||
− | $ ghc --make 4.hs -o tutbot |
||
+ | Compiling Main ( 4.hs, 4.o ) |
||
− | Chasing modules from: 4.hs |
||
+ | Linking ... |
||
− | Compiling Main ( 4.hs, 4.o ) |
||
+ | $ ./tutbot |
||
− | Linking ... |
||
− | $ ./tutbot |
||
− | </code> |
||
If you're using Hugs, you'll have to use the <hask>-98</hask> flag: |
If you're using Hugs, you'll have to use the <hask>-98</hask> flag: |
||
+ | |||
− | <code> |
||
− | $ runhugs -98 4.hs |
+ | $ runhugs -98 4.hs |
− | </code> |
||
And from an IRC client we can watch it connect: |
And from an IRC client we can watch it connect: |
||
− | <code> |
||
15:26 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing |
15:26 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing |
||
15:28 dons> !id all good? |
15:28 dons> !id all good? |
||
Line 486: | Line 472: | ||
15:28 dons> !quit |
15:28 dons> !quit |
||
15:28 -- tutbot [n=tutbot@aa.bb.cc.dd] has quit [Client Quit] |
15:28 -- tutbot [n=tutbot@aa.bb.cc.dd] has quit [Client Quit] |
||
− | </code> |
||
So we now have a bot with explicit read-only monadic state, error |
So we now have a bot with explicit read-only monadic state, error |
||
handling, and some basic IRC operations. |
handling, and some basic IRC operations. |
||
+ | |||
+ | == Extending the bot == |
||
+ | |||
+ | Let's implement a basic new command: uptime tracking. Conceptually, we |
||
+ | need to remember the time the bot starts. Then, if a user requests, we |
||
+ | work out the total running time, and print it as a string. A nice way to |
||
+ | do this is to extend the bot's state with a start time field: |
||
+ | |||
+ | <haskell> |
||
+ | data Bot = Bot { socket :: Handle, starttime :: ClockTime } |
||
+ | </haskell> |
||
+ | |||
+ | We can then modify the initial <hask>connect</hask> function to also set |
||
+ | the start time. |
||
+ | |||
+ | <haskell> |
||
+ | connect :: IO Bot |
||
+ | connect = notify $ do |
||
+ | t <- getClockTime |
||
+ | h <- connectTo server (PortNumber (fromIntegral port)) |
||
+ | hSetBuffering h NoBuffering |
||
+ | return (Bot h t) |
||
+ | </haskell> |
||
+ | |||
+ | We then add a new case to the <hask>eval</hask> function, to handle |
||
+ | uptime requests: |
||
+ | |||
+ | <haskell> |
||
+ | eval "!uptime" = uptime >>= privmsg |
||
+ | </haskell> |
||
+ | |||
+ | This will just run the <hask>uptime</hask> function, and send it back to |
||
+ | the server. <hask>uptime</hask> itself is: |
||
+ | |||
+ | <haskell> |
||
+ | uptime :: Net String |
||
+ | uptime = do |
||
+ | now <- io getClockTime |
||
+ | zero <- asks starttime |
||
+ | return . pretty $ diffClockTimes now zero |
||
+ | </haskell> |
||
+ | |||
+ | That is, in the Net monad, find the current time and the start time, and |
||
+ | then calculate the difference, returning that number as a string. |
||
+ | Rather than use the normal representation for dates, we'll write our own |
||
+ | custom formatter for dates: |
||
+ | |||
+ | <haskell> |
||
+ | -- |
||
+ | -- 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 |
||
+ | </haskell> |
||
+ | |||
+ | And that's it. Running the bot with this new command: |
||
+ | |||
+ | 16:03 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing |
||
+ | 16:03 dons> !uptime |
||
+ | 16:03 tutbot> 51s |
||
+ | 16:03 dons> !uptime |
||
+ | 16:03 tutbot> 1m 1s |
||
+ | 16:12 dons> !uptime |
||
+ | 16:12 tutbot> 9m 46s |
||
+ | |||
+ | == Where to now? == |
||
+ | |||
+ | This is just a flavour of application programming in Haskell, and only |
||
+ | hints at the power of Haskell's lazy evaluation, static typing, monadic |
||
+ | effects and higher order functions. There is much, much more to be said |
||
+ | on these topics. Some places to start: |
||
+ | |||
+ | * The [[/Source|complete bot source]] (also [http://www.cse.unsw.edu.au/~dons/irc/bot.html mirrored here]) |
||
+ | * [[Haskell|Haskell.org]] |
||
+ | * [[Example_code|More Haskell code]] |
||
+ | * [[Books_and_tutorials|Learning Haskell]] |
||
[[Category:Tutorials]] |
[[Category:Tutorials]] |
Revision as of 05:19, 4 October 2006
This tutorial is designed as a practical guide to writing real world code in Haskell, and hopes to intuitively motivate and introduce some of the advanced features of Haskell to the novice programmer. Our goal is to write a concise, robust and elegant IRC bot in Haskell.
Getting started
You'll need a reasonably recent version of GHC or Hugs. Our first step is to get on the network. So let's start by importing the Network package, and the standard IO library and defining a server to connect to.
import Network
import System.IO
server = "irc.freenode.org"
port = 6667
main = do
h <- connectTo server (PortNumber (fromIntegral port))
hSetBuffering h NoBuffering
t <- hGetContents h
print t
The key here is the main
function. This is the entry point
to a Haskell program. We first connect to the server, then set the
buffering on the socket off. Once we've got a socket, we can then just
read and print any data we receive.
Put this code in the module 1.hs
, and we can then run it.
Use whichever system you like:
Using runhaskell:
$ runhaskell 1.hs "NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ...
Or we can just compile it to an executable with GHC:
$ ghc --make 1.hs -o tutbot Chasing modules from: 1.hs Compiling Main ( 1.hs, 1.o ) Linking ... $ ./tutbot "NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ...
Or using GHCi:
$ ghci 1.hs *Main> main "NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ...
Or in Hugs:
$ runhugs 1.hs "NOTICE AUTH :*** Looking up your hostname...\r\nNOTICE AUTH :*** Checking ident\r\nNOTICE AUTH :*** Found your hostname\r\n ...
Great! We're on the network.
Talking IRC
Now we're listening to the server, we better start sending some information back. Three details are important: the nick, the user name, and a channel to join. So let's send those.
import Network
import System.IO
import Text.Printf
server = "irc.freenode.org"
port = 6667
chan = "#tutbot-testing"
nick = "tutbot"
main = do
h <- connectTo server (PortNumber (fromIntegral port))
hSetBuffering h NoBuffering
write h "NICK" nick
write h "USER" (nick++" 0 * :tutorial bot")
write h "JOIN" chan
listen h
write :: Handle -> String -> String -> IO ()
write h s t = do
hPrintf h "%s %s\r\n" s t
printf "> %s %s\n" s t
listen h = forever $ do
s <- hGetLine h
putStrLn s
where
forever a = a >> forever a
Now, we've done quite a few things here. Firstly, we import
Text.Printf
, which will be useful. We also set up a channel
name and bot nickname. The main
function has been extended
to send messages back to the IRC server, using a write
function. Let's look at that a bit more closely:
write :: Handle -> String -> String -> IO ()
write h s t = do
hPrintf h "%s %s\r\n" s t
printf "> %s %s\n" s t
We've given write
an explicit type to help document it, and
we'll use explicit types signatures from now on, as they're just good
practice (though of course not required, as Haskell uses type inference
to work out the types anyway).
The write
function takes 3 arguments: a handle (our
socket), and then two strings representing an IRC protocol action, and
any arguments it takes. write
then uses hPrintf
to build an IRC message, and write it over the wire to the server. For
debugging purposes we also print to standard output the message we send.
Our second function, listen
, is as follows:
listen :: Handle -> IO ()
listen h = forever $ do
s <- hGetLine h
putStrLn s
where
forever a = a >> forever a
This function takes a Handle argument, and sits in an infinite loop
reading lines of text from the network, and printing them. We take
advantage of two powerful features, lazy evaluation and higher order
functions, to roll our own loop control structure, forever
,
as a normal function! forever
takes a chunk of code as an
argument, evaluates it, and recurses -- an infinite loop function. It
is very common to roll our own control structures in Haskell this way,
using higher order functions. No need to add new syntax to the language,
when you can just write a normal function to implement whatever control
flow you wish.
Let's run this thing:
$ runhaskell 2.hs > NICK tutbot > USER tutbot 0 * :tutorial bot > JOIN #tutbot-testing NOTICE AUTH :*** Looking up your hostname... NOTICE AUTH :*** Found your hostname, welcome back NOTICE AUTH :*** Checking ident NOTICE AUTH :*** No identd (auth) response :orwell.freenode.net 001 tutbot :Welcome to the freenode IRC Network tutbot :orwell.freenode.net 002 tutbot :Your host is orwell.freenode.net ... :tutbot!n=tutbot@aa.bb.cc.dd JOIN :#tutbot-testing :orwell.freenode.net MODE #tutbot-testing +ns :orwell.freenode.net 353 tutbot @ #tutbot-testing :@tutbot :orwell.freenode.net 366 tutbot #tutbot-testing :End of /NAMES list.
And we're in business! From an irc client, we can watch the bot connect:
15:02 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing 15:02 dons> hello
And the bot logs to standard output:
:dons!i=dons@my.net PRIVMSG #tutbot-testing :hello
We can now implement some commands.
A simple interpreter
import Network
import System.IO
import Text.Printf
import Data.List
import System.Exit
server = "irc.freenode.org"
port = 6667
chan = "#tutbot-testing"
nick = "tutbot"
main :: IO ()
main = do
h <- connectTo server (PortNumber (fromIntegral port))
hSetBuffering h NoBuffering
write h "NICK" nick
write h "USER" (nick++" 0 * :tutorial bot")
write h "JOIN" chan
listen h
listen :: Handle -> IO ()
listen h = forever $ do
s <- init `fmap` hGetLine h
if ping s then pong s else eval h (clean s)
putStrLn s
where
forever a = a >> forever a
clean = drop 1 . dropWhile (/= ':') . drop 1
ping x = "PING :" `isPrefixOf` x
pong x = write h "PONG" (':' : drop 6 x)
eval :: Handle -> String -> IO ()
eval h "!quit" = write h "QUIT" ":Exiting" >> exitWith ExitSuccess
eval h x | "!id " `isPrefixOf` x = privmsg h (drop 4 x)
eval _ _ = return () -- ignore everything else
privmsg :: Handle -> String -> IO ()
privmsg h s = write h "PRIVMSG" (chan ++ " :" ++ s)
write :: Handle -> String -> String -> IO ()
write h s t = do
hPrintf h "%s %s\r\n" s t
printf "> %s %s\n" s t
We add 3 features to the bot here, by modifying listen
.
Firstly, it responds to PING
messages: if ping s then pong s ...
. This is useful for servers that require pings to
keep clients connected. We also add a new function, eval
,
which takes a cleaned up input string, and then dispatches bot commands
where appropriate:
eval :: Handle -> String -> IO ()
eval h "!quit" = write h "QUIT" ":Exiting" >> exitWith ExitSuccess
eval h x | "!id " `isPrefixOf` x = privmsg h (drop 4 x)
eval _ _ = return () -- ignore everything else
So, if the single string "!quit" is received, we inform the server, and
exit the program. If a string beginning with "!id" we echo any argument
string back to the server (id
id is the Haskell identity
function, which just returns its argument). Finally, if no other matches
occur, we do nothing.
We add the privmsg
function, a useful wrapper over
write
for sending PRIVMSG
lines to the server.
Here's a transcript from our minimal bot running in channel:
15:12 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing 15:13 dons> !id hello, world! 15:13 tutbot> hello, world! 15:13 dons> !id very pleased to meet you. 15:13 tutbot> very pleased to meet you. 15:13 dons> !quit 15:13 -- tutbot [n=tutbot@aa.bb.cc.dd] has quit [Client Quit]
Now, before we go further, let's refactor the code a bit.
Roll your own monad
A small annoyance so far has been that we've had to thread around our socket to every function that needs to talk to the network. The socket is essentially immutable state, that could be treated as a global read only value in other languages. In Haskell, we can implement such a structure using a state monad. Monads are a very powerful abstraction, , and we'll only touch on them here. The interested reader is referred to All About Monads. We'll be using a custom monad specifically to implement a read-only global state for our bot.
The key requirement is that we wish to be able to perform IO actions, as well as thread a small state value transparently through the program. As this is Haskell, we can take the extra step of partitioning our stateful code from all other program code, using a new type.
So let's define a small state monad:
data Bot = Bot { socket :: Handle }
type Net = ReaderT Bot IO
Firstly, we define a data type for the global state. In this case, it is
the Bot
type, a simple struct storing our network socket.
When then layer this data type over our existing IO code, with a
monad transformer. This isn't as scary as it sounds, and the
effect is that we can just treat the socket as a global read-only value,
anywhere we need it. We'll call this new io + state structure the
Net
monad.
We can now throw out all that socket threading, and just grab the socket
when we need it. The key steps are, once we've connected to the server,
to initialise our new state monad, and the main bot loop with that
state. We add a small function, which takes the intial bot state, and
evaluates the bot's run
loop "in" the Net monad.
loop st = runReaderT run st
While we're here we can tidy up the main function a little, by using
bracket
to explicitly delimit the connection, shutdown and
main loop phases of the program -- a useful technique. We can also make
the code a bit more robust, by wrapping the main loop in an exception
handler, using catch
:
main :: IO ()
main = bracket connect disconnect loop
where
disconnect = hClose . socket
loop st = catch (runReaderT run st) (const $ return ())
That is, the higher order function bracket
takes 3
arguments: a function to connect to the server, and function to
disconnect, and a main loop to run in between. We can use
bracket
whenever we wish to run some code before and after
a particular action -- like forever
, this is another
control structure implemented as a normal Haskell function.
Rather than threading the socket around, we can now simply ask for it
when needed. Note that the type of write
changes: it is in
the Net monad, which tells us that the bot must already by connected to
a server (and thus it is ok to use the socket, as it is initialised).
--
-- 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
In order to use both state and IO, we use the small io
function to lift an IO expression into the Net monad. This
tells the compiler.
io :: IO a -> Net a
io = liftIO
The monadic, stateful, exception-handling bot in all its glory:
import Data.List
import Network
import System.IO
import System.Exit
import Control.Monad.Reader
import Control.Exception
import Control.Concurrent
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.
--
type Net = ReaderT Bot IO
data Bot = Bot { socket :: Handle }
--
-- 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
h <- connectTo server (PortNumber (fromIntegral port))
hSetBuffering h NoBuffering
return (Bot h)
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 "!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
--
-- Convenience.
--
io :: IO a -> Net a
io = liftIO
Note that we threw in a new control structure, notify
, for
fun. Now we're almost done! Let's run this bot. Using GHC/runhaskell:
$ runhaskell 4.hs
$ ghc --make 4.hs -o tutbot Chasing modules from: 4.hs Compiling Main ( 4.hs, 4.o ) Linking ... $ ./tutbot
If you're using Hugs, you'll have to use the -98
flag:
$ runhugs -98 4.hs
And from an IRC client we can watch it connect:
15:26 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing 15:28 dons> !id all good? 15:28 tutbot> all good? 15:28 dons> !quit 15:28 -- tutbot [n=tutbot@aa.bb.cc.dd] has quit [Client Quit]
So we now have a bot with explicit read-only monadic state, error handling, and some basic IRC operations.
Extending the bot
Let's implement a basic new command: uptime tracking. Conceptually, we need to remember the time the bot starts. Then, if a user requests, we work out the total running time, and print it as a string. A nice way to do this is to extend the bot's state with a start time field:
data Bot = Bot { socket :: Handle, starttime :: ClockTime }
We can then modify the initial connect
function to also set
the start time.
connect :: IO Bot
connect = notify $ do
t <- getClockTime
h <- connectTo server (PortNumber (fromIntegral port))
hSetBuffering h NoBuffering
return (Bot h t)
We then add a new case to the eval
function, to handle
uptime requests:
eval "!uptime" = uptime >>= privmsg
This will just run the uptime
function, and send it back to
the server. uptime
itself is:
uptime :: Net String
uptime = do
now <- io getClockTime
zero <- asks starttime
return . pretty $ diffClockTimes now zero
That is, in the Net monad, find the current time and the start time, and then calculate the difference, returning that number as a string. Rather than use the normal representation for dates, we'll write our own custom formatter for dates:
--
-- 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
And that's it. Running the bot with this new command:
16:03 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing 16:03 dons> !uptime 16:03 tutbot> 51s 16:03 dons> !uptime 16:03 tutbot> 1m 1s 16:12 dons> !uptime 16:12 tutbot> 9m 46s
Where to now?
This is just a flavour of application programming in Haskell, and only hints at the power of Haskell's lazy evaluation, static typing, monadic effects and higher order functions. There is much, much more to be said on these topics. Some places to start: