git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@41 9f8f72e9-4bf4-416e-b76e-7d4203597157

1 files changed, 19 insertions, 20 deletions

diff --git a/IRC.hs b/IRC.hs
index fab7acb..6bf94ff 100644
--- a/IRC.hs
+++ b/IRC.hs
@@ -70,28 +70,27 @@ ircEvalLoop h env = do
       env' <- branch s
       ircEvalLoop h env'
    where 
-      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 }
+      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 _ dispatch) = 
-   case isCommand (clean msg) of
-      Just cmd -> do
-         dispatch cmd sendReplyMsg (castEnv env)
-         return (env)
-      Nothing -> do
-         evalMessage (clean msg)
-         return (env)
+ircEval h msg env@(DispatchEnv state _ dispatch) = ircEval' (clean msg)
    where
-      isCommand ('!':xs) = Just xs
-      isCommand _ = Nothing
-      evalMessage "+x" = ircWrite h "JOIN" (currentChannel state)
-      evalMessage _ = putStrLn $ "foo" ++ (show msg)
+      ircEval' "+x" = do
+         ircWrite h "JOIN" (currentChannel state)
+         return (env)
+      ircEval' cleanMsg = do
+         (Env s c) <- dispatch cleanMsg sendReplyMsg (castEnv env)
+         return (DispatchEnv s c dispatch)
       sendReplyMsg = ircPrivMsg h msg (castEnv env)