From a7865fd10582a9b710e96d2052a9ce90ced8020c Mon Sep 17 00:00:00 2001 From: pb Date: Sun, 14 Mar 2010 14:12:17 +0000 Subject: added environment git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@26 9f8f72e9-4bf4-416e-b76e-7d4203597157 --- Conf.hs | 9 ++++++- Env.hs | 13 ++++++++++ IRC.hs | 82 ++++++++++++++++++++++++---------------------------------------- Main.hs | 5 ++-- State.hs | 15 +++++++++++- hsbot.db | 2 +- 6 files changed, 70 insertions(+), 56 deletions(-) create mode 100644 Env.hs diff --git a/Conf.hs b/Conf.hs index 33be1dd..9db9c19 100644 --- a/Conf.hs +++ b/Conf.hs @@ -7,7 +7,7 @@ type Conf = M.Map String String makeConf = M.fromList [ ("name", "HsBot") , ("version", "v0.0") - , ("database", "hsbot.db") + , ("databaseFile", "hsbot.db") , ("maxMessageSize", "400") , ("admin", "rantanplan") , ("ircServer", "irc.german-elite.net") @@ -19,3 +19,10 @@ makeConf = M.fromList get :: (Monad m) => String -> Conf -> m String get = M.lookup + +getUnwrappedInt :: String -> Conf -> Int +getUnwrappedInt key conf = read (getUnwrapped key conf) :: Int + +getUnwrapped :: String -> Conf -> String +getUnwrapped key conf = do { val <- get key conf; val } + diff --git a/Env.hs b/Env.hs new file mode 100644 index 0000000..5c47815 --- /dev/null +++ b/Env.hs @@ -0,0 +1,13 @@ +module Env where + +import Conf +import State + +data Env = Env State Conf + +envGetInt :: String -> Env -> Int +envGetInt key (Env _ conf) = getUnwrappedInt key conf + +envGet :: String -> Env -> String +envGet key (Env _ conf) = getUnwrapped key conf + diff --git a/IRC.hs b/IRC.hs index 25d2b34..02f0a59 100644 --- a/IRC.hs +++ b/IRC.hs @@ -8,31 +8,11 @@ import System.IO import Text.Printf import Conf +import Env import State import Tools import User -load :: String -> IO State -load databaseFile = do - file <- readFile databaseFile - return ( read file :: State ) - -save :: State -> IO () -save = writeFile database . show - -saveIO :: IO State -> IO () -saveIO state = do - state' <- state - writeFile database (show state') - -makeIOState :: IO State -makeIOState = return (makeState) - --- Will be removed some day: -makeState :: State -makeState = State { channel = "", line = "", users = [ ], karmas = [ ] } ---- - data IrcMessage = IrcMessage { raw :: String, from :: String, @@ -42,16 +22,17 @@ data IrcMessage = IrcMessage { ircWrite :: Handle -> String -> String -> IO () ircWrite h s t = do - hPrintf h "%s %s\r\n" s t - printf "> %s %s\n" s t + printf "> %s %s\n" s t + hPrintf h "%s %s\r\n" s t -ircPrivmsg :: Handle -> IrcMessage -> State -> Conf -> String -> IO () -ircPrivmsg h msg state conf s = +ircPrivmsg :: Handle -> IrcMessage -> Env -> String -> IO () +ircPrivmsg h msg (Env state conf) s = do if isMultiline s then ircPrivmsg' (lines s) else ircPrivmsg' [s] where ircPrivmsg' [] = return () - ircPrivmsg' (x:xs) = - let receiver = if (isQuery msg) then from msg else channel state + ircPrivmsg' (x:xs) = + let maxMessageSize = getUnwrappedInt "maxMessageSize" conf + receiver = if (isQuery msg) then from msg else currentChannel state in if length x > maxMessageSize then do ircWrite h "PRIVMSG" (receiver ++ " :" ++ (take maxMessageSize x) ++ "...") @@ -62,21 +43,21 @@ ircPrivmsg h msg state conf s = else do ircWrite h "PRIVMSG" (receiver ++ " :" ++ x) ircPrivmsg' xs -ircConnect :: State -> Conf -> IO () -ircConnect state conf = do +ircConnect :: Env -> IO () +ircConnect (Env state conf) = 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))) + h <- connectTo ircServer (PortNumber $ fromIntegral (read ircPort :: Int)) hSetBuffering h NoBuffering ircWrite h "NICK" ircNick ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser - ircEvalLoop h state { channel = ircChannel } conf + ircEvalLoop h (Env (state { currentChannel = ircChannel }) conf) -ircEvalLoop :: Handle -> State -> Conf -> IO () -ircEvalLoop h state conf = forever $ do +ircEvalLoop :: Handle -> Env -> IO () +ircEvalLoop h env = forever $ do t <- hGetLine h let s = init t if ping s @@ -86,50 +67,49 @@ ircEvalLoop h state conf = forever $ do from = from s, clean = clean s, isQuery = isQuery s } - in ircEval h msg state conf + in ircEval h msg env where forever a = do a; forever a from = drop 1 . takeWhile (/= '!') clean = drop 1 . dropWhile (/= ':') . drop 1 - isQuery x = split x ' ' !! 2 == ircNick - where ircNick = do { ircNick <- get "ircNick" conf; ircNick } + isQuery x = split x ' ' !! 2 == (envGet "ircNick" env) ping x = "PING :" `isPrefixOf` x pong x = ircWrite h "PONG" (':' : drop 6 x) -ircEval :: Handle -> IrcMessage -> State -> Conf -> IO () -ircEval h msg state conf = +ircEval :: Handle -> IrcMessage -> Env -> IO () +ircEval h msg env@(Env state _) = case isCommand (clean msg) of - Just xs -> dispatch h xs msg state conf + Just xs -> dispatch h xs msg env Nothing -> ircEvalServerMessage (clean msg) where isCommand ('!':xs) = Just xs isCommand _ = Nothing - ircEvalServerMessage "+x" = do - ircChannel <- get "ircChannel" conf - ircWrite h "JOIN" ircChannel + 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 -> State -> Conf -> IO () -dispatch h cmd msg state conf = do +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 $ name ++ " " ++ version ++ " (try !h)"} ), - Command "!p" "Prints stateiguration" - (\x -> do { sendMessage $ show x } ), - Command "!s" "Saves stateiguration" - (\x -> do { sendMessage "Saving current stateiguration"; save x; } ), + (\_ -> 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" - (\x -> do { sendMessage "Good bye"; save x; exitWith ExitSuccess } ) + (\s -> do { sendMessage "Good bye"; stateSave databaseFile s; exitWith ExitSuccess } ) ] - sendMessage = ircPrivmsg h msg state conf + 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 diff --git a/Main.hs b/Main.hs index 8be35cf..50e9f44 100644 --- a/Main.hs +++ b/Main.hs @@ -3,14 +3,15 @@ module Main where import Conf import IRC import State +import Env main :: IO () main = do let conf = makeConf databaseFile <- get "databaseFile" conf - let state = load databaseFile + let state = stateLoad databaseFile state' <- state -- Extract State from the IO Monad - ircConnect state' conf + ircConnect (Env state' conf) -- Shortcut r :: IO () diff --git a/State.hs b/State.hs index 27fd11f..c31d410 100644 --- a/State.hs +++ b/State.hs @@ -5,7 +5,7 @@ import List import User data State = State { - channel :: String, + currentChannel :: String, line :: String, users :: [User] } deriving (Show, Read) @@ -16,3 +16,16 @@ stateNumUsers state = length $ users state stateSortedUsers :: State -> [User] stateSortedUsers state = sort $ users state +stateLoad :: String -> IO State +stateLoad databaseFile = do + file <- readFile databaseFile + return ( read file :: State ) + +stateSave :: String -> State -> IO () +stateSave databaseFile = writeFile databaseFile . show + +stateSaveIO :: String -> IO State -> IO () +stateSaveIO databaseFile state = do + state' <- state + writeFile databaseFile (show state') + diff --git a/hsbot.db b/hsbot.db index 1786071..1226f84 100644 --- a/hsbot.db +++ b/hsbot.db @@ -1 +1 @@ -State {channel = "#buetow.org", line = "!w\DELs", 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 +State {currentChannel = "#buetow.org", line = "!w\DELs", 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}]} \ No newline at end of file -- cgit v1.2.3