From a13bb48ca1edf0fbc0a0d6a1aa09c4dc07758e3a Mon Sep 17 00:00:00 2001 From: pb Date: Sat, 13 Mar 2010 12:39:48 +0000 Subject: added irc functionality git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@20 9f8f72e9-4bf4-416e-b76e-7d4203597157 --- HsBot.hs | 218 ++++++++++++++++++++++++++++++++++++++++++--------------------- Main.hs | 7 -- hsbot.db | 2 +- 3 files changed, 146 insertions(+), 81 deletions(-) delete mode 100644 Main.hs diff --git a/HsBot.hs b/HsBot.hs index eaf5f83..f766df5 100644 --- a/HsBot.hs +++ b/HsBot.hs @@ -6,12 +6,14 @@ module Main where import IO import System +import List +import Network +import System.IO +import Text.Printf + -- Static configurations -version :: String version = "v0.0" - -database :: String database = "hsbot.db" -- logfile :: String @@ -36,13 +38,28 @@ instance Ord Karma where x >= y = not (x < y) x <= y = not (x > y) +data IrcConnection = IrcConnection { + server :: String, + port :: Int, + channel :: String, + nick :: String + } deriving (Show, Read) + +data IrcMessage = IrcMessage { + raw :: String, + from :: String, + clean :: String, + isQuery :: Bool + } deriving Show + data Conf = Conf { + irc :: IrcConnection, line :: String, loggs :: [String], maxLoggs :: Int, users :: [User], - karmas :: [Karma] } - deriving (Show, Read) + karmas :: [Karma] + } deriving (Show, Read) data User = User { userName :: String, @@ -68,8 +85,8 @@ instance Render User where (show $ userPts user) ++ "pts; " ++ (show $ userPerc user) ++ "%)" -loggMessage :: String -> Conf -> Conf -loggMessage message conf = +loggIrcMessage :: String -> Conf -> Conf +loggIrcMessage message conf = let l = message : (loggs conf) l' | (length l) > (maxLoggs conf) = init l | otherwise = l @@ -119,9 +136,9 @@ addUserKarma :: Int -> User -> User addUserKarma add user = user { userPts = userPts user + add } -- Sorts a list -sort :: (Ord a) => [a] -> [a] -sort [] = [] -sort (x:xs) = sort (filter (>= x) xs) ++ [x] ++ sort (filter (< x) xs) +--sort :: (Ord a) => [a] -> [a] +--sort [] = [] +--sort (x:xs) = sort (filter (>= x) xs) ++ [x] ++ sort (filter (< x) xs) uniq :: (Eq a) => [a] -> [a] uniq list = @@ -141,6 +158,9 @@ split (c:cs) delim | otherwise = (c : head rest) : tail rest where rest = split cs delim +empty :: String -> Bool +empty str = length str == 0 + -- Returns a list of all strings to increase or decrease the karma of matches :: String -> String -> [String] matches search string = uniq $ case m' $ occ search string of @@ -163,7 +183,7 @@ matches search string = uniq $ case m' $ occ search string of m' Nothing = ([], []) processInput :: Conf -> Conf -processInput conf = addAll --loggMessage "foo" conf +processInput conf = addAll --loggIrcMessage "foo" conf where add :: [User] -> [User] add [] = [] add (u:[]) = addUserKarma 1 u : [] @@ -172,28 +192,36 @@ processInput conf = addAll --loggMessage "foo" conf plus = matches "++" (line conf) minus = matches "--" (line conf) -loop :: IO Conf -> IO () -loop conf = - let loop' :: Conf -> IO () - loop' conf = do - line <- readInput - getLambda line conf -- Executing the specific lambda function of 'commands' - printHelp = putStr . foldr (++) "" . map (\(a,b,_) -> "\t" ++ a ++ " - " ++ b ++ "\n") - getLambda x = let (_, _, c) = getCommand x in c - getDescr x = let (_, b, _) = getCommand x in b - getCommand x = - let command = [ (a, b, c) | (a, b, c) <- commands, a == x ] - in if length command == 0 - then getCommand "!h" -- If there is no such command print out the help - else head command - where commands = [ - ("!h", "Prints help ", (\x -> do { printHelp commands; loop' x } ) ), - ("!l", "Prints loggs", (\x -> do { printLoggs x; loop' x } ) ), - ("!p", "Prints configuration", (\x -> do { putStrLn $ show x; loop' x } ) ), - ("!s", "Saves configuration", (\x -> do { putStrLn "Saving current xiguration"; save x; loop' x } ) ), - ("!q", "Quits", (\x -> do { putStrLn "Good bye"; save x; exitWith ExitSuccess } ) )] - in do conf' <- conf -- Extract Conf from the IO Monad and run loop' with pure input - loop' conf' +data Command = Command String String (Conf -> IO ()) + +instance Show Command where + show (Command a b _) = "\t" ++ a ++ " - " ++ b ++ "\n" + +loop :: Conf -> IO () +loop conf = do + line <- readInput + getLambda line conf -- Eval the specific lambda function of 'isCommands' + where + isCommands = [ + Command "!h" "Prints help" + (\x -> do { printHelp isCommands; loop x } ), + Command "!l" "Prints loggs" + (\x -> do { printLoggs x; loop x } ), + Command "!p" "Prints configuration" + (\x -> do { putStrLn $ show x; loop x } ), + Command "!s" "Saves configuration" + (\x -> do { putStrLn "Saving current configuration"; save x; loop x } ), + Command "!q" "quits" + (\x -> do { putStrLn "Good bye"; save x; exitWith ExitSuccess } ) + ] + printHelp = putStr . foldr (++) "" . map show + getLambda x = let (Command _ _ c) = getCommand x in c + getDescr x = let (Command _ b _) = getCommand x in b + getCommand x = + let isCommand = [ (Command a b c) | (Command a b c) <- isCommands, a == x ] + in if length isCommand == 0 + then getCommand "!h" -- If there is no such isCommand print out the help + else head isCommand -- Will be connected to IRC input in future instead of getLine readInput :: IO String @@ -201,8 +229,16 @@ readInput = getLine main :: IO () main = do - putStrLn $ "Welcome to HsBot " ++ version ++ " (Enter !h for help)" - loop load + putStrLn $ "Welcome to HsBot " ++ version ++ " (Enter !h for help)" + let conf = load + conf' <- conf -- Extract Conf from the IO Monad + connect conf' + --loop conf' -- and run loop with 'pure' input + +load :: IO Conf +load = do + file <- readFile database + return ( read file :: Conf ) save :: Conf -> IO () save = writeFile database . show @@ -212,45 +248,81 @@ saveIO conf = do conf' <- conf writeFile database (show conf') -load :: IO Conf -load = do - file <- readFile database - return ( read file :: Conf ) +makeIOConf :: IO Conf +makeIOConf = return (makeConf) -makeTestConf :: Conf -makeTestConf = Conf { +connect conf = do + let con = irc conf + h <- connectTo (server con) (PortNumber (fromIntegral (port con))) + hSetBuffering h NoBuffering + write h "NICK" (nick con) + write h "USER" ((nick con) ++ " 0 * :hsbot.haskell.eu") + listen h conf + +write :: Handle -> String -> String -> IO () +write h s t = do + hPrintf h "%s %s\r\n" s t + printf "> %s %s\n" s t + +listen :: Handle -> Conf -> IO () +listen h conf = forever $ do + t <- hGetLine h + let s = init t + if ping s + then pong s + else let msg = IrcMessage { + raw = s, + from = from s, + clean = clean s, + isQuery = isQuery s } + in eval h msg conf + where + forever a = do a; forever a + from = drop 1 . takeWhile (/= '!') + clean = drop 1 . dropWhile (/= ':') . drop 1 + isQuery x = split x ' ' !! 2 == (nick $ irc conf) + ping x = "PING :" `isPrefixOf` x + pong x = write h "PONG" (':' : drop 6 x) + +isCommand :: String -> Maybe String +isCommand ('!':xs) = Just xs +isCommand _ = Nothing + +eval :: Handle -> IrcMessage -> Conf-> IO () +eval h msg conf = + case isCommand (clean msg) of + Just xs -> evalCommand h xs msg conf + Nothing -> evalServerMessage (clean msg) + where + evalServerMessage "+x" = write h "JOIN" (channel $ irc conf) + evalServerMessage _ = putStrLn $ show msg + +evalCommand :: Handle -> String -> IrcMessage -> Conf-> IO () +evalCommand h cmd msg conf + | cmd == "hello" = privmsg h ("Hi " ++ (from msg) ++ ", what's up?") + | otherwise = privmsg h "No such command!" + where + privmsg h s = + let receiver = if (isQuery msg) + then from msg + else channel $ irc conf + in write h "PRIVMSG" (receiver ++ " :" ++ s) + +-- Will be removed some day: +makeConf :: Conf +makeConf = makeDefaultConf + +makeDefaultConf :: Conf +makeDefaultConf = Conf { + irc = IrcConnection { + server = "", + port = 6667, + channel = [], + nick = "" + }, line = "", loggs = [], maxLoggs = 10, - users = [ - User "thunder" 100, - User "otto" 1, - User "rantanplan" 3, - User "rantanplan2" 3, - User "icefox2" 11, - User "icefox" 10, - User "foobar" 5, - User "foobar1" 5, - User "foobar2" 5, - User "foobar3" 5, - User "foobar4" 5, - User "foobar5" 5, - User "foobar6" 5, - User "openfire" 2 - ], - karmas = [ - Karma "God" 20 90, - Karma "Guru" 10 80, - Karma "Nerd" 10 70, - Karma "Expert" 5 60, - Karma "Geek" 3 40, - Karma "Advanced" 0 20, - Karma "Cool dude" 0 0 - ] } - -makeConf :: Conf -makeConf = makeTestConf - -makeIOConf :: IO Conf -makeIOConf = return (makeConf) - + users = [ ], + karmas = [ ] +} diff --git a/Main.hs b/Main.hs deleted file mode 100644 index 8333078..0000000 --- a/Main.hs +++ /dev/null @@ -1,7 +0,0 @@ --- Karmabot By Paul C. Buetow - -module Main (main) where - -import HsBot - -main = start diff --git a/hsbot.db b/hsbot.db index 884103e..45a0a3c 100644 --- a/hsbot.db +++ b/hsbot.db @@ -1 +1 @@ -Conf {line = "!w\DELs", loggs = [], maxLoggs = 10, users = [User {userName = "thunder", userPts = 103},User {userName = "otto", userPts = 4},User {userName = "rantanplan", userPts = 102},User {userName = "rantanplan2", userPts = 6},User {userName = "icefox2", userPts = 14},User {userName = "icefox", userPts = 13},User {userName = "foobar", userPts = 8},User {userName = "foobar1", userPts = 8},User {userName = "foobar2", userPts = 8},User {userName = "foobar3", userPts = 8},User {userName = "foobar4", userPts = 8},User {userName = "foobar5", userPts = 8},User {userName = "foobar6", userPts = 8},User {userName = "openfire", userPts = 5}], karmas = [Karma {karmaName = "God", minPts = 20, minPerc = 90.0},Karma {karmaName = "Guru", minPts = 10, minPerc = 80.0},Karma {karmaName = "Nerd", minPts = 10, minPerc = 70.0},Karma {karmaName = "Expert", minPts = 5, minPerc = 60.0},Karma {karmaName = "Geek", minPts = 3, minPerc = 40.0},Karma {karmaName = "Advanced", minPts = 0, minPerc = 20.0},Karma {karmaName = "Cool dude", minPts = 0, minPerc = 0.0}]} \ No newline at end of file +Conf {irc = IrcConnection {server = "irc.german-elite.net", port = 6667, channel = "#buetow.org", nick = "hsbot"}, line = "!w\DELs", loggs = [], maxLoggs = 10, users = [User {userName = "thunder", userPts = 103},User {userName = "otto", userPts = 4},User {userName = "rantanplan", userPts = 102},User {userName = "rantanplan2", userPts = 6},User {userName = "icefox2", userPts = 14},User {userName = "icefox", userPts = 13},User {userName = "foobar", userPts = 8},User {userName = "foobar1", userPts = 8},User {userName = "foobar2", userPts = 8},User {userName = "foobar3", userPts = 8},User {userName = "foobar4", userPts = 8},User {userName = "foobar5", userPts = 8},User {userName = "foobar6", userPts = 8},User {userName = "openfire", userPts = 5}], karmas = [Karma {karmaName = "God", minPts = 20, minPerc = 90.0},Karma {karmaName = "Guru", minPts = 10, minPerc = 80.0},Karma {karmaName = "Nerd", minPts = 10, minPerc = 70.0},Karma {karmaName = "Expert", minPts = 5, minPerc = 60.0},Karma {karmaName = "Geek", minPts = 3, minPerc = 40.0},Karma {karmaName = "Advanced", minPts = 0, minPerc = 20.0},Karma {karmaName = "Cool dude", minPts = 0, minPerc = 0.0}]} -- cgit v1.2.3