From 08e80e41af814eb3d6bc21c72e0830f0fc1e8c6c Mon Sep 17 00:00:00 2001 From: pb Date: Sun, 28 Mar 2010 10:55:24 +0000 Subject: git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@47 9f8f72e9-4bf4-416e-b76e-7d4203597157 --- HsBot/AI.hs | 6 --- HsBot/IRC.hs | 96 ------------------------------------------------ HsBot/IRC/Connection.hs | 96 ++++++++++++++++++++++++++++++++++++++++++++++++ HsBot/IRC/User.hs | 28 ++++++++++++++ HsBot/Karma.hs | 21 ----------- HsBot/Logics.hs | 10 +++++ HsBot/Logics/AI.hs | 6 --- HsBot/Logics/IRCKarma.hs | 27 ++++++++++++++ HsBot/Start.hs | 6 +-- HsBot/User.hs | 28 -------------- 10 files changed, 164 insertions(+), 160 deletions(-) delete mode 100644 HsBot/AI.hs delete mode 100644 HsBot/IRC.hs create mode 100644 HsBot/IRC/Connection.hs create mode 100644 HsBot/IRC/User.hs delete mode 100644 HsBot/Karma.hs create mode 100644 HsBot/Logics.hs delete mode 100644 HsBot/Logics/AI.hs create mode 100644 HsBot/Logics/IRCKarma.hs delete mode 100644 HsBot/User.hs (limited to 'HsBot') diff --git a/HsBot/AI.hs b/HsBot/AI.hs deleted file mode 100644 index 9deaca4..0000000 --- a/HsBot/AI.hs +++ /dev/null @@ -1,6 +0,0 @@ -module HsBot.AI (aiRun) where - -import HsBot.Env - -aiRun :: String -> Env -> IO Env -aiRun str env = return (env) diff --git a/HsBot/IRC.hs b/HsBot/IRC.hs deleted file mode 100644 index 28fc9f0..0000000 --- a/HsBot/IRC.hs +++ /dev/null @@ -1,96 +0,0 @@ -module HsBot.IRC (ircStart) where - -import IO -import List -import Network -import System -import System.IO -import Text.Printf - -import HsBot.Conf -import HsBot.Env -import HsBot.State -import HsBot.Tools -import HsBot.User - -data IrcMessage = IrcMessage { - raw :: String, - from :: String, - clean :: String, - isQuery :: Bool - } deriving Show - -ircWrite :: Handle -> String -> String -> IO () -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@(Env state _) s = do - ircPrivMsg' $ if isMultiline s then (lines s) else [s] - where - ircPrivMsg' [] = return () - ircPrivMsg' (x:xs) = - let maxMessageSize = - envGetInt "maxMessageSize" env - receiver = - if (isQuery msg) - then from msg - else currentChannel state - in if length x > maxMessageSize - then do - ircWrite h "PRIVMSG" (receiver ++ " :" - ++ (take maxMessageSize x) ++ "...") - ircWrite h "PRIVMSG" (receiver ++ " :" - ++ "...this message has been cut to " - ++ (show maxMessageSize) ++ " chars") - ircPrivMsg' xs - else do - ircWrite h "PRIVMSG" (receiver ++ " :" ++ x) - ircPrivMsg' xs - -ircStart :: Env -> IO () -ircStart (DispatchEnv state conf dispatch) = do - ircChannel <- get "ircChannel" conf - ircNick <- get "ircNick" conf - ircPort <- get "ircPort" conf - ircServer <- get "ircServer" conf - ircUser <- get "ircUser" conf - h <- connectTo ircServer (PortNumber $ fromIntegral (read ircPort :: Int)) - hSetBuffering h NoBuffering - ircWrite h "NICK" ircNick - ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser - ircEvalLoop h (DispatchEnv state { currentChannel = ircChannel } conf dispatch) - return () - -ircEvalLoop :: Handle -> Env -> IO () -ircEvalLoop h env = do - t <- hGetLine h - let s = init t - env' <- branch s - ircEvalLoop h env' - where - 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) = ircEval' (clean msg) - where - 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) - diff --git a/HsBot/IRC/Connection.hs b/HsBot/IRC/Connection.hs new file mode 100644 index 0000000..c4fa7a9 --- /dev/null +++ b/HsBot/IRC/Connection.hs @@ -0,0 +1,96 @@ +module HsBot.IRC.IRConnection (ircStart) where + +import IO +import List +import Network +import System +import System.IO +import Text.Printf + +import HsBot.Conf +import HsBot.Env +import HsBot.State +import HsBot.Tools +import HsBot.IRC.User + +data IrcMessage = IrcMessage { + raw :: String, + from :: String, + clean :: String, + isQuery :: Bool + } deriving Show + +ircWrite :: Handle -> String -> String -> IO () +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@(Env state _) s = do + ircPrivMsg' $ if isMultiline s then (lines s) else [s] + where + ircPrivMsg' [] = return () + ircPrivMsg' (x:xs) = + let maxMessageSize = + envGetInt "maxMessageSize" env + receiver = + if (isQuery msg) + then from msg + else currentChannel state + in if length x > maxMessageSize + then do + ircWrite h "PRIVMSG" (receiver ++ " :" + ++ (take maxMessageSize x) ++ "...") + ircWrite h "PRIVMSG" (receiver ++ " :" + ++ "...this message has been cut to " + ++ (show maxMessageSize) ++ " chars") + ircPrivMsg' xs + else do + ircWrite h "PRIVMSG" (receiver ++ " :" ++ x) + ircPrivMsg' xs + +ircStart :: Env -> IO () +ircStart (DispatchEnv state conf dispatch) = do + ircChannel <- get "ircChannel" conf + ircNick <- get "ircNick" conf + ircPort <- get "ircPort" conf + ircServer <- get "ircServer" conf + ircUser <- get "ircUser" conf + h <- connectTo ircServer (PortNumber $ fromIntegral (read ircPort :: Int)) + hSetBuffering h NoBuffering + ircWrite h "NICK" ircNick + ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser + ircEvalLoop h (DispatchEnv state { currentChannel = ircChannel } conf dispatch) + return () + +ircEvalLoop :: Handle -> Env -> IO () +ircEvalLoop h env = do + t <- hGetLine h + let s = init t + env' <- branch s + ircEvalLoop h env' + where + 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) = ircEval' (clean msg) + where + 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) + diff --git a/HsBot/IRC/User.hs b/HsBot/IRC/User.hs new file mode 100644 index 0000000..cd6d55f --- /dev/null +++ b/HsBot/IRC/User.hs @@ -0,0 +1,28 @@ +module HsBot.User where + +import List + +import HsBot.Karma +import HsBot.Render + +data User = User { + userName :: String, + userPts :: Int + } deriving (Show, Read) + +instance Eq User where + x == y = (userPts x) == (userPts y) + +instance Ord User where + x < y = (userPts x) < (userPts y) + x > y = (userPts x) > (userPts y) + x >= y = not (x < y) + x <= y = not (x > y) + +instance Render User where + render user = userName user ++ ": " ++ + (show $ userPts user) ++ "pts" + +userEquals :: User -> User -> Bool +userEquals x y = (userName x) == (userName y) + diff --git a/HsBot/Karma.hs b/HsBot/Karma.hs deleted file mode 100644 index 939b782..0000000 --- a/HsBot/Karma.hs +++ /dev/null @@ -1,21 +0,0 @@ -module HsBot.Karma where - -data Karma = Karma { - karmaName :: String, - minPts :: Int, - minPerc :: Float - } deriving (Show, Read) - -instance Eq Karma where - x == y = (minPerc x) == (minPerc y) && (minPts x == minPts y) - -instance Ord Karma where - x > y - | (minPerc x) > (minPerc y) = True - | otherwise = (minPts x) > (minPts y) - x < y - | (minPerc x) < (minPerc y) = True - | otherwise = (minPts x) < (minPts y) - x >= y = not (x < y) - x <= y = not (x > y) - diff --git a/HsBot/Logics.hs b/HsBot/Logics.hs new file mode 100644 index 0000000..5b534e5 --- /dev/null +++ b/HsBot/Logics.hs @@ -0,0 +1,10 @@ +module HsBot.Logics (logicsRun) where + +import HsBot.Env +import HsBot.Logics.IRCKarma + +class Logics where + logicRun :: String -> Env -> IO Env + +logicsRun :: String -> Env -> IO Env +logicsRun str env = return (env) diff --git a/HsBot/Logics/AI.hs b/HsBot/Logics/AI.hs deleted file mode 100644 index 9deaca4..0000000 --- a/HsBot/Logics/AI.hs +++ /dev/null @@ -1,6 +0,0 @@ -module HsBot.AI (aiRun) where - -import HsBot.Env - -aiRun :: String -> Env -> IO Env -aiRun str env = return (env) diff --git a/HsBot/Logics/IRCKarma.hs b/HsBot/Logics/IRCKarma.hs new file mode 100644 index 0000000..55c74d7 --- /dev/null +++ b/HsBot/Logics/IRCKarma.hs @@ -0,0 +1,27 @@ +module HsBot.Logics.IrcKarma where + +import HsBot.Env +import HsBot.Logics + +data Karma = Karma { + karmaName :: String, + minPts :: Int, + minPerc :: Float + } deriving (Show, Read) + +instance Eq Karma where + x == y = (minPerc x) == (minPerc y) && (minPts x == minPts y) + +instance Ord Karma where + x > y + | (minPerc x) > (minPerc y) = True + | otherwise = (minPts x) > (minPts y) + x < y + | (minPerc x) < (minPerc y) = True + | otherwise = (minPts x) < (minPts y) + x >= y = not (x < y) + x <= y = not (x > y) + +instance Logics Karma where + logicsRun str env = return (env) + diff --git a/HsBot/Start.hs b/HsBot/Start.hs index cf87404..3ea4d1e 100644 --- a/HsBot/Start.hs +++ b/HsBot/Start.hs @@ -2,11 +2,11 @@ module HsBot.Start (start) where import System -import HsBot.AI import HsBot.Cmd import HsBot.Conf import HsBot.Env -import HsBot.IRC +import HsBot.IRC.Connection +import HsBot.Logics import HsBot.State import HsBot.Tools @@ -27,7 +27,7 @@ dispatch msg sendMessage env@(Env state conf) = dispatch' msg cmdAction state return (env) Nothing -> return (env) - dispatch' _ = aiRun msg env + dispatch' _ = logicsRun msg env commands = [ Cmd "!h" "Prints help" printHelp, Cmd "!i" "Prints infos" printInfos, diff --git a/HsBot/User.hs b/HsBot/User.hs deleted file mode 100644 index cd6d55f..0000000 --- a/HsBot/User.hs +++ /dev/null @@ -1,28 +0,0 @@ -module HsBot.User where - -import List - -import HsBot.Karma -import HsBot.Render - -data User = User { - userName :: String, - userPts :: Int - } deriving (Show, Read) - -instance Eq User where - x == y = (userPts x) == (userPts y) - -instance Ord User where - x < y = (userPts x) < (userPts y) - x > y = (userPts x) > (userPts y) - x >= y = not (x < y) - x <= y = not (x > y) - -instance Render User where - render user = userName user ++ ": " ++ - (show $ userPts user) ++ "pts" - -userEquals :: User -> User -> Bool -userEquals x y = (userName x) == (userName y) - -- cgit v1.2.3