summaryrefslogtreecommitdiffstats
path: root/hirc.hs
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2015-10-08 18:44:36 +0200
committertv <tv@shackspace.de>2015-10-08 18:44:36 +0200
commitd6130b447cb7a9263e60fb5c925dd587b72e1f27 (patch)
treea08b875c47f0159411a610a0144f51abc75199be /hirc.hs
Initial commit
From: https://wiki.haskell.org/Roll_your_own_IRC_bot
Diffstat (limited to 'hirc.hs')
-rw-r--r--hirc.hs78
1 files changed, 78 insertions, 0 deletions
diff --git a/hirc.hs b/hirc.hs
new file mode 100644
index 0000000..96ef82c
--- /dev/null
+++ b/hirc.hs
@@ -0,0 +1,78 @@
+import Data.List
+import Network
+import System.IO
+import System.Exit
+import Control.Arrow
+import Control.Monad.Reader
+import Control.Exception
+import Text.Printf
+
+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 = runReaderT run st
+
+-- 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