module IRC where import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) -- import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as Char8 import Data.Char import Data.Text (Text) import qualified Data.Text as T import Network.IRC.Client hiding (stdoutLogger) -- import Network.IRC.Client.Events import Lens.Micro import System.IO (hFlush, stdout) connectIRC :: (Text -> Maybe a) -> (a -> Text -> IO [Text]) -> IO () connectIRC commandDetect msgFun = do pass <- readFile "irc-password.txt" let trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace let conn = tlsConnection (WithDefaultConfig (Char8.pack "irc.libera.chat") 6697) & username .~ T.pack "yahb2" & realname .~ T.pack "Bot operated by tomsmeding" & password .~ Just (T.pack (trim pass)) & logfunc .~ noopLogger let cfg = defaultInstanceConfig (T.pack "yahb2") & handlers .~ (-- some of the standard handlers [pingHandler ,kickHandler ,ctcpPingHandler ,ctcpTimeHandler ,ctcpVersionHandler ,welcomeNick ,joinHandler] ++ -- our custom handlers [noticeHandler ,privmsgHandler commandDetect msgFun] ) runClient conn cfg () noticeHandler :: EventHandler s noticeHandler = EventHandler (\ev -> case ev ^. message of Notice _ (Right text) | T.pack "now identified for" `T.isInfixOf` text -> Just () _ -> Nothing) (\_ () -> do liftIO $ putStrLn "Identification confirmation received, joining channel" liftIO $ hFlush stdout send $ Join (T.pack "#haskell") send $ Join (T.pack "#haskell-offtopic")) privmsgHandler :: (Text -> Maybe a) -> (a -> Text -> IO [Text]) -> EventHandler s privmsgHandler commandDetect msgFun = EventHandler (\ev -> case ev ^. message of Privmsg _ (Right text) | Just s <- commandDetect text -> Just (ev ^. source, text, s) _ -> Nothing) (\_ (src, text, s) -> do msgs <- liftIO $ msgFun s text let mtarget = case src of User name -> Just name Channel ch _ -> Just ch Server _ -> Nothing forM_ mtarget $ \target -> forM_ msgs $ \msg -> send $ Privmsg target (Right msg)) -- stdoutLogger :: Origin -> ByteString -> IO () -- stdoutLogger origin x = do -- putStrLn $ unwords -- [ if origin == FromServer then "<---" else "--->" -- , init . tail $ show x -- ] -- hFlush stdout