From af903e0031288f6e4f1c8a63db8ef9efc63f8b91 Mon Sep 17 00:00:00 2001
From: pb <pb@9f8f72e9-4bf4-416e-b76e-7d4203597157>
Date: Fri, 26 Mar 2010 22:31:54 +0000
Subject: git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@41
 9f8f72e9-4bf4-416e-b76e-7d4203597157

---
 IRC.hs | 39 +++++++++++++++++++--------------------
 1 file changed, 19 insertions(+), 20 deletions(-)

(limited to 'IRC.hs')

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)
 
-- 
cgit v1.2.3