summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpb <pb@9f8f72e9-4bf4-416e-b76e-7d4203597157>2010-03-14 12:06:58 +0000
committerpb <pb@9f8f72e9-4bf4-416e-b76e-7d4203597157>2010-03-14 12:06:58 +0000
commitd102f483205bf2969ddf60063ba2b03c0c2b508a (patch)
tree3e0d930c423d54f0b8788fafd94abc6fdea9b6ac
parentde9e80d18816cd11c4b7785e635a3fb0dfe0433a (diff)
git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@23 9f8f72e9-4bf4-416e-b76e-7d4203597157
-rw-r--r--Conf.hs1
-rw-r--r--HsBot.hs52
-rw-r--r--Main.hs2
3 files changed, 28 insertions, 27 deletions
diff --git a/Conf.hs b/Conf.hs
index b4b2477..33be1dd 100644
--- a/Conf.hs
+++ b/Conf.hs
@@ -14,6 +14,7 @@ makeConf = M.fromList
, ("ircChannel", "#buetow.org")
, ("ircNick", "hotdog")
, ("ircPort", "6667")
+ , ("ircUser", "hsbot.haskell.eu")
]
get :: (Monad m) => String -> Conf -> m String
diff --git a/HsBot.hs b/HsBot.hs
index eba9a75..e8894e6 100644
--- a/HsBot.hs
+++ b/HsBot.hs
@@ -171,43 +171,43 @@ data IrcMessage = IrcMessage {
isQuery :: Bool
} deriving Show
-write :: Handle -> String -> String -> IO ()
-write h s t = do
+ircWrite :: Handle -> String -> String -> IO ()
+ircWrite h s t = do
hPrintf h "%s %s\r\n" s t
printf "> %s %s\n" s t
-privmsg :: Handle -> IrcMessage -> State -> Conf -> String -> IO ()
-privmsg h msg state conf s =
- if isMultiline s then privmsg' (lines s) else privmsg' [s]
+ircPrivmsg :: Handle -> IrcMessage -> State -> Conf -> String -> IO ()
+ircPrivmsg h msg state conf s =
+ if isMultiline s then ircPrivmsg' (lines s) else ircPrivmsg' [s]
where
- privmsg' [] = return ()
- privmsg' (x:xs) =
+ ircPrivmsg' [] = return ()
+ ircPrivmsg' (x:xs) =
let receiver = if (isQuery msg) then from msg else channel state
in if length x > maxMessageSize
- then do write h "PRIVMSG" (receiver ++ " :"
+ then do ircWrite h "PRIVMSG" (receiver ++ " :"
++ (take maxMessageSize x) ++ "...")
- write h "PRIVMSG" (receiver ++ " :"
+ ircWrite h "PRIVMSG" (receiver ++ " :"
++ "...this message has been cut to "
++ (show maxMessageSize) ++ " chars")
- privmsg' xs
- else do write h "PRIVMSG" (receiver ++ " :" ++ x)
- privmsg' xs
+ ircPrivmsg' xs
+ else do ircWrite h "PRIVMSG" (receiver ++ " :" ++ x)
+ ircPrivmsg' xs
-connect :: State -> Conf -> IO ()
-connect state conf = do
- ircNick <- get "ircNick" conf
+ircConnect :: State -> Conf -> IO ()
+ircConnect state conf = do
ircChannel <- get "ircChannel" conf
- ircServer <- get "ircServer" conf
+ ircNick <- get "ircNick" conf
ircPort <- get "ircPort" conf
- let state' = state { channel = ircChannel }
- h <- connectTo ircServer (PortNumber (fromIntegral 6667))
+ ircServer <- get "ircServer" conf
+ ircUser <- get "ircUser" conf
+ h <- connectTo ircServer (PortNumber (fromIntegral (read ircPort :: Int)))
hSetBuffering h NoBuffering
- write h "NICK" ircNick
- write h "USER" (ircNick ++ " 0 * :hsbot.haskell.eu")
- listen h state' conf
+ ircWrite h "NICK" ircNick
+ ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser
+ evalLoop h state { channel = ircChannel } conf
-listen :: Handle -> State -> Conf -> IO ()
-listen h state conf = forever $ do
+evalLoop :: Handle -> State -> Conf -> IO ()
+evalLoop h state conf = forever $ do
t <- hGetLine h
let s = init t
if ping s
@@ -225,7 +225,7 @@ listen h state conf = forever $ do
isQuery x = split x ' ' !! 2 == ircNick
where ircNick = do { ircNick <- get "ircNick" conf; ircNick }
ping x = "PING :" `isPrefixOf` x
- pong x = write h "PONG" (':' : drop 6 x)
+ pong x = ircWrite h "PONG" (':' : drop 6 x)
eval :: Handle -> IrcMessage -> State -> Conf -> IO ()
eval h msg state conf =
@@ -237,7 +237,7 @@ eval h msg state conf =
isCommand _ = Nothing
evalServerMessage "+x" = do
ircChannel <- get "ircChannel" conf
- write h "JOIN" ircChannel
+ ircWrite h "JOIN" ircChannel
evalServerMessage _ = putStrLn $ show msg
data Command = Command String String (State -> IO ())
@@ -260,7 +260,7 @@ dispatch h cmd msg state conf = do
Command "!q" "quits"
(\x -> do { sendMessage "Good bye"; save x; exitWith ExitSuccess } )
]
- sendMessage = privmsg h msg state conf
+ sendMessage = ircPrivmsg h msg state conf
printHelp = sendMessage . concat . showL
getLambda x = let (Command _ _ c) = getCommand x in c
getDescr x = let (Command _ b _) = getCommand x in b
diff --git a/Main.hs b/Main.hs
index f89ac3b..637719f 100644
--- a/Main.hs
+++ b/Main.hs
@@ -7,7 +7,7 @@ main :: IO ()
main = do
let conf = load
conf' <- conf -- Extract Conf from the IO Monad
- connect conf' makeConf
+ ircConnect conf' makeConf
r = main