added environment

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

1 files changed, 31 insertions, 51 deletions

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