Skip to content

Instantly share code, notes, and snippets.

@xintron
Created February 5, 2014 08:17
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save xintron/8819207 to your computer and use it in GitHub Desktop.
Save xintron/8819207 to your computer and use it in GitHub Desktop.
Simple IRC-bot written in Haskell
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (unless)
import Control.Exception (bracket)
import System.Environment (getArgs)
import System.IO (Handle, BufferMode(NoBuffering), hClose, hSetBuffering)
import Data.Time.LocalTime (getZonedTime)
import Network (PortID(PortNumber), connectTo)
import qualified Data.Text as T (Text, append, concat, drop, dropWhile, head,
isPrefixOf, pack, takeWhile, toLower, words)
import qualified Data.Text.IO as TIO (hGetLine, hPutStr, putStrLn)
data Command = Privmsg | Ping | Join | RplWelcome deriving (Show)
nick :: T.Text
nick = "foo"
write :: Handle -> T.Text -> IO ()
write h a = lio a >> TIO.hPutStr h (T.append a "\r\n")
lio :: T.Text -> IO ()
lio = TIO.putStrLn . T.append "> "
connect :: [String] -> IO Handle
connect [h, p] = do
-- Connect to the server and return the handle
lio $ T.append "Connecting to " $ T.pack h
handle <- connectTo h port
hSetBuffering handle NoBuffering
write handle "USER foo 12 * :Haskell IRC bot."
write handle $ T.append "NICK " nick
return handle
where
port = PortNumber $ fromIntegral (read p :: Int)
getSource :: T.Text -> T.Text
-- Parse source from ":nick!~ident@host PRIVMSG #channel :input"
getSource = T.takeWhile (/= '!') . T.drop 1
getChannel :: T.Text -> T.Text
getChannel = T.takeWhile (/= ' ') . T.dropWhile (/= '#')
getArguments :: T.Text -> [T.Text]
getArguments = map T.toLower . T.words . T.drop 1 . T.dropWhile (/= ':') . T.drop 1
getCommand :: T.Text -> Maybe Command
-- Parse the command
getCommand c
| "PING" `T.isPrefixOf` c = Just Ping
-- Parse the command :<prefix> <command>; and match it with the Command
-- type
| T.head c == ':' = readCommand $
T.takeWhile (/= ' ') $ T.drop 1 $ T.dropWhile (/= ' ') c
| otherwise = Nothing
-- Read a command and make it an instance of the Command-type
readCommand :: T.Text -> Maybe Command
readCommand "PRIVMSG" = Just Privmsg
readCommand "001" = Just RplWelcome
readCommand "JOIN" = Just Join
readCommand _ = Nothing
-- Parse incoming data
eval :: Handle -> Maybe Command -> T.Text -> IO ()
-- Welcome people to the channel
eval h (Just Join) c =
let source = getSource c
in unless (source == nick) (write h $
T.concat ["PRIVMSG "
, head $ getArguments c,
" :Welcome ",
getSource c,
"!"])
-- Join a channel after the welcome message
eval h (Just RplWelcome) _ = write h "JOIN #foo"
-- Parse privmsg
eval h (Just Privmsg) c = privmsg h (getArguments c) c
-- Pong the sever on pings
eval h (Just Ping) c = write h $ T.append "PONG " $ T.dropWhile (/= ':') c
eval _ _ _ = return ()
privmsg :: Handle -> [T.Text] -> T.Text -> IO ()
privmsg h ("!time":_) c = do
time <- getZonedTime
write h $ T.concat ["PRIVMSG ", getChannel c, " :", T.pack $ show time]
privmsg _ _ _ = return ()
-- Loop over the handle to fetch data and handle accordingly
loop :: Handle -> IO ()
loop h = do
c <- TIO.hGetLine h
TIO.putStrLn $ T.append "< " c
eval h (getCommand c) c
loop h
main :: IO ()
main = do
args <- getArgs
if length args /= 2
then TIO.putStrLn "Usage: ./bot <server> <port> <nick>"
else bracket
(connect args)
hClose
loop
@adriangoransson
Copy link

Not okay.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment