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

1 files changed, 16 insertions, 147 deletions

diff --git a/HsBot.hs b/HsBot.hs
index e8894e6..25d2b34 100644
--- a/HsBot.hs
+++ b/HsBot.hs
@@ -1,151 +1,20 @@
--- HsBot - The Karmabot By Paul Buetow
-
---module Main (main,matches) where
-module HsBot where
+module IRC where
 
 import IO
-import System
-
 import List
 import Network
+import System
 import System.IO
 import Text.Printf
 
-import Tools
 import Conf
 import State
+import Tools
+import User
 
--- Static stateigurations (will be moved to Conf.hs)
-
-name = "hsbot"
-version = "v0.0"
-database = "hsbot.db"
-maxMessageSize = 400
-adminsitrator = "rantanplan"
-
--- End of static stateigurations
-
-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)
-
-data State = State { 
-      channel :: String, 
-      line :: String, 
-      users :: [User], 
-      karmas :: [Karma] 
-   } deriving (Show, Read)
-
-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)
-
-class Render a where render :: a -> String
-
-instance Render User where
-	render user = userName user ++ ": " ++ 
-		(userKarma user) ++ 	" (rank " ++ 
-		(show $ userRank user) ++ "/" ++ 
-		(show numUsers) ++ "; " ++ 
-		(show $ userPts user) ++ "pts; " ++ 
-		(show $ userPerc user) ++ "%)"
-
-numUsers :: Int
-numUsers = length $ users makeState
-
-sortedUsers :: [User]
-sortedUsers = sort $ users makeState
-
-userEquals :: User -> User -> Bool
-userEquals x y = (userName x) == (userName y)
-
-userRank :: User -> Int
-userRank = userRank' 1 sortedUsers
-	where userRank' rank (x:xs) user
-		| userEquals x user = rank
-		| otherwise = userRank' (rank+1) xs user
-
-getUser :: String -> State -> User
-getUser name = head . filter (\x -> userName x == name) . users
-
-userPerc :: User -> Float
-userPerc user = 
-	let rank = userRank user
-	    userPerc' 
-		| rank == 1 = 100 -- 1st always has 100%
-		| rank == numUsers = 0 -- back always has 0%
-		| otherwise = 
-			let userWeight = 100 / (fromIntegral numUsers)
-			in 100 - userWeight * (fromIntegral rank)
-	 in userPerc' 
-
-userKarma :: User -> String 
-userKarma user = userKarma' (userPts user) (userPerc user)
-	where userKarma' pts perc = 
-		let cands = sort $ filter (\x -> minPts x <= pts && minPerc x <= perc) 
-                     (karmas makeState)
-		 in karmaName $ cands !! 0 -- Best posible karma 
-
-addUserKarma :: Int -> User -> User
-addUserKarma add user = user { userPts = userPts user + add }
-
--- Returns a list of all strings to increase or decrease the karma of
-matches :: String -> String -> [String]
-matches search string = uniq $ case m' $ occ search string of
-		(list, "") -> list
-		(list, rest) -> list ++ (matches search rest)
-      where occ :: String -> String -> Maybe (String, String)
-	    occ search str = o' "" search str
-	    	where o' pred [] str = Just (init . init $ reverse pred, str)
-	    	      o' pred occ [] = Nothing
-	    	      o' pred (m:occ) (s:str) 
-	    		| otherwise = o' (s:pred) search str
-	    extr extrF = extrF . filter (\x -> (x /= '-') && (x /= '+')) 
-	    extrL str -- extract left side
-		| null str || last str == ' ' = []
-		| otherwise = [last $ split str ' ']
-      	    extrR str -- extract right side
-		| null str || str !! 0 == ' ' = []
-		| otherwise = [split str ' ' !! 0] 
-	    m' (Just (a, b)) = ((extr extrL a) ++ (extr extrR b), b)
-	    m' Nothing = ([], [])
-
-processInput :: State -> State
-processInput state = addAll 
-	where add :: [User] -> [User]
-	      add [] = []
-	      add (u:[]) = addUserKarma 1 u : []
-	      add (u:us) = addUserKarma 1 u : (add us)
-	      addAll = state { users = add (users state)  }
-	      plus = matches "++" (line state)
-	      minus = matches "--" (line state)
-
-load :: IO State
-load = do
-   file <- readFile database
+load :: String -> IO State
+load databaseFile = do
+   file <- readFile databaseFile
    return ( read file :: State )
 
 save :: State -> IO ()
@@ -204,10 +73,10 @@ ircConnect state conf = do
    hSetBuffering h NoBuffering
    ircWrite h "NICK" ircNick
    ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser
-   evalLoop h state { channel = ircChannel } conf
+   ircEvalLoop h state { channel = ircChannel } conf
 
-evalLoop :: Handle -> State -> Conf -> IO ()
-evalLoop h state conf = forever $ do
+ircEvalLoop :: Handle -> State -> Conf -> IO ()
+ircEvalLoop h state conf = forever $ do
       t <- hGetLine h
       let s = init t
       if ping s 
@@ -217,7 +86,7 @@ evalLoop h state conf = forever $ do
                   from = from s, 
                   clean = clean s, 
                   isQuery = isQuery s }
-               in eval h msg state conf
+               in ircEval h msg state conf
    where 
       forever a = do a; forever a
       from = drop 1 . takeWhile (/= '!') 
@@ -227,18 +96,18 @@ evalLoop h state conf = forever $ do
       ping x = "PING :" `isPrefixOf` x
       pong x = ircWrite h "PONG" (':' : drop 6 x)
 
-eval :: Handle -> IrcMessage -> State -> Conf -> IO ()
-eval h msg state conf = 
+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 -> evalServerMessage (clean msg)
+      Nothing -> ircEvalServerMessage (clean msg)
    where
       isCommand ('!':xs) = Just xs
       isCommand _ = Nothing
-      evalServerMessage "+x" = do
+      ircEvalServerMessage "+x" = do
             ircChannel <- get "ircChannel" conf
             ircWrite h "JOIN" ircChannel
-      evalServerMessage _ = putStrLn $ show msg
+      ircEvalServerMessage _ = putStrLn $ show msg
 
 data Command = Command String String (State -> IO ()) 
 instance Show Command where