{-# LANGUAGE OverloadedStrings #-} module Main where import System.IO import System.Exit (exitSuccess) import Control.Exception (bracket, bracket_) import Control.Monad.Reader import Control.Monad.IO.Class (liftIO) import Data.List (intercalate, isPrefixOf) import qualified Network.Socket as N -- internal imports import Types -- configuration options (TODO: Move to yaml and read from there) server = "irc.freenode.org" port = 6667 chan = "#parrotbot-testing" nick = "parrotbot" -- | Entry point main :: IO () main = bracket connect disconnect loop where disconnect = hClose . botSocket loop st = runReaderT run st -- | Process bot comands inside of its monad run :: Net () run = do write "NICK" nick write "USER" (nick <> " 0 * :parrot bot") write "JOIN" chan listen -- | Connect to the server und return the initial bot state connect :: IO Bot connect = notify $ do handle <- connectTo server port return (Bot handle) where notify a = bracket_ (do putStrLn ("Connecting to " <> server <> "…") hFlush stdout ) (putStrLn "done.") a -- | Connect to an IRC server given domain name and port (Helper for 'connect' connectTo :: N.HostName -- ^ Domain to connect to -> N.PortNumber -- ^ Port to connect to -> IO Handle -- ^ Handle for the connection connectTo 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 :: String -- ^ Command to issue -> String -- ^ Command argument(s) -> Net () write cmd args = do let msg = intercalate " " [cmd, args, "\r\n"] handle <- asks botSocket liftIO $ do hPutStr handle msg putStr ("> " <> msg) -- | Send Messages via PRIVMSG to the connected Channel privmsg :: String -- ^ Message Content -> Net () privmsg msg = write "PRIVMSG" (chan <> " :" <> msg) -- | Listen to and process messages from IRC listen :: Net () listen = forever $ do handle <- asks botSocket line <- liftIO $ hGetLine handle liftIO $ putStrLn line let s = init line if isPing s then pong s else evaluate (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 s = "PING" `isPrefixOf` s pong :: String -> Net () pong x = write "PONG" (':' : drop 6 x) -- | Evaluate input from IRC evaluate :: String -- ^ Input to be processed -> Net () evaluate "!quit" = do write "QUIT" ":I have been orderd to go" liftIO exitSuccess evaluate text | "!say " `isPrefixOf` text = privmsg (drop 5 text) evaluate _ = return ()