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

1 files changed, 16 insertions, 48 deletions

diff --git a/IRC.hs b/IRC.hs
index d1e4724..4a402c7 100644
--- a/IRC.hs
+++ b/IRC.hs
@@ -25,14 +25,14 @@ ircWrite h s t = do
    printf    "> %s %s\n" s t
    hPrintf h "%s %s\r\n" s t
 
-ircPrivmsg :: Handle -> IrcMessage -> Env -> String -> IO ()
-ircPrivmsg h msg (Env state conf) s = do
+ircPrivMsg :: Handle -> IrcMessage -> Env -> String -> IO ()
+ircPrivMsg h msg (Env state conf _) s = do
       if isMultiline s 
-         then ircPrivmsg' (lines s)
-         else ircPrivmsg' [s]
+         then ircPrivMsg' (lines s)
+         else ircPrivMsg' [s]
    where
-      ircPrivmsg' [] = return ()
-      ircPrivmsg' (x:xs) = 
+      ircPrivMsg' [] = return ()
+      ircPrivMsg' (x:xs) = 
          let maxMessageSize = 
                getUnwrappedInt "maxMessageSize" conf 
              receiver = 
@@ -46,13 +46,13 @@ ircPrivmsg h msg (Env state conf) s = do
                   ircWrite h "PRIVMSG" (receiver ++ " :" 
                         ++ "...this message has been cut to " 
                         ++ (show maxMessageSize) ++ " chars")
-                  ircPrivmsg' xs
+                  ircPrivMsg' xs
                else do
                   ircWrite h "PRIVMSG" (receiver ++ " :" ++ x)
-                  ircPrivmsg' xs
+                  ircPrivMsg' xs
 
 ircConnect :: Env -> IO ()
-ircConnect (Env state conf) = do
+ircConnect (Env state conf dispatch) = do
    ircChannel <- get "ircChannel" conf
    ircNick <- get "ircNick" conf
    ircPort <- get "ircPort" conf
@@ -62,7 +62,7 @@ ircConnect (Env state conf) = do
    hSetBuffering h NoBuffering
    ircWrite h "NICK" ircNick
    ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser
-   ircEvalLoop h (Env state { currentChannel = ircChannel } conf)
+   ircEvalLoop h (Env state { currentChannel = ircChannel } conf dispatch)
 
 ircEvalLoop :: Handle -> Env -> IO ()
 ircEvalLoop h env = forever $ do
@@ -85,45 +85,13 @@ ircEvalLoop h env = forever $ do
       pong x = ircWrite h "PONG" (':' : drop 6 x)
 
 ircEval :: Handle -> IrcMessage -> Env -> IO ()
-ircEval h msg env@(Env state _) = 
+ircEval h msg env@(Env state _ dispatch) = 
    case isCommand (clean msg) of
-      Just xs -> dispatch h xs msg env
-      Nothing -> ircEvalServerMessage (clean msg)
+      Just cmd -> dispatch cmd sendReplyMsg env
+      Nothing -> evalServerMessage (clean msg)
    where
       isCommand ('!':xs) = Just xs
       isCommand _ = Nothing
-      ircEvalServerMessage "+x" = ircWrite h "JOIN" (currentChannel state)
-      ircEvalServerMessage _ = putStrLn $ show msg
-
-data Command = Command String String (State -> IO ()) 
-instance Show Command where 
-   show (Command a b _) = a ++ " - " ++ b
-
-dispatch :: Handle -> String -> IrcMessage -> Env -> IO ()
-dispatch h cmd msg env@(Env state conf) = do
-   getLambda ("!" ++ cmd) state -- Eval the specific lambda function of 'command'
-      where
-         databaseFile = envGet "databaseFile" env
-         commands = [      
-            Command "!h" "Prints help" 
-               (\_ -> do { printHelp commands } ),
-            Command "!i" "Prints infos" 
-               (\_ -> do { sendMessage $ (envGet "name" env) 
-                  ++ " " ++ (envGet "version" env) ++ " (try !h)"} ),
-            Command "!p" "Prints current state" 
-               (\s -> do { sendMessage $ show s } ),
-            Command "!s" "Stores current state to file" 
-               (\s -> do { sendMessage "Storing current state"; stateSave databaseFile s; } ),
-            Command "!q" "quits"
-               (\s -> do { sendMessage "Good bye"; stateSave databaseFile s; exitWith ExitSuccess } ) 
-            ]
-         sendMessage = ircPrivmsg h msg env
-         printHelp = sendMessage . concat . showL 
-         getLambda x = let (Command _ _ c) = getCommand x in c
-         getDescr x = let (Command _ b _) = getCommand x in b
-         getCommand x = 
-               let command = [ (Command a b c) | (Command a b c) <- commands, a == x ]
-                in if length command == 0
-                     then getCommand "!i" 
-                     else head command
-
+      evalServerMessage "+x" = ircWrite h "JOIN" (currentChannel state)
+      evalServerMessage _ = putStrLn $ show msg
+      sendReplyMsg = ircPrivMsg h msg env