blob: 1dbec06010d3985938443c6c82d78f42cf569228 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (forever)
import Network (withSocketsDo, PortID(..), connectTo)
import Network.Socket (HostName, PortNumber)
import System.IO (hSetBuffering, hSetNewlineMode, hPutStrLn, hClose, hGetLine, BufferMode(LineBuffering), universalNewlineMode, Handle)
import Control.Concurrent.Async (race)
import Control.Exception.Base (finally)
import Data.Text (isPrefixOf, pack, replace, unpack)
nick :: String
nick = "ni"
chan :: String
chan = "#retiolum"
server_hostname :: HostName
server_hostname = "ni.r"
server_port :: PortNumber
server_port = 6667;
main :: IO ()
main = withSocketsDo $ do
h <- connectTo server_hostname (PortNumber server_port)
talk h `finally` hClose h
handshake :: Handle -> IO ()
handshake h = do
hPutStrLn h ("NICK " ++ nick)
hPutStrLn h ("USER " ++ nick ++ " * 0 :" ++ nick)
hPutStrLn h ("JOIN " ++ chan)
talk :: Handle -> IO ()
talk h = do
hSetNewlineMode h universalNewlineMode
hSetBuffering h LineBuffering
handshake h
_ <- race fromServer toServer
return ()
where
fromServer = forever $ do
line <- hGetLine h
--case line of
if (isPrefixOf "PING" (pack line)) then
hPutStrLn h (unpack (replace "PING" "PONG" (pack line)))
else
print line
toServer = do
line <- getLine
case line of
":quit" -> do hPutStrLn h "/quit"; return ()
_ -> do hPutStrLn h ("PRIVMSG " ++ chan ++ " :" ++ line); toServer
|
