From 3e19b375af39e3547d05af5fa2cfce86bc236023 Mon Sep 17 00:00:00 2001 From: pb Date: Sat, 20 Mar 2010 23:59:46 +0000 Subject: git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@37 9f8f72e9-4bf4-416e-b76e-7d4203597157 --- IRC.hs | 46 ++++++++++++++++++++++++---------------------- State.hs | 3 ++- 2 files changed, 26 insertions(+), 23 deletions(-) diff --git a/IRC.hs b/IRC.hs index a3a4677..a77090d 100644 --- a/IRC.hs +++ b/IRC.hs @@ -26,15 +26,13 @@ ircWrite h s t = do hPrintf h "%s %s\r\n" s t ircPrivMsg :: Handle -> IrcMessage -> Env -> String -> IO () -ircPrivMsg h msg (Env state conf) s = do - if isMultiline s - then ircPrivMsg' (lines s) - else ircPrivMsg' [s] +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 = - getUnwrappedInt "maxMessageSize" conf + envGetInt "maxMessageSize" env receiver = if (isQuery msg) then from msg @@ -63,35 +61,39 @@ ircConnect (DispatchEnv state conf dispatch) = do ircWrite h "NICK" ircNick ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser ircEvalLoop h (DispatchEnv state { currentChannel = ircChannel } conf dispatch) + return () -ircEvalLoop :: Handle -> Env -> IO () -ircEvalLoop h env = forever $ do +ircEvalLoop :: Handle -> Env -> IO Env +ircEvalLoop h env = do t <- hGetLine h let s = init t - if ping s - then pong s - else let msg = IrcMessage { - raw = s, - from = from s, - clean = clean s, - isQuery = isQuery s } - in ircEval h msg env + env' <- if ping s + then pong s + else let msg = IrcMessage { + raw = s, from = from s, + clean = clean s, isQuery = isQuery s } + in ircEval h msg env + ircEvalLoop h env' where - forever a = do a; forever a from = drop 1 . takeWhile (/= '!') clean = drop 1 . dropWhile (/= ':') . drop 1 isQuery x = split x ' ' !! 2 == (envGet "ircNick" env) ping x = "PING :" `isPrefixOf` x - pong x = ircWrite h "PONG" (':' : drop 6 x) + pong x = do { ircWrite h "PONG" (':' : drop 6 x); return (env) } -ircEval :: Handle -> IrcMessage -> Env -> IO () +ircEval :: Handle -> IrcMessage -> Env -> IO Env ircEval h msg env@(DispatchEnv state _ dispatch) = case isCommand (clean msg) of - Just cmd -> dispatch cmd sendReplyMsg (castEnv env) - Nothing -> evalServerMessage (clean msg) + Just cmd -> do + dispatch cmd sendReplyMsg (castEnv env) + return (env) + Nothing -> do + evalMessage (clean msg) + return (env) where isCommand ('!':xs) = Just xs isCommand _ = Nothing - evalServerMessage "+x" = ircWrite h "JOIN" (currentChannel state) - evalServerMessage _ = putStrLn $ show msg + evalMessage "+x" = ircWrite h "JOIN" (currentChannel state) + evalMessage _ = putStrLn $ "foo" ++ (show msg) sendReplyMsg = ircPrivMsg h msg (castEnv env) + diff --git a/State.hs b/State.hs index c31d410..8ab8e33 100644 --- a/State.hs +++ b/State.hs @@ -1,7 +1,8 @@ module State where -import List +import qualified Data.Map as M +import List import User data State = State { -- cgit v1.2.3