summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Kirk/Simple.hs49
-rw-r--r--ircout.hs50
2 files changed, 59 insertions, 40 deletions
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)