Un bot irc inutile en haskell

Hier, je me suis amusé à faire un bot IRC inutile en Haskell, surnommé LiMonade (je ne donne rien à celui qui trouve la référence). Il se base sur ce code http://www.haskell.org/haskellwiki/Roll_your_own_IRC_bot, mais assez modifié pour obtenir un système de commandes pas très puissant, mais bon.

J’ai pensé que que ça pourrait intéresser queulqu’un qui veut faire un bot simplement et qui aime bien Haskell.

Voilà le code:

import Data.List
import Network
import System.IO
import System.Exit
import Control.Arrow
import Control.Monad.Reader
import Text.Printf
import Data.Map as Map
import Data.Char (isDigit)
import Prelude hiding (catch)
– Configuration
server = « irc.freenode.org »
port   = 6667
chan   = « #limonade »
nick   = « LiMonade »
author = « xarch »
private = False
cmdPrefix = « ! »
– Commandes du bot
commands = Map.fromList [("foo", foo), ("say_hello", hello), ("quit", quit)]
foo _ _ = pubmsg « FOO! »
hello a _ = pubmsg $ « hello  » ++ a
quit a _ | a == author = write « QUIT » « :Exiting » >> io (exitWith ExitSuccess)
– Le bot en lui même
type Net = ReaderT Bot IO
data Bot = Bot { socket :: Handle }
main :: IO ()
main = bracket connect disconnect loop
where
disconnect = hClose . socket
loop st    = runReaderT run st
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
run :: Net ()
run = do
write « NICK » nick
write « USER » (nick++ » 0 * :mon super bot irc »)
write « JOIN » chan
asks socket >>= listen
listen :: Handle -> Net ()
listen h = forever $ do
s <- init `fmap` io (hGetLine h)
io (putStrLn s)
if ping s then pong s else eval s
where
forever a = a >> forever a
ping x    = « PING : » `isPrefixOf` x
pong x    = write « PONG » (’:’ : drop 6 x)
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
io :: IO a -> Net a
io = liftIO
eval :: String -> Net ()
eval x | isCommand x = (getCommand x) (getAuthor x) (getMessage x)
eval _ = return ()
getAuthor = drop 1 . takeWhile (/=’!')
getMessage = drop 1 . dropWhile (/=’:') . drop 1
getCommandName x = getCommandName’ (getMessage x)
getCommandName’ = head . words . drop (length cmdPrefix)
getCommand x = case Map.lookup (getCommandName x) commands of
Nothing -> (\ _ _ -> pubmsg « Commande inconnue »)
Just a -> a
isCommand x = isPrefixOf cmdPrefix (getMessage x)
– Fonctions utiles
privmsg :: String -> String -> Net ()
privmsg s to = write « PRIVMSG » (to ++  » : » ++ s)
pubmsg :: String -> Net ()
pubmsg s = if private then privmsg s author else privmsg s chan

import Data.List

import Network

import System.IO

import System.Exit

import Control.Arrow

import Control.Monad.Reader

import Text.Printf

import Data.Map as Map

import Data.Char (isDigit)

– Configuration

server = « irc.freenode.org »

port   = 6667

chan   = « #limonade »

nick   = « LiMonade »

author = « xarch »

private = False

cmdPrefix = « ! »

– Commandes du bot

commands = Map.fromList [("foo", foo), ("say_hello", hello), ("quit", quit)]

foo _ _ = pubmsg « FOO! »

hello a _ = pubmsg $ « hello  » ++ a

quit a _ | a == author = write « QUIT » « :Exiting » >> io (exitWith ExitSuccess)

– Le bot en lui même

type Net = ReaderT Bot IO

data Bot = Bot { socket :: Handle }

main :: IO ()

main = bracket connect disconnect loop

where

disconnect = hClose . socket

loop st    = runReaderT run st

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

run :: Net ()

run = do

write « NICK » nick

write « USER » (nick++ » 0 * :mon super bot irc »)

write « JOIN » chan

asks socket >>= listen

listen :: Handle -> Net ()

listen h = forever $ do

s <- init fmap io (hGetLine h)

io (putStrLn s)

if ping s then pong s else eval s

where

forever a = a >> forever a

ping x    = « PING : » isPrefixOf x

pong x    = write « PONG » (’:’ : drop 6 x)

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

io :: IO a -> Net a

io = liftIO

eval :: String -> Net ()

eval x | isCommand x = (getCommand x) (getAuthor x) (getMessage x)

eval _ = return ()

getAuthor = drop 1 . takeWhile (/=’!')

getMessage = drop 1 . dropWhile (/=’:') . drop 1

getCommandName x = getCommandName’ (getMessage x)

getCommandName’ = head . words . drop (length cmdPrefix)

getCommand x = case Map.lookup (getCommandName x) commands of

Nothing -> (\ _ _ -> pubmsg « Commande inconnue »)

Just a -> a

isCommand x = isPrefixOf cmdPrefix (getMessage x)

– Fonctions utiles

privmsg :: String -> String -> Net ()

privmsg s to = write « PRIVMSG » (to ++  » : » ++ s)

pubmsg :: String -> Net ()

pubmsg s = if private then privmsg s author else privmsg s chan

Les commandes sont simplement des fonctions prenant deux paramètres, l’auteur et le message. Utilisez la fonction pubmsg pour écrire sur le canal.

On notera que ce bot n’a que peu de possibilités, il n’est par exemple pas possible de faire une action, mais vous pouvez implémenter ces fonctionnalités.

N’hésitez pas à critiquer mon niveau en Haskell, très faible.

Foo

Mon blog est mort. Carrément mort. Mais, venant de lire un article expliqaunt pourquoi tout développeur devrait avoir un blog technique, j’ai décidé de le remettre à jour. Je compte écrire au moins un billet par semaine.

Je viens de mettre le thème à jour et de retirer les trois derniers articles, qui étaient inintéressants.

Enjoy (ou pas, y’a rien à enjoyer).

Nouvelles

Plop,

Comme vous l’avez remarqué, je tiens toujours mes promesses: le blog est inactif.

Mais je vais quand même écrire un article, avec des nouvelles diverses, inutiles, et inintéressantes.

Voilà, je me suis mis à Erlang, un langage fonctionnel très pratique pour gérer les situations de concurrence. Donc parfait pour le web. En plus, le framework Nitrogen rocks, alors ça va être vachement sympa.

Je me suis également intéressé à CouchDB. C’est un système de base de données orienté document, très différents des SGBDR. Un serveur CouchDB propose une API accessible via HTTP et utilisant JSON. Il n’y a donc pas de SQL, et les requêtes de sélection complexes sont effectués à l’aide de vues qui sont en pratique des fonction javascript. Et, comme le hasard fait bien les choses, CouchDB est écrit en Erlang.

Autrement, j’ai continué à apprendre Python, et c’est vraiment agréable après tant de temps passé avec PHP. Ma fonctionnalité préféré en Python ? La compréhension des listes. Ca rocks vraiment ce truc. Et comme j’aime le développement web, j’ai naturellement choisi d’utiliser Django, et je m’amuse bien, même si je trouve le framework un peu trop orienté blog/publication.

Bienvenue !

Bienvenue sur un nouveau blog (again…). Il sera inactif.