From aec4b187bf1b06ad932825b811d8256b6a6d6958 Mon Sep 17 00:00:00 2001 From: pb Date: Sun, 21 Mar 2010 00:07:47 +0000 Subject: git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@38 9f8f72e9-4bf4-416e-b76e-7d4203597157 --- IRC.hs | 24 +++++++++++------------- Main.hs | 2 +- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/IRC.hs b/IRC.hs index a77090d..310f9a4 100644 --- a/IRC.hs +++ b/IRC.hs @@ -49,8 +49,8 @@ ircPrivMsg h msg env@(Env state _) s = do ircWrite h "PRIVMSG" (receiver ++ " :" ++ x) ircPrivMsg' xs -ircConnect :: Env -> IO () -ircConnect (DispatchEnv state conf dispatch) = do +ircStart :: Env -> IO () +ircStart (DispatchEnv state conf dispatch) = do ircChannel <- get "ircChannel" conf ircNick <- get "ircNick" conf ircPort <- get "ircPort" conf @@ -67,19 +67,17 @@ ircEvalLoop :: Handle -> Env -> IO Env ircEvalLoop h env = do t <- hGetLine h let s = init t - 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 + env' <- branch s ircEvalLoop h env' where - 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 = do { ircWrite h "PONG" (':' : drop 6 x); return (env) } + branch s = if ping s then do { pong s; return (env) } else ircEval h msg env + where + 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 = IrcMessage { raw = s, from = from s, clean = clean s, isQuery = isQuery s } ircEval :: Handle -> IrcMessage -> Env -> IO Env ircEval h msg env@(DispatchEnv state _ dispatch) = diff --git a/Main.hs b/Main.hs index 7726f70..1d668d3 100644 --- a/Main.hs +++ b/Main.hs @@ -15,7 +15,7 @@ main = do databaseFile <- get "databaseFile" conf let state = stateLoad databaseFile state' <- state -- Extract State from the IO Monad - ircConnect (DispatchEnv state' conf dispatch) + ircStart (DispatchEnv state' conf dispatch) -- Shortcut r :: IO () -- cgit v1.2.3