{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} import Control.Concurrent.Async (race) import Control.Exception.Base (finally) import Control.Monad (forever,unless) import Data.List (intercalate,null) import Data.Text (isPrefixOf,pack,replace,unpack) import Network (withSocketsDo,PortID(..),connectTo) import qualified Data.ByteString.Char8 as BS8 import System.IO (hSetBuffering,hSetNewlineMode,hPutStrLn,hClose,hGetLine,BufferMode(LineBuffering),universalNewlineMode,Handle) import Kirk.Config main :: IO () main = do c@Config{..} <- parseConfigFromArgs withSocketsDo $ do h <- connectTo server_hostname (PortNumber server_port) (`finally` hClose h) $ do hSetNewlineMode h universalNewlineMode hSetBuffering h LineBuffering handshake c h >> race (ircAgent c h) (stdinForwarder c h) >>= print handshake :: Config -> Handle -> IO () handshake Config{..} h = do hPutStrLn h ("NICK " ++ nick) hPutStrLn h ("USER " ++ nick ++ " * 0 :" ++ nick) unless (null channels) $ hPutStrLn h ("JOIN " ++ channels) where channels = intercalate "," $ filter ((=='#') . head) msgtarget ircAgent :: Config -> Handle -> IO () ircAgent Config{..} h = forever $ do line <- hGetLine h if (isPrefixOf "PING" (pack line)) then hPutStrLn h (unpack (replace "PING" "PONG" (pack line))) else print line stdinForwarder :: Config -> Handle -> IO () stdinForwarder Config{..} h = forever $ do line <- BS8.getLine hPutStrLn h ("PRIVMSG " ++ msgtarget' ++ " :" ++ BS8.unpack line) where msgtarget' = intercalate "," msgtarget