added environment

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

6 files changed, 70 insertions, 56 deletions

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