blob: c0382cc858812eb483f6c503a2d486e0b87d0909 (
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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
module HsBot.IRC (ircStart) where
import IO
import List
import Network
import System
import System.IO
import Text.Printf
import HsBot.Base.Conf
import HsBot.Base.Env
import HsBot.Base.State
import HsBot.General.Tools
import HsBot.IRC.User
data IrcMessage = IrcMessage {
raw :: String,
from :: String,
clean :: String,
isQuery :: Bool
} deriving Show
ircWrite :: Handle -> String -> String -> IO ()
ircWrite h s t = do
printf "> %s %s\n" s t
hPrintf h "%s %s\r\n" s t
ircPrivMsg :: Handle -> IrcMessage -> Env -> String -> IO ()
ircPrivMsg h msg env@(Env state _) s = do
ircPrivMsg' $ if isMultiline s then (lines s) else [s]
where
ircPrivMsg' [] = return ()
ircPrivMsg' (x:xs) =
let maxMessageSize =
envGetInt "maxMessageSize" env
receiver =
if (isQuery msg)
then from msg
else currentChannel state
in if length x > maxMessageSize
then do
ircWrite h "PRIVMSG" (receiver ++ " :"
++ (take maxMessageSize x) ++ "...")
ircWrite h "PRIVMSG" (receiver ++ " :"
++ "...this message has been cut to "
++ (show maxMessageSize) ++ " chars")
ircPrivMsg' xs
else do
ircWrite h "PRIVMSG" (receiver ++ " :" ++ x)
ircPrivMsg' xs
ircStart :: Env -> IO ()
ircStart (DispatchEnv state conf dispatch) = do
ircChannel <- get "ircChannel" conf
ircNick <- get "ircNick" conf
ircPort <- get "ircPort" conf
ircServer <- get "ircServer" conf
ircUser <- get "ircUser" conf
h <- connectTo ircServer (PortNumber $ fromIntegral (read ircPort :: Int))
hSetBuffering h NoBuffering
ircWrite h "NICK" ircNick
ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser
ircEvalLoop h (DispatchEnv state { isReady = False, currentChannel = ircChannel } conf dispatch)
return ()
ircEvalLoop :: Handle -> Env -> IO ()
ircEvalLoop h env = do
t <- hGetLine h
let s = init t
env' <- branch s
ircEvalLoop h env'
where
branch s
| ping s = do { pong s; return (env) }
| otherwise = ircEval h (msg s) env
ping x = "PING :" `isPrefixOf` x
pong x = ircWrite h "PONG" (':' : drop 6 x)
from = drop 1 . takeWhile (/= '!')
clean = drop 1 . dropWhile (/= ':') . drop 1
isQuery x = split x ' ' !! 2 == (envGet "ircNick" env)
msg s = IrcMessage {
raw = s, from = from s,
clean = clean s, isQuery = isQuery s
}
ircEval :: Handle -> IrcMessage -> Env -> IO Env
ircEval h msg env@(DispatchEnv state conf dispatch) = ircEval' (clean msg)
where
ircEval' "+x" = do
ircWrite h "JOIN" (currentChannel state)
return (env)
ircEval' "End of /NAMES list." =
return (DispatchEnv state { isReady = True } conf dispatch)
ircEval' cleanMsg = do
let env' = (Env state { currentSender = from msg } conf)
(Env s c) <- dispatch cleanMsg sendReplyMsg env'
return (DispatchEnv s c dispatch)
sendReplyMsg = ircPrivMsg h msg (castEnv env)
|
