diff options
Diffstat (limited to 'IRC.hs')
| -rw-r--r-- | IRC.hs | 64 |
1 files changed, 16 insertions, 48 deletions
@@ -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 |