From 00e81b5a2c6ddd5a5caf4934a8ee32b1281ccc53 Mon Sep 17 00:00:00 2001 From: tv Date: Tue, 23 May 2017 21:06:04 +0200 Subject: move most functionality from ircout to Kirk.Simple --- Kirk/Simple.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ ircout.hs | 50 ++++++++++---------------------------------------- 2 files changed, 59 insertions(+), 40 deletions(-) create mode 100644 Kirk/Simple.hs diff --git a/Kirk/Simple.hs b/Kirk/Simple.hs new file mode 100644 index 0000000..6ed0239 --- /dev/null +++ b/Kirk/Simple.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Kirk.Simple where + +import Control.Exception.Base (finally) +import Control.Monad (forever,unless) +import Data.List (intercalate,null) +import Data.Monoid +import Data.Text (isPrefixOf,pack,replace,unpack) +import Network (withSocketsDo,PortID(..),connectTo) +import System.IO (hSetBuffering,hSetNewlineMode,hPutStrLn,hClose,hGetLine,BufferMode(LineBuffering),universalNewlineMode,Handle) + +import Kirk.Config + + +run :: Config -> (Handle -> IO a) -> IO a +run Config{..} f = + withSocketsDo $ do + h <- connectTo server_hostname (PortNumber server_port) + (`finally` hClose h) $ do + hSetNewlineMode h universalNewlineMode + hSetBuffering h LineBuffering + f h + + +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 + + +privmsg :: Config -> Handle -> String -> IO () +privmsg Config{..} h text = + hPutStrLn h ("PRIVMSG " <> msgtarget' <> " :" <> text) + where + msgtarget' = intercalate "," msgtarget diff --git a/ircout.hs b/ircout.hs index 3edf388..9b3de60 100644 --- a/ircout.hs +++ b/ircout.hs @@ -1,50 +1,20 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +module Main where -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 Control.Concurrent.Async +import Control.Monad (forever) +import System.IO (Handle) import Kirk.Config +import Kirk.Simple 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 + c <- parseConfigFromArgs + r <- run c $ \h -> + handshake c h >> race (ircAgent c h) (stdinForwarder c h) + print r stdinForwarder :: Config -> Handle -> IO () -stdinForwarder Config{..} h = forever $ do - line <- BS8.getLine - hPutStrLn h ("PRIVMSG " ++ msgtarget' ++ " :" ++ BS8.unpack line) - where - msgtarget' = intercalate "," msgtarget +stdinForwarder c h = forever (getLine >>= privmsg c h) -- cgit v1.2.3