parrotbot/src/Main.hs

97 lines
2.3 KiB
Haskell
Raw Normal View History

2021-03-27 03:17:39 +00:00
{-# LANGUAGE OverloadedStrings #-}
module Main where
import System.IO
import System.Exit (exitSuccess)
import Data.List (intercalate, isPrefixOf)
import qualified Network.Socket as N
-- configuration options (TODO: Move to yaml and read from there)
server = "irc.freenode.org"
port = 6667
chan = "#parrotbot-testing"
nick = "parrotbot"
main :: IO ()
main = do
handle <- connect server port
write handle "NICK" nick
write handle "USER" (nick <> " 0 * :parrot bot")
write handle "JOIN" chan
listen handle
-- | Connect to an IRC server given domain name and port
connect
:: N.HostName -- ^ Domain to connect to
-> N.PortNumber -- ^ Port to connect to
-> IO Handle -- ^ Handle for the connection
connect chost cport = do
(addr:_) <- N.getAddrInfo Nothing (Just chost) (Just (show cport))
sock <- N.socket
(N.addrFamily addr)
(N.addrSocketType addr)
(N.addrProtocol addr)
N.connect sock (N.addrAddress addr)
N.socketToHandle sock ReadWriteMode
-- | Send messages to IRC
write
:: Handle -- ^ Connection handle
-> String -- ^ Command to issue
-> String -- ^ Command argument(s)
-> IO ()
write handle cmd args = do
let msg = intercalate " " [cmd, args, "\r\n"]
hPutStr handle msg
print ("> " <> msg)
-- | Send Messages via PRIVMSG to the connected Channel
privmsg
:: Handle -- ^ Connection handle
-> String -- ^ Message Content
-> IO ()
privmsg handle msg = write handle "PRIVMSG" (chan <> " :" <> msg)
-- | Listen to and process messages from IRC
listen
:: Handle -- ^ Connection handle
-> IO ()
listen handle = forever $ do
line <- hGetLine handle
putStrLn line
let s = init line
if isPing s
then
pong s
else
evaluate handle (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 s = "PING" `isPrefixOf` s
pong :: String -> IO ()
pong x = write handle "PONG" (':' : drop 6 x)
-- | Evaluate input from IRC
evaluate
:: Handle -- ^ Connection handle
-> String -- ^ Input to be processed
-> IO ()
evaluate handle "!quit" = do
write handle "QUIT" ":I have been orderd to go"
exitSuccess
evaluate handle text | "!say " `isPrefixOf` text =
privmsg handle (drop 4 text)
evaluate _ _ =
return ()