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

1 files changed, 39 insertions, 49 deletions

diff --git a/HsBot.hs b/HsBot.hs
index f766df5..00dc69b 100644
--- a/HsBot.hs
+++ b/HsBot.hs
@@ -15,6 +15,8 @@ import Text.Printf
 
 version = "v0.0"
 database = "hsbot.db"
+maxMessageSize = 400
+adminsitrator = "rantanplan"
 
 -- logfile :: String
 -- logfile = "hsbot.log"
@@ -135,11 +137,6 @@ userKarma user = userKarma' (userPts user) (userPerc user)
 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)
-
 uniq :: (Eq a) => [a] -> [a]
 uniq list = 
 	let r = u' list 0                    
@@ -197,43 +194,11 @@ 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
-readInput = getLine
-
 main :: IO ()	
 main = do
-   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
@@ -264,6 +229,14 @@ write h s t = do
    hPrintf h   "%s %s\r\n" s t
    printf      "> %s %s\n" s t
 
+privmsg :: Handle -> String -> IrcMessage -> Conf -> IO ()
+privmsg h s msg conf = 
+   let receiver = if (isQuery msg) then from msg else channel $ irc conf
+    in if length s > maxMessageSize
+         then do write h "PRIVMSG" (receiver ++ " :" ++ (take maxMessageSize s) ++ "...")
+                 write h "PRIVMSG" (receiver ++ " :" ++ "...this message has been cut to " ++ (show maxMessageSize) ++ " chars")
+         else write h "PRIVMSG" (receiver ++ " :" ++ s)
+
 listen :: Handle -> Conf -> IO ()
 listen h conf = forever $ do
       t <- hGetLine h
@@ -284,29 +257,46 @@ listen h conf = forever $ do
       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
+      isCommand ('!':xs) = Just xs
+      isCommand _ = Nothing
       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)
+      | cmd == "hello" = privmsg h ("Hi " ++ (from msg) ++ ", what's up?") msg conf
+      | otherwise = dispatch h cmd msg conf
+
+dispatch :: Handle -> String -> IrcMessage -> Conf-> IO ()
+dispatch h cmd msg conf = do
+   getLambda ("!" ++ cmd) conf -- Eval the specific lambda function of 'command'
+      where
+         commands = [      
+            Command "!h" "Prints help" 
+               (\x -> do { printHelp commands } ),
+            Command "!l" "Prints loggs" 
+               (\x -> do { printLoggs x } ),
+            Command "!p" "Prints configuration" 
+               (\x -> do { privmsg h (show x) msg conf } ),
+            Command "!s" "Saves configuration" 
+               (\x -> do { putStrLn "Saving current configuration"; save 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 command = [ (Command a b c) | (Command 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
 
 -- Will be removed some day:
 makeConf :: Conf