Difference between revisions of "Roll your own IRC bot"
DonStewart (talk | contribs) m (clarify) |
(Connect to libera.chat instead of freenode) |
||
(50 intermediate revisions by 14 users not shown) | |||
Line 1: | Line 1: | ||
+ | |||
This tutorial is designed as a practical guide to writing real world |
This tutorial is designed as a practical guide to writing real world |
||
− | code in [http://haskell.org Haskell] |
+ | code in [http://haskell.org Haskell] and hopes to intuitively motivate |
and introduce some of the advanced features of Haskell to the novice |
and introduce some of the advanced features of Haskell to the novice |
||
programmer. Our goal is to write a concise, robust and elegant |
programmer. Our goal is to write a concise, robust and elegant |
||
[http://haskell.org/haskellwiki/IRC_channel IRC] bot in Haskell. |
[http://haskell.org/haskellwiki/IRC_channel IRC] bot in Haskell. |
||
+ | |||
+ | A packaged-up version of the code is [https://github.com/Lysxia/roll-your-own-irc-bot available on GitHub]. |
||
== Getting started == |
== Getting started == |
||
− | You'll need a reasonably recent version of [http://haskell.org/ghc GHC] |
+ | You'll need a reasonably recent version of [http://haskell.org/ghc GHC]. Our first step is to get on the |
+ | network. So let's start by importing modules from the standard library and the ''network'' package, and defining a server to connect to. |
||
− | or [http://haskell.org/hugs 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. |
||
<haskell> |
<haskell> |
||
+ | -- File 1.hs |
||
− | import Network |
||
− | import System.IO |
||
+ | import System.IO -- base |
||
− | server = "irc.freenode.org" |
||
+ | import qualified Network.Socket as N -- network |
||
− | port = 6667 |
||
+ | -- Configuration options |
||
+ | myServer = "irc.libera.chat" :: String |
||
+ | myPort = 6667 :: N.PortNumber |
||
+ | |||
+ | -- Toplevel program |
||
+ | main :: IO () |
||
main = do |
main = do |
||
− | h <- connectTo |
+ | h <- connectTo myServer myPort |
− | hSetBuffering h NoBuffering |
||
t <- hGetContents h |
t <- hGetContents h |
||
+ | hSetBuffering stdout NoBuffering |
||
print t |
print t |
||
+ | |||
+ | -- Connect to a server given its name and port number |
||
+ | connectTo :: N.HostName -> N.PortNumber -> IO Handle |
||
+ | connectTo host port = do |
||
+ | addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port)) |
||
+ | sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr) |
||
+ | N.connect sock (N.addrAddress addr) |
||
+ | N.socketToHandle sock ReadWriteMode |
||
</haskell> |
</haskell> |
||
+ | The key here is the <code>main</code> function. This is the entry point to a Haskell program. We first connect to the server and get a socket <code>h</code> (wrapped as a <code>Handle</code>). We can then read and print any data we receive. We disable buffering (<code>hSetBuffering</code>) on standard output, as <code>print</code> renders strings on a single line, with newline characters escaped. |
||
− | The key here is the <hask>main</hask> 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 < |
+ | Put this code in the module <code>1.hs</code> and we can then run it. Use whichever system you like: |
− | Use which ever system you like: |
||
Using runhaskell: |
Using runhaskell: |
||
Line 54: | Line 64: | ||
$ ghci 1.hs |
$ ghci 1.hs |
||
*Main> main |
*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 :*** |
"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 ... |
||
Line 67: | Line 71: | ||
== Talking IRC == |
== Talking IRC == |
||
− | Now we're listening to the server, we better start sending some |
+ | 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. |
− | information back. Three details are important: the nick, the user name, |
||
− | and a channel to join. So let's send those. |
||
<haskell> |
<haskell> |
||
+ | -- File 2.hs |
||
− | import Network |
||
− | import System.IO |
||
− | import Text.Printf |
||
+ | import System.IO -- base |
||
− | server = "irc.freenode.org" |
||
+ | import qualified Network.Socket as N -- network |
||
− | port = 6667 |
||
− | chan = "#tutbot-testing" |
||
− | nick = "tutbot" |
||
+ | -- Configuration options |
||
+ | myServer = "irc.libera.chat" :: String |
||
+ | myPort = 6667 :: N.PortNumber |
||
+ | myChan = "#tutbot-testing" :: String |
||
+ | myNick = "tutbot" :: String |
||
+ | |||
+ | -- Toplevel program |
||
+ | main :: IO () |
||
main = do |
main = do |
||
− | h <- connectTo |
+ | h <- connectTo myServer myPort |
− | + | write h "NICK" myNick |
|
− | write h " |
+ | write h "USER" (myNick ++ " 0 * :tutorial bot") |
− | write h " |
+ | write h "JOIN" myChan |
− | write h "JOIN" chan |
||
listen h |
listen h |
||
+ | -- Connect to a server given its name and port number |
||
+ | connectTo :: N.HostName -> N.PortNumber -> IO Handle |
||
+ | connectTo host port = do |
||
+ | addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port)) |
||
+ | sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr) |
||
+ | N.connect sock (N.addrAddress addr) |
||
+ | N.socketToHandle sock ReadWriteMode |
||
+ | |||
+ | -- Send a message to a handle |
||
write :: Handle -> String -> String -> IO () |
write :: Handle -> String -> String -> IO () |
||
− | write h |
+ | write h cmd args = do |
− | + | let msg = cmd ++ " " ++ args ++ "\r\n" |
|
+ | hPutStr h msg -- Send message on the wire |
||
− | printf "> %s %s\n" s t |
||
+ | putStr ("> " ++ msg) -- Show sent message on the command line |
||
+ | -- Process each line from the server |
||
+ | listen :: Handle -> IO () |
||
listen h = forever $ do |
listen h = forever $ do |
||
− | + | line <- hGetLine h |
|
− | putStrLn |
+ | putStrLn line |
where |
where |
||
− | forever |
+ | forever :: IO () -> IO () |
+ | forever a = do a; forever a |
||
</haskell> |
</haskell> |
||
− | Now, we've done quite a few things here. Firstly, we |
+ | Now, we've done quite a few things here. Firstly, we set up a channel name and bot nickname. The <code>main</code> function has been extended to send messages back to the IRC server using a <code>write</code> function. Let's look at that a bit more closely: |
− | <hask>Text.Printf</hask>, which will be useful. We also set up a channel |
||
− | name and bot nickname. The <hask>main</hask> function has been extended |
||
− | to send messages back to the IRC server, using a <hask>write</hask> |
||
− | function. Let's look at that a bit more closely: |
||
<haskell> |
<haskell> |
||
+ | -- Send a message to a handle |
||
write :: Handle -> String -> String -> IO () |
write :: Handle -> String -> String -> IO () |
||
− | write h |
+ | write h cmd args = do |
− | + | let msg = cmd ++ " " ++ args ++ "\r\n" |
|
+ | hPutStr h msg -- Send message on the wire |
||
− | printf "> %s %s\n" s t |
||
+ | putStr ("> " ++ msg) -- Show sent message on the command line |
||
</haskell> |
</haskell> |
||
+ | The <code>write</code> function takes 3 arguments; a handle (our socket), and then two strings representing an IRC protocol action, and any arguments it takes. <code>write</code> then builds an IRC message by concatenating strings and write it over the wire to the server. For debugging purposes we also print to standard output the message we send. |
||
− | We've given <hask>write</hask> 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). |
||
+ | Our second function, <code>listen</code>, is as follows: |
||
− | The <hask>write</hask> function takes 3 arguments: a handle (our |
||
− | socket), and then two strings representing an IRC protocol action, and |
||
− | any arguments it takes. <hask>write</hask> then uses <hask>hPrintf</hask> |
||
− | 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, <hask>listen</hask>, is as follows: |
||
<haskell> |
<haskell> |
||
+ | -- Process each line from the server |
||
listen :: Handle -> IO () |
listen :: Handle -> IO () |
||
listen h = forever $ do |
listen h = forever $ do |
||
− | + | line <- hGetLine h |
|
− | putStrLn |
+ | putStrLn line |
where |
where |
||
− | forever |
+ | forever :: IO () -> IO () |
+ | forever a = do a; forever a |
||
</haskell> |
</haskell> |
||
+ | This function takes a <code>Handle</code> 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, <code>forever</code>, as a normal function! <code>forever</code> 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, lisp-like macros or meta programming - you just write a normal function to implement whatever control flow you wish. We can also avoid <code>do</code>-notation, and directly write: <code>forever a = a >> forever a</code>. Note that <code>forever</code> can also be found in the standard library ''base'', in the module [https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#v:forever <code>Control.Monad</code>] (with a more general type). |
||
− | 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, <hask>forever</hask>, |
||
− | as a normal function! <hask>forever</hask> 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: |
Let's run this thing: |
||
<haskell> |
<haskell> |
||
− | + | $ 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 |
|
+ | :copper.libera.chat NOTICE * :*** Checking Ident |
||
− | :orwell.freenode.net 001 tutbot :Welcome to the freenode IRC Network tutbot |
||
+ | :copper.libera.chat NOTICE * :*** Looking up your hostname... |
||
− | :orwell.freenode.net 002 tutbot :Your host is orwell.freenode.net |
||
− | + | ... |
|
+ | :tutbot MODE tutbot :+iw |
||
− | :tutbot!n=tutbot@aa.bb.cc.dd JOIN :#tutbot-testing |
||
− | + | :tutbot!~tutbot@aa.bb.cc.dd JOIN :#tutbot-testing |
|
− | + | :copper.libera.chat 353 tutbot @ #tutbot-testing :tutbot @dons |
|
− | + | :copper.libera.chat 366 tutbot #tutbot-testing :End of /NAMES list. |
|
</haskell> |
</haskell> |
||
− | And we're in business! From an |
+ | 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 -- tutbot [n=tutbot@aa.bb.cc.dd] has joined #tutbot-testing |
||
Line 179: | Line 179: | ||
== A simple interpreter == |
== A simple interpreter == |
||
+ | |||
+ | Add these additional imports before changing the <code>listen</code> function. |
||
<haskell> |
<haskell> |
||
+ | import Data.List |
||
+ | import System.Exit |
||
+ | </haskell> |
||
+ | |||
+ | <haskell> |
||
+ | -- Connect to a server given its name and port number |
||
listen :: Handle -> IO () |
listen :: Handle -> IO () |
||
listen h = forever $ do |
listen h = forever $ do |
||
− | + | line <- hGetLine h |
|
+ | putStrLn line |
||
− | if ping s then pong s else eval h (clean s) |
||
− | + | let s = init line |
|
+ | if isPing s then pong s else eval h (clean s) |
||
where |
where |
||
− | forever |
+ | forever :: IO () -> IO () |
+ | forever a = do a; forever a |
||
− | clean = drop 1 . dropWhile (/= ':') . drop 1 |
||
+ | |||
− | ping x = "PING :" `isPrefixOf` x |
||
+ | clean :: String -> String |
||
− | pong x = write h "PONG" (':' : drop 6 x) |
||
+ | clean = drop 1 . dropWhile (/= ':') . drop 1 |
||
+ | |||
+ | isPing :: String -> Bool |
||
+ | isPing x = "PING :" `isPrefixOf` x |
||
+ | |||
+ | pong :: String -> IO () |
||
+ | pong x = write h "PONG" (':' : drop 6 x) |
||
</haskell> |
</haskell> |
||
− | We add 3 features to the bot here |
+ | We add 3 features to the bot here by modifying <code>listen</code>. |
− | Firstly, it responds to < |
+ | Firstly, it responds to <code>PING</code> messages: <code>if ping s then pong s ... </code>. |
− | + | This is useful for servers that require pings to keep clients connected. |
|
+ | Before we can process a command, remember the IRC protocol generates |
||
− | keep clients connected. We also add a new function, <hask>eval</hask>, |
||
+ | input lines of the form: |
||
− | which takes a cleaned up input string, and then dispatches bot commands |
||
− | where appropriate: |
||
<haskell> |
<haskell> |
||
+ | :dons!i=dons@my.net PRIVMSG #tutbot-testing :!id foo |
||
+ | </haskell> |
||
+ | |||
+ | so we need a <code>clean</code> function to simply drop the leading ':' character, and then everything up to the next ':', leaving just the actual command content. We then pass this cleaned up string to <code>eval</code>, which dispatches bot commands. |
||
+ | |||
+ | <haskell> |
||
+ | -- Dispatch a command |
||
eval :: Handle -> String -> IO () |
eval :: Handle -> String -> IO () |
||
− | eval h |
+ | eval h "!quit" = write h "QUIT" ":Exiting" >> exitSuccess |
eval h x | "!id " `isPrefixOf` x = privmsg h (drop 4 x) |
eval h x | "!id " `isPrefixOf` x = privmsg h (drop 4 x) |
||
eval _ _ = return () -- ignore everything else |
eval _ _ = return () -- ignore everything else |
||
</haskell> |
</haskell> |
||
+ | |||
+ | So, if the single string <code>"!quit"</code> is received, we inform the server and exit the program. If a string beginning with <code>"!id "</code> appears, we echo any argument string back to the server (the command is named after the identity function <code>id</code>, which just returns its argument). Finally, if no other matches occur, we do nothing. |
||
+ | We add the <code>privmsg</code> function - a useful wrapper over <code>write</code> for sending <code>PRIVMSG</code> lines to the server. |
||
− | So, if the single string "!quit" is received, we inform the server, and |
||
− | exit the program. If a string beginning with "!id" appears, we echo any argument |
||
− | string back to the server (<hask>id</hask> id is the Haskell identity |
||
− | function, which just returns its argument). Finally, if no other matches |
||
− | occur, we do nothing. |
||
+ | <haskell> |
||
− | We add the <hask>privmsg</hask> function, a useful wrapper over |
||
+ | -- Send a privmsg to the channel |
||
− | <hask>write</hask> for sending <hask>PRIVMSG</hask> lines to the server. |
||
+ | privmsg :: Handle -> String -> IO () |
||
+ | privmsg h s = write h "PRIVMSG" (chan ++ " :" ++ s) |
||
+ | </haskell> |
||
Here's a transcript from our minimal bot running in channel: |
Here's a transcript from our minimal bot running in channel: |
||
Line 230: | Line 253: | ||
== Roll your own monad == |
== 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 <em>immutable state</em>, that could be treated as a global read only value in other languages. In Haskell, we can implement such a structure using a <em>reader monad</em>. Monads are a very powerful abstraction, and we'll only touch on them here. The interested reader is referred to [http://www.haskell.org/haskellwiki/All_About_Monads All About Monads]. We'll be using a custom monad specifically to implement a read-only global state for our bot. |
||
− | 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 <em>immutable state</em>, that could be treated as a |
||
− | global read only value in other languages. In Haskell, we can implement |
||
− | such a structure using a state <em>monad</em>. Monads are a very powerful |
||
− | abstraction, and we'll only touch on them here. The interested reader is |
||
− | referred to [http://www.nomaware.com/monads/ 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, |
+ | 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. |
− | 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 |
+ | So let's define a small reader monad: |
<haskell> |
<haskell> |
||
+ | -- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state. |
||
− | data Bot = Bot { socket :: Handle } |
||
+ | data Bot = Bot { botSocket :: Handle } |
||
− | |||
type Net = ReaderT Bot IO |
type Net = ReaderT Bot IO |
||
</haskell> |
</haskell> |
||
+ | Firstly, we define a data type for the global state. In this case, it is the <code>Bot</code> type, a simple struct storing our network socket. We then layer this data type over our existing IO code, with a <em>monad transformer</em>. This isn't as scary as it sounds and the effect is that we can treat the socket as a global read-only value anywhere we need it. We'll call this new IO + state structure the <code>Net</code> monad. <code>ReaderT</code> is a <em>type constructor</em>, essentially a type function, that takes 2 types as arguments, building a result type: the <code>Net</code> monad type. |
||
− | Firstly, we define a data type for the global state. In this case, it is |
||
− | the <hask>Bot</hask> type, a simple struct storing our network socket. |
||
− | We then layer this data type over our existing IO code, with a |
||
− | <em>monad transformer</em>. 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 |
||
− | <hask>Net</hask> monad. |
||
+ | We can now throw out all that socket threading and grab the socket when we need it. The key steps are connecting to the server, followed by the initialisation of our new reader monad and then to run the main bot loop with that global value. We add a small function, which takes the intial bot state and evaluates the bot's <code>run</code> loop "in" the Net monad, using the Reader monad's <code>runReaderT</code> function: |
||
− | 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 then to run the main bot loop |
||
− | with that state. We add a small function, which takes the intial bot |
||
− | state, and evaluates the bot's <hask>run</hask> loop "in" the Net monad. |
||
<haskell> |
<haskell> |
||
Line 270: | Line 272: | ||
</haskell> |
</haskell> |
||
+ | where <code>run</code> is a small function to register the bot's nick, join a channel, and start listening for commands. |
||
− | While we're here we can tidy up the main function a little, by using |
||
+ | |||
− | <hask>bracket</hask> to explicitly delimit the connection, shutdown and |
||
+ | While we're here, we can tidy up the main function a little by using [https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Exception.html <code>Control.Exception.bracket</code>] to explicitly delimit the connection, shutdown and main loop phases of the program - a useful technique. |
||
− | 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 <hask>catch</hask>: |
||
<haskell> |
<haskell> |
||
+ | -- Toplevel program |
||
main :: IO () |
main :: IO () |
||
main = bracket connect disconnect loop |
main = bracket connect disconnect loop |
||
where |
where |
||
disconnect = hClose . socket |
disconnect = hClose . socket |
||
− | loop st = |
+ | loop st = runReaderT run st |
</haskell> |
</haskell> |
||
+ | That is, the higher order function <code>bracket</code> takes 3 arguments: a function to connect to the server, a function to disconnect and a main loop to run in between. We can use <code>bracket</code> whenever we wish to run some code before and after a particular action - like <code>forever</code>, this is another control structure implemented as a normal Haskell function. |
||
− | That is, the higher order function <hask>bracket</hask> 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 |
||
− | <hask>bracket</hask> whenever we wish to run some code before and after |
||
− | a particular action -- like <hask>forever</hask>, this is another |
||
− | control structure implemented as a normal Haskell function. |
||
− | Rather than threading the socket around, we can now simply ask for it |
+ | Rather than threading the socket around, we can now simply ask for it when needed. Note that the type of <code>write</code> changes - it is in the <code>Net</code> 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). |
− | when needed. Note that the type of <hask>write</hask> 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). |
||
<haskell> |
<haskell> |
||
− | -- |
||
-- Send a message out to the server we're currently connected to |
-- Send a message out to the server we're currently connected to |
||
− | -- |
||
write :: String -> String -> Net () |
write :: String -> String -> Net () |
||
− | write |
+ | write cmd args = do |
− | h <- asks |
+ | h <- asks botSocket |
− | + | let msg = cmd ++ " " ++ args ++ "\r\n" |
|
− | + | liftIO $ hPutStr h msg -- Send message on the wire |
|
+ | liftIO $ putStr ("> " ++ msg) -- Show sent message on the command line |
||
</haskell> |
</haskell> |
||
− | In order to use both state and IO, we use the |
+ | In order to use both state and IO, we use the <code>liftIO</code> function to <em>lift</em> an IO expression into the <code>Net</code> monad making that IO function available to code in the <code>Net</code> monad. |
− | function to <em>lift</em> an IO expression into the Net monad, making |
||
− | that IO function available to code in the <hask>Net</hask> monad. |
||
<haskell> |
<haskell> |
||
+ | -- Imported from Control.Monad.IO.Class |
||
− | io :: IO a -> Net a |
||
+ | liftIO :: IO a -> Net a |
||
− | io = liftIO |
||
</haskell> |
</haskell> |
||
Line 319: | Line 309: | ||
<haskell> |
<haskell> |
||
+ | -- File 4.hs |
||
− | 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) |
||
+ | import Control.Exception -- base |
||
− | server = "irc.freenode.org" |
||
+ | import Control.Monad.IO.Class -- |
||
− | port = 6667 |
||
+ | import Data.List -- |
||
− | chan = "#tutbot-testing" |
||
+ | import System.Exit -- |
||
− | nick = "tutbot" |
||
+ | import System.IO -- |
||
+ | import qualified Network.Socket as N -- network |
||
+ | import Control.Monad.Trans.Reader -- transformers |
||
+ | -- Configuration options |
||
− | -- |
||
+ | myServer = "irc.libera.chat" :: String |
||
− | -- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state. |
||
+ | myPort = 6667 :: N.PortNumber |
||
− | -- |
||
+ | myChan = "#tutbot-testing" :: String |
||
− | type Net = ReaderT Bot IO |
||
− | + | myNick = "tutbot" :: String |
|
− | -- |
||
-- Set up actions to run on start and end, and run the main loop |
-- Set up actions to run on start and end, and run the main loop |
||
− | -- |
||
main :: IO () |
main :: IO () |
||
main = bracket connect disconnect loop |
main = bracket connect disconnect loop |
||
where |
where |
||
− | disconnect = hClose . |
+ | disconnect = hClose . botSocket |
− | loop st |
+ | loop st = runReaderT run st |
+ | |||
+ | -- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state. |
||
+ | data Bot = Bot { botSocket :: Handle } |
||
+ | type Net = ReaderT Bot IO |
||
− | -- |
||
-- Connect to the server and return the initial bot state |
-- Connect to the server and return the initial bot state |
||
− | -- |
||
connect :: IO Bot |
connect :: IO Bot |
||
connect = notify $ do |
connect = notify $ do |
||
− | h <- connectTo |
+ | h <- connectTo myServer myPort |
− | hSetBuffering h NoBuffering |
||
return (Bot h) |
return (Bot h) |
||
where |
where |
||
notify a = bracket_ |
notify a = bracket_ |
||
− | + | (putStrLn ("Connecting to " ++ myServer ++ " ...") >> hFlush stdout) |
|
− | + | (putStrLn "done.") |
|
− | + | a |
|
+ | |||
+ | -- Connect to the server and return a Handle (helper for connect) |
||
+ | connectTo :: N.HostName -> N.PortNumber -> IO Handle |
||
+ | connectTo host port = do |
||
+ | addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port)) |
||
+ | sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr) |
||
+ | N.connect sock (N.addrAddress addr) |
||
+ | N.socketToHandle sock ReadWriteMode |
||
− | -- |
||
-- We're in the Net monad now, so we've connected successfully |
-- We're in the Net monad now, so we've connected successfully |
||
-- Join a channel, and start processing commands |
-- Join a channel, and start processing commands |
||
− | -- |
||
run :: Net () |
run :: Net () |
||
run = do |
run = do |
||
− | write "NICK" |
+ | write "NICK" myNick |
− | write "USER" ( |
+ | write "USER" (myNick ++ " 0 * :tutorial bot") |
− | write "JOIN" |
+ | write "JOIN" myChan |
− | + | listen |
|
+ | |||
+ | -- Send a message to the server we're currently connected to |
||
+ | write :: String -> String -> Net () |
||
+ | write cmd args = do |
||
+ | h <- asks botSocket |
||
+ | let msg = cmd ++ " " ++ args ++ "\r\n" |
||
+ | liftIO $ hPutStr h msg -- Send message on the wire |
||
+ | liftIO $ putStr ("> " ++ msg) -- Show sent message on the command line |
||
− | -- |
||
-- Process each line from the server |
-- Process each line from the server |
||
+ | listen :: Net () |
||
− | -- |
||
− | listen |
+ | listen = forever $ do |
+ | h <- asks botSocket |
||
− | listen h = forever $ do |
||
− | + | line <- liftIO $ hGetLine h |
|
− | + | liftIO (putStrLn line) |
|
+ | let s = init line |
||
− | if ping s then pong s else eval (clean s) |
||
+ | if isPing s then pong s else eval (clean s) |
||
where |
where |
||
− | forever |
+ | forever :: Net () -> Net () |
+ | forever a = do a; forever a |
||
− | clean = drop 1 . dropWhile (/= ':') . drop 1 |
||
+ | |||
− | ping x = "PING :" `isPrefixOf` x |
||
+ | clean :: String -> String |
||
− | pong x = write "PONG" (':' : drop 6 x) |
||
+ | clean = drop 1 . dropWhile (/= ':') . drop 1 |
||
+ | |||
+ | isPing :: String -> Bool |
||
+ | isPing x = "PING :" `isPrefixOf` x |
||
+ | |||
+ | pong :: String -> Net () |
||
+ | pong x = write "PONG" (':' : drop 6 x) |
||
− | -- |
||
-- Dispatch a command |
-- Dispatch a command |
||
− | -- |
||
eval :: String -> Net () |
eval :: String -> Net () |
||
− | eval |
+ | eval "!quit" = write "QUIT" ":Exiting" >> liftIO exitSuccess |
eval x | "!id " `isPrefixOf` x = privmsg (drop 4 x) |
eval x | "!id " `isPrefixOf` x = privmsg (drop 4 x) |
||
− | eval |
+ | eval _ = return () -- ignore everything else |
− | -- |
||
-- Send a privmsg to the current chan + server |
-- Send a privmsg to the current chan + server |
||
− | -- |
||
privmsg :: String -> Net () |
privmsg :: String -> Net () |
||
− | privmsg |
+ | privmsg msg = write "PRIVMSG" (myChan ++ " :" ++ msg) |
− | |||
− | -- |
||
− | -- 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 |
||
</haskell> |
</haskell> |
||
− | Note that we threw in a new control structure, < |
+ | Note that we threw in a new control structure, <code>notify</code>, for fun. Now we're almost done! Let's run this bot. Using runhaskell: |
− | fun. Now we're almost done! Let's run this bot. Using GHC/runhaskell: |
||
$ runhaskell 4.hs |
$ runhaskell 4.hs |
||
+ | |||
+ | or using GHC: |
||
$ ghc --make 4.hs -o tutbot |
$ ghc --make 4.hs -o tutbot |
||
Line 428: | Line 415: | ||
Linking ... |
Linking ... |
||
$ ./tutbot |
$ ./tutbot |
||
− | |||
− | If you're using Hugs, you'll have to use the <hask>-98</hask> flag: |
||
− | |||
− | $ runhugs -98 4.hs |
||
And from an IRC client we can watch it connect: |
And from an IRC client we can watch it connect: |
||
Line 441: | Line 424: | ||
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] |
||
− | 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. If we wished to add read-write state, we need only change the <code>ReaderT</code> transformer to <code>StateT</code>. |
− | handling, and some basic IRC operations. If we wished to add read-write |
||
− | state, we need only change the <hask>ReaderT</hask> transformer to |
||
− | <hask>StateT</hask>. |
||
== Extending the bot == |
== Extending the bot == |
||
− | Let's implement a basic new command: uptime tracking. Conceptually, we |
+ | 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: |
− | 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> |
<haskell> |
||
+ | import Data.Time |
||
− | data Bot = Bot { socket :: Handle, starttime :: ClockTime } |
||
</haskell> |
</haskell> |
||
+ | <haskell> |
||
− | We can then modify the initial <hask>connect</hask> function to also set |
||
+ | -- Updated Bot type |
||
− | the start time. |
||
+ | data Bot = Bot { botSocket :: Handle, startTime :: UTCTime } |
||
+ | </haskell> |
||
+ | |||
+ | We can then modify the initial <code>connect</code> function to also set the start time. |
||
<haskell> |
<haskell> |
||
+ | -- Connect to the server and return the initial bot state |
||
connect :: IO Bot |
connect :: IO Bot |
||
connect = notify $ do |
connect = notify $ do |
||
− | t <- |
+ | t <- getCurrentTime |
− | h <- connectTo |
+ | h <- connectTo myServer myPort |
− | hSetBuffering h NoBuffering |
||
return (Bot h t) |
return (Bot h t) |
||
</haskell> |
</haskell> |
||
− | We then add a new case to the < |
+ | We then add a new case to the <code>eval</code> function, to handle uptime requests: |
− | uptime requests: |
||
<haskell> |
<haskell> |
||
eval "!uptime" = uptime >>= privmsg |
eval "!uptime" = uptime >>= privmsg |
||
+ | eval ... |
||
</haskell> |
</haskell> |
||
− | This will |
+ | This will run the <code>uptime</code> function and send it back to the server. <code>uptime</code> itself is: |
− | the server. <hask>uptime</hask> itself is: |
||
<haskell> |
<haskell> |
||
+ | -- Get the current uptime |
||
uptime :: Net String |
uptime :: Net String |
||
uptime = do |
uptime = do |
||
− | + | now <- liftIO getCurrentTime |
|
− | + | zero <- asks startTime |
|
− | + | return (pretty (diffUTCTime now zero)) |
|
</haskell> |
</haskell> |
||
− | That is, in the Net monad, find the current time and the start time, and |
+ | That is, in the <code>Net</code> 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: |
− | 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> |
<haskell> |
||
− | -- |
||
-- Pretty print the date in '1d 9h 9m 17s' format |
-- Pretty print the date in '1d 9h 9m 17s' format |
||
+ | pretty :: NominalDiffTime -> String |
||
− | -- |
||
− | pretty |
+ | pretty diff = |
+ | unwords |
||
− | pretty td = join . intersperse " " . filter (not . null) . map f $ |
||
− | + | . map (\(t, unit) -> show t ++ unit) |
|
− | + | $ if null diffs then [(0, "s")] else diffs |
|
− | ,(mins `mod` 60,"m") ,(secs `mod` 60,"s")] |
||
where |
where |
||
+ | diffs :: [(Integer, String)] |
||
− | secs = abs $ tdSec td ; mins = secs `div` 60 |
||
+ | diffs = filter ((/= 0) . fst) |
||
− | hours = mins `div` 60 ; days = hours `div` 24 |
||
+ | $ decompose [(86400, "d"), (3600, "h"), (60, "m"), (1, "s")] (floor diff) |
||
− | months = days `div` 28 ; years = months `div` 12 |
||
− | + | decompose [] _ = [] |
|
+ | decompose ((secs, unit) : metrics) t = |
||
− | | otherwise = show i ++ s |
||
+ | let (n, t') = t `divMod` secs |
||
+ | in (n, unit) : decompose metrics t' |
||
</haskell> |
</haskell> |
||
Line 526: | Line 504: | ||
on these topics. Some places to start: |
on these topics. Some places to start: |
||
+ | * A [[/Transcript|full transcript]]. |
||
− | * The [[/Source|complete bot source]] (also [http://www.cse.unsw.edu.au/~dons/irc/bot.html mirrored here]) |
||
* [[Haskell|Haskell.org]] |
* [[Haskell|Haskell.org]] |
||
* [[Example_code|More Haskell code]] |
* [[Example_code|More Haskell code]] |
||
− | * [[ |
+ | * [[Books and tutorials|Learning Haskell]] |
+ | * A gallery of [[Libraries_and_tools/Network|network apps]] in Haskell |
||
− | Or take the bot home |
+ | Or take the bot home and hack! Some suggestions: |
− | * Use < |
+ | * Use <code>forkIO</code> to add a command line interface, and you've got yourself an irc client with 4 more lines of code. |
* Port some commands from [[Lambdabot]]. |
* Port some commands from [[Lambdabot]]. |
||
+ | |||
+ | Author: Don Stewart |
||
[[Category:Tutorials]] |
[[Category:Tutorials]] |
||
+ | [[Category:Code]] |
Latest revision as of 19:34, 11 April 2024
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.
A packaged-up version of the code is available on GitHub.
Getting started
You'll need a reasonably recent version of GHC. Our first step is to get on the network. So let's start by importing modules from the standard library and the network package, and defining a server to connect to.
-- File 1.hs
import System.IO -- base
import qualified Network.Socket as N -- network
-- Configuration options
myServer = "irc.libera.chat" :: String
myPort = 6667 :: N.PortNumber
-- Toplevel program
main :: IO ()
main = do
h <- connectTo myServer myPort
t <- hGetContents h
hSetBuffering stdout NoBuffering
print t
-- Connect to a server given its name and port number
connectTo :: N.HostName -> N.PortNumber -> IO Handle
connectTo host port = do
addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
N.connect sock (N.addrAddress addr)
N.socketToHandle sock ReadWriteMode
The key here is the main
function. This is the entry point to a Haskell program. We first connect to the server and get a socket h
(wrapped as a Handle
). We can then read and print any data we receive. We disable buffering (hSetBuffering
) on standard output, as print
renders strings on a single line, with newline characters escaped.
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 ...
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.
-- File 2.hs
import System.IO -- base
import qualified Network.Socket as N -- network
-- Configuration options
myServer = "irc.libera.chat" :: String
myPort = 6667 :: N.PortNumber
myChan = "#tutbot-testing" :: String
myNick = "tutbot" :: String
-- Toplevel program
main :: IO ()
main = do
h <- connectTo myServer myPort
write h "NICK" myNick
write h "USER" (myNick ++ " 0 * :tutorial bot")
write h "JOIN" myChan
listen h
-- Connect to a server given its name and port number
connectTo :: N.HostName -> N.PortNumber -> IO Handle
connectTo host port = do
addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
N.connect sock (N.addrAddress addr)
N.socketToHandle sock ReadWriteMode
-- Send a message to a handle
write :: Handle -> String -> String -> IO ()
write h cmd args = do
let msg = cmd ++ " " ++ args ++ "\r\n"
hPutStr h msg -- Send message on the wire
putStr ("> " ++ msg) -- Show sent message on the command line
-- Process each line from the server
listen :: Handle -> IO ()
listen h = forever $ do
line <- hGetLine h
putStrLn line
where
forever :: IO () -> IO ()
forever a = do a; forever a
Now, we've done quite a few things here. Firstly, we 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:
-- Send a message to a handle
write :: Handle -> String -> String -> IO ()
write h cmd args = do
let msg = cmd ++ " " ++ args ++ "\r\n"
hPutStr h msg -- Send message on the wire
putStr ("> " ++ msg) -- Show sent message on the command line
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 builds an IRC message by concatenating strings 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:
-- Process each line from the server
listen :: Handle -> IO ()
listen h = forever $ do
line <- hGetLine h
putStrLn line
where
forever :: IO () -> IO ()
forever a = do 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, lisp-like macros or meta programming - you just write a normal function to implement whatever control flow you wish. We can also avoid do
-notation, and directly write: forever a = a >> forever a
. Note that forever
can also be found in the standard library base, in the module Control.Monad
(with a more general type).
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
:copper.libera.chat NOTICE * :*** Checking Ident
:copper.libera.chat NOTICE * :*** Looking up your hostname...
...
:tutbot MODE tutbot :+iw
:tutbot!~tutbot@aa.bb.cc.dd JOIN :#tutbot-testing
:copper.libera.chat 353 tutbot @ #tutbot-testing :tutbot @dons
:copper.libera.chat 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
Add these additional imports before changing the listen
function.
import Data.List
import System.Exit
-- Connect to a server given its name and port number
listen :: Handle -> IO ()
listen h = forever $ do
line <- hGetLine h
putStrLn line
let s = init line
if isPing s then pong s else eval h (clean s)
where
forever :: IO () -> IO ()
forever a = do a; forever a
clean :: String -> String
clean = drop 1 . dropWhile (/= ':') . drop 1
isPing :: String -> Bool
isPing x = "PING :" `isPrefixOf` x
pong :: String -> IO ()
pong x = write h "PONG" (':' : drop 6 x)
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.
Before we can process a command, remember the IRC protocol generates
input lines of the form:
:dons!i=dons@my.net PRIVMSG #tutbot-testing :!id foo
so we need a clean
function to simply drop the leading ':' character, and then everything up to the next ':', leaving just the actual command content. We then pass this cleaned up string to eval
, which dispatches bot commands.
-- Dispatch a command
eval :: Handle -> String -> IO ()
eval h "!quit" = write h "QUIT" ":Exiting" >> 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 "
appears, we echo any argument string back to the server (the command is named after the identity function id
, 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.
-- Send a privmsg to the channel
privmsg :: Handle -> String -> IO ()
privmsg h s = write h "PRIVMSG" (chan ++ " :" ++ s)
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 reader 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 reader monad:
-- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
data Bot = Bot { botSocket :: 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. We 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 treat the socket as a global read-only value anywhere we need it. We'll call this new IO + state structure the Net
monad. ReaderT
is a type constructor, essentially a type function, that takes 2 types as arguments, building a result type: the Net
monad type.
We can now throw out all that socket threading and grab the socket when we need it. The key steps are connecting to the server, followed by the initialisation of our new reader monad and then to run the main bot loop with that global value. We add a small function, which takes the intial bot state and evaluates the bot's run
loop "in" the Net monad, using the Reader monad's runReaderT
function:
loop st = runReaderT run st
where run
is a small function to register the bot's nick, join a channel, and start listening for commands.
While we're here, we can tidy up the main function a little by using Control.Exception.bracket
to explicitly delimit the connection, shutdown and main loop phases of the program - a useful technique.
-- Toplevel program
main :: IO ()
main = bracket connect disconnect loop
where
disconnect = hClose . socket
loop st = runReaderT run st
That is, the higher order function bracket
takes 3 arguments: a function to connect to the server, a 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 cmd args = do
h <- asks botSocket
let msg = cmd ++ " " ++ args ++ "\r\n"
liftIO $ hPutStr h msg -- Send message on the wire
liftIO $ putStr ("> " ++ msg) -- Show sent message on the command line
In order to use both state and IO, we use the liftIO
function to lift an IO expression into the Net
monad making that IO function available to code in the Net
monad.
-- Imported from Control.Monad.IO.Class
liftIO :: IO a -> Net a
The monadic, stateful, exception-handling bot in all its glory:
-- File 4.hs
import Control.Exception -- base
import Control.Monad.IO.Class --
import Data.List --
import System.Exit --
import System.IO --
import qualified Network.Socket as N -- network
import Control.Monad.Trans.Reader -- transformers
-- Configuration options
myServer = "irc.libera.chat" :: String
myPort = 6667 :: N.PortNumber
myChan = "#tutbot-testing" :: String
myNick = "tutbot" :: String
-- Set up actions to run on start and end, and run the main loop
main :: IO ()
main = bracket connect disconnect loop
where
disconnect = hClose . botSocket
loop st = runReaderT run st
-- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
data Bot = Bot { botSocket :: Handle }
type Net = ReaderT Bot IO
-- Connect to the server and return the initial bot state
connect :: IO Bot
connect = notify $ do
h <- connectTo myServer myPort
return (Bot h)
where
notify a = bracket_
(putStrLn ("Connecting to " ++ myServer ++ " ...") >> hFlush stdout)
(putStrLn "done.")
a
-- Connect to the server and return a Handle (helper for connect)
connectTo :: N.HostName -> N.PortNumber -> IO Handle
connectTo host port = do
addr : _ <- N.getAddrInfo Nothing (Just host) (Just (show port))
sock <- N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr)
N.connect sock (N.addrAddress addr)
N.socketToHandle sock ReadWriteMode
-- 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" myNick
write "USER" (myNick ++ " 0 * :tutorial bot")
write "JOIN" myChan
listen
-- Send a message to the server we're currently connected to
write :: String -> String -> Net ()
write cmd args = do
h <- asks botSocket
let msg = cmd ++ " " ++ args ++ "\r\n"
liftIO $ hPutStr h msg -- Send message on the wire
liftIO $ putStr ("> " ++ msg) -- Show sent message on the command line
-- Process each line from the server
listen :: Net ()
listen = forever $ do
h <- asks botSocket
line <- liftIO $ hGetLine h
liftIO (putStrLn line)
let s = init line
if isPing s then pong s else eval (clean s)
where
forever :: Net () -> Net ()
forever a = do a; forever a
clean :: String -> String
clean = drop 1 . dropWhile (/= ':') . drop 1
isPing :: String -> Bool
isPing x = "PING :" `isPrefixOf` x
pong :: String -> Net ()
pong x = write "PONG" (':' : drop 6 x)
-- Dispatch a command
eval :: String -> Net ()
eval "!quit" = write "QUIT" ":Exiting" >> liftIO 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 msg = write "PRIVMSG" (myChan ++ " :" ++ msg)
Note that we threw in a new control structure, notify
, for fun. Now we're almost done! Let's run this bot. Using runhaskell:
$ runhaskell 4.hs
or using GHC:
$ ghc --make 4.hs -o tutbot Chasing modules from: 4.hs Compiling Main ( 4.hs, 4.o ) Linking ... $ ./tutbot
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. If we wished to add read-write state, we need only change the ReaderT
transformer to StateT
.
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:
import Data.Time
-- Updated Bot type
data Bot = Bot { botSocket :: Handle, startTime :: UTCTime }
We can then modify the initial connect
function to also set the start time.
-- Connect to the server and return the initial bot state
connect :: IO Bot
connect = notify $ do
t <- getCurrentTime
h <- connectTo myServer myPort
return (Bot h t)
We then add a new case to the eval
function, to handle uptime requests:
eval "!uptime" = uptime >>= privmsg
eval ...
This will run the uptime
function and send it back to the server. uptime
itself is:
-- Get the current uptime
uptime :: Net String
uptime = do
now <- liftIO getCurrentTime
zero <- asks startTime
return (pretty (diffUTCTime 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 :: NominalDiffTime -> String
pretty diff =
unwords
. map (\(t, unit) -> show t ++ unit)
$ if null diffs then [(0, "s")] else diffs
where
diffs :: [(Integer, String)]
diffs = filter ((/= 0) . fst)
$ decompose [(86400, "d"), (3600, "h"), (60, "m"), (1, "s")] (floor diff)
decompose [] _ = []
decompose ((secs, unit) : metrics) t =
let (n, t') = t `divMod` secs
in (n, unit) : decompose metrics t'
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:
- A full transcript.
- Haskell.org
- More Haskell code
- Learning Haskell
- A gallery of network apps in Haskell
Or take the bot home and hack! Some suggestions:
- Use
forkIO
to add a command line interface, and you've got yourself an irc client with 4 more lines of code. - Port some commands from Lambdabot.
Author: Don Stewart