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

5 files changed, 187 insertions, 143 deletions

diff --git a/HsBot.hs b/HsBot.hs
deleted file mode 100644
index 25d2b34..0000000
--- a/HsBot.hs
+++ /dev/null
@@ -1,141 +0,0 @@
-module IRC where
-
-import IO
-import List
-import Network
-import System
-import System.IO
-import Text.Printf
-
-import Conf
-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,
-      clean :: String,
-      isQuery :: Bool
-   } deriving Show
-
-ircWrite :: Handle -> String -> String -> IO ()
-ircWrite h s t = do
-   hPrintf h   "%s %s\r\n" s t
-   printf      "> %s %s\n" s t
-
-ircPrivmsg :: Handle -> IrcMessage -> State -> Conf -> String -> IO ()
-ircPrivmsg h msg state conf s = 
-      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
-          in if length x > maxMessageSize
-               then do ircWrite h "PRIVMSG" (receiver ++ " :" 
-                              ++ (take maxMessageSize x) ++ "...")
-                       ircWrite h "PRIVMSG" (receiver ++ " :" 
-                              ++ "...this message has been cut to " 
-                              ++ (show maxMessageSize) ++ " chars")
-                       ircPrivmsg' xs
-               else do ircWrite h "PRIVMSG" (receiver ++ " :" ++ x)
-                       ircPrivmsg' xs
-
-ircConnect :: State -> Conf -> IO ()
-ircConnect 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)))
-   hSetBuffering h NoBuffering
-   ircWrite h "NICK" ircNick
-   ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser
-   ircEvalLoop h state { channel = ircChannel } conf
-
-ircEvalLoop :: Handle -> State -> Conf -> IO ()
-ircEvalLoop h state 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 ircEval h msg state conf
-   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 } 
-      ping x = "PING :" `isPrefixOf` x
-      pong x = ircWrite h "PONG" (':' : drop 6 x)
-
-ircEval :: Handle -> IrcMessage -> State -> Conf -> IO ()
-ircEval h msg state conf = 
-   case isCommand (clean msg) of
-      Just xs -> dispatch h xs msg state conf
-      Nothing -> ircEvalServerMessage (clean msg)
-   where
-      isCommand ('!':xs) = Just xs
-      isCommand _ = Nothing
-      ircEvalServerMessage "+x" = do
-            ircChannel <- get "ircChannel" conf
-            ircWrite h "JOIN" ircChannel
-      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
-   getLambda ("!" ++ cmd) state -- Eval the specific lambda function of 'command'
-      where
-         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; } ),
-            Command "!q" "quits"
-               (\x -> do { sendMessage "Good bye"; save x; exitWith ExitSuccess } ) 
-            ]
-         sendMessage = ircPrivmsg h msg state conf
-         printHelp = sendMessage . concat . showL 
-         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 "!i" 
-                     else head command
-
diff --git a/IRC.hs b/IRC.hs
index 6897c71..25d2b34 100644
--- a/IRC.hs
+++ b/IRC.hs
@@ -1,10 +1,141 @@
 module IRC where
 
 import IO
-import System
-
 import List
 import Network
+import System
 import System.IO
 import Text.Printf
 
+import Conf
+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,
+      clean :: String,
+      isQuery :: Bool
+   } deriving Show
+
+ircWrite :: Handle -> String -> String -> IO ()
+ircWrite h s t = do
+   hPrintf h   "%s %s\r\n" s t
+   printf      "> %s %s\n" s t
+
+ircPrivmsg :: Handle -> IrcMessage -> State -> Conf -> String -> IO ()
+ircPrivmsg h msg state conf s = 
+      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
+          in if length x > maxMessageSize
+               then do ircWrite h "PRIVMSG" (receiver ++ " :" 
+                              ++ (take maxMessageSize x) ++ "...")
+                       ircWrite h "PRIVMSG" (receiver ++ " :" 
+                              ++ "...this message has been cut to " 
+                              ++ (show maxMessageSize) ++ " chars")
+                       ircPrivmsg' xs
+               else do ircWrite h "PRIVMSG" (receiver ++ " :" ++ x)
+                       ircPrivmsg' xs
+
+ircConnect :: State -> Conf -> IO ()
+ircConnect 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)))
+   hSetBuffering h NoBuffering
+   ircWrite h "NICK" ircNick
+   ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser
+   ircEvalLoop h state { channel = ircChannel } conf
+
+ircEvalLoop :: Handle -> State -> Conf -> IO ()
+ircEvalLoop h state 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 ircEval h msg state conf
+   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 } 
+      ping x = "PING :" `isPrefixOf` x
+      pong x = ircWrite h "PONG" (':' : drop 6 x)
+
+ircEval :: Handle -> IrcMessage -> State -> Conf -> IO ()
+ircEval h msg state conf = 
+   case isCommand (clean msg) of
+      Just xs -> dispatch h xs msg state conf
+      Nothing -> ircEvalServerMessage (clean msg)
+   where
+      isCommand ('!':xs) = Just xs
+      isCommand _ = Nothing
+      ircEvalServerMessage "+x" = do
+            ircChannel <- get "ircChannel" conf
+            ircWrite h "JOIN" ircChannel
+      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
+   getLambda ("!" ++ cmd) state -- Eval the specific lambda function of 'command'
+      where
+         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; } ),
+            Command "!q" "quits"
+               (\x -> do { sendMessage "Good bye"; save x; exitWith ExitSuccess } ) 
+            ]
+         sendMessage = ircPrivmsg h msg state conf
+         printHelp = sendMessage . concat . showL 
+         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 "!i" 
+                     else head command
+
diff --git a/Karma.hs b/Karma.hs
new file mode 100644
index 0000000..9093936
--- /dev/null
+++ b/Karma.hs
@@ -0,0 +1,21 @@
+module Karma where
+
+data Karma = Karma { 
+      karmaName :: String, 
+      minPts :: Int, 
+      minPerc :: Float
+   } deriving (Show, Read)
+
+instance Eq Karma where 
+   x == y = (minPerc x) == (minPerc y) && (minPts x == minPts y)
+
+instance Ord Karma where
+   x > y
+      | (minPerc x) > (minPerc y) = True
+      | otherwise = (minPts x) > (minPts y)
+   x < y
+      | (minPerc x) < (minPerc y) = True
+      | otherwise = (minPts x) < (minPts y)
+   x >= y = not (x < y)
+   x <= y = not (x > y)
+
diff --git a/Render.hs b/Render.hs
new file mode 100644
index 0000000..924040b
--- /dev/null
+++ b/Render.hs
@@ -0,0 +1,5 @@
+module Render where
+
+class Render a where 
+   render :: a -> String
+
diff --git a/User.hs b/User.hs
new file mode 100644
index 0000000..ba1a58c
--- /dev/null
+++ b/User.hs
@@ -0,0 +1,28 @@
+module User where
+
+import List
+
+import Karma
+import Render
+
+data User = User { 
+      userName :: String,
+      userPts :: Int 
+   } deriving (Show, Read) 
+
+instance Eq User where 
+   x == y = (userPts x) == (userPts y)
+
+instance Ord User where
+	x < y = (userPts x) < (userPts y)
+	x > y = (userPts x) > (userPts y)
+	x >= y = not (x < y)
+	x <= y = not (x > y)
+
+instance Render User where
+	render user = userName user ++ ": " ++ 
+		(show $ userPts user) ++ "pts"
+
+userEquals :: User -> User -> Bool
+userEquals x y = (userName x) == (userName y)
+