modularization

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

8 files changed, 185 insertions, 154 deletions

diff --git a/Conf.hs b/Conf.hs
new file mode 100644
index 0000000..b4b2477
--- /dev/null
+++ b/Conf.hs
@@ -0,0 +1,20 @@
+module Conf where
+
+import qualified Data.Map as M
+
+type Conf = M.Map String String
+
+makeConf = M.fromList 
+         [ ("name", "HsBot")
+         , ("version", "v0.0")
+         , ("database", "hsbot.db")
+         , ("maxMessageSize", "400")
+         , ("admin", "rantanplan")
+         , ("ircServer", "irc.german-elite.net")
+         , ("ircChannel", "#buetow.org")
+         , ("ircNick", "hotdog")
+         , ("ircPort", "6667")
+         ]
+
+get :: (Monad m) => String -> Conf -> m String
+get = M.lookup 
diff --git a/HsBot.hs b/HsBot.hs
index 00dc69b..eba9a75 100644
--- a/HsBot.hs
+++ b/HsBot.hs
@@ -1,7 +1,7 @@
 -- HsBot - The Karmabot By Paul Buetow
 
 --module Main (main,matches) where
-module Main where
+module HsBot where
 
 import IO
 import System
@@ -11,23 +11,25 @@ import Network
 import System.IO
 import Text.Printf
 
--- Static configurations
+import Tools
+import Conf
+import State
 
+-- Static stateigurations (will be moved to Conf.hs)
+
+name = "hsbot"
 version = "v0.0"
 database = "hsbot.db"
 maxMessageSize = 400
 adminsitrator = "rantanplan"
 
--- logfile :: String
--- logfile = "hsbot.log"
-
--- End of static configurations
+-- End of static stateigurations
 
 data Karma = Karma { 
       karmaName :: String, 
       minPts :: Int, 
-      minPerc :: Float } 
-   deriving (Show, Read)
+      minPerc :: Float
+   } deriving (Show, Read)
 
 instance Eq Karma where 
    x == y = (minPerc x) == (minPerc y) && (minPts x == minPts y)
@@ -40,33 +42,17 @@ instance Ord Karma where
 	x >= y	= not (x < y)
 	x <= y	= not (x > y)
 
-data IrcConnection = IrcConnection {
-      server :: String,
-      port :: Int,
-      channel :: String,
-      nick :: String 
-   } deriving (Show, Read)
-
-data IrcMessage = IrcMessage {
-      raw :: String,
-      from :: String,
-      clean :: String,
-      isQuery :: Bool
-   } deriving Show
-
-data Conf = Conf { 
-      irc :: IrcConnection,
+data State = State { 
+      channel :: String, 
       line :: String, 
-      loggs :: [String], 
-      maxLoggs :: Int, 
       users :: [User], 
       karmas :: [Karma] 
    } deriving (Show, Read)
 
 data User = User { 
       userName :: String,
-      userPts :: Int } 
-   deriving (Show, Read) 
+      userPts :: Int 
+   } deriving (Show, Read) 
 
 instance Eq User where 
    x == y = (userPts x) == (userPts y)
@@ -87,23 +73,11 @@ instance Render User where
 		(show $ userPts user) ++ "pts; " ++ 
 		(show $ userPerc user) ++ "%)"
 
-loggIrcMessage :: String -> Conf -> Conf
-loggIrcMessage message conf = 
-   let l = message : (loggs conf)
-       l' | (length l) > (maxLoggs conf) = init l
-		    | otherwise = l
-    in conf { loggs = l' } 
-
-printLoggs :: Conf -> IO ()
-printLoggs conf = printLoggs' $ reverse (loggs conf)
-	where printLoggs' [] = return ()
-	      printLoggs' (l:logg) = do { putStrLn l; printLoggs' logg }
-
 numUsers :: Int
-numUsers = length $ users makeConf
+numUsers = length $ users makeState
 
 sortedUsers :: [User]
-sortedUsers = sort $ users makeConf
+sortedUsers = sort $ users makeState
 
 userEquals :: User -> User -> Bool
 userEquals x y = (userName x) == (userName y)
@@ -114,7 +88,7 @@ userRank = userRank' 1 sortedUsers
 		| userEquals x user = rank
 		| otherwise = userRank' (rank+1) xs user
 
-getUser :: String -> Conf -> User
+getUser :: String -> State -> User
 getUser name = head . filter (\x -> userName x == name) . users
 
 userPerc :: User -> Float
@@ -131,33 +105,13 @@ userPerc user =
 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 makeConf)
+		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 }
 
-uniq :: (Eq a) => [a] -> [a]
-uniq list = 
-	let r = u' list 0                    
-            u' [] _ = []              
-  	    u' (x:list) n 
-		   | member x r n = u' list n 
-		   | otherwise = x:(u' list (n + 1))
-  	    member e list 0 = False
-  	    member y (x:list) n = x == y || member y list (n - 1)
-    in r
-
-split :: String -> Char -> [String]
-split [] delim = [""]
-split (c:cs) delim 
-      | c == delim = "" : rest
-   	| otherwise = (c : head rest) : tail rest
-   where rest = split cs delim
-
-empty :: String -> Bool
-empty str = length str == 0
-
 -- 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
@@ -179,66 +133,81 @@ matches search string = uniq $ case m' $ occ search string of
 	    m' (Just (a, b)) = ((extr extrL a) ++ (extr extrR b), b)
 	    m' Nothing = ([], [])
 
-processInput :: Conf -> Conf
-processInput conf = addAll --loggIrcMessage "foo" conf
+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 = conf { users = add (users conf)  }
-	      plus = matches "++" (line conf)
-	      minus = matches "--" (line conf)
+	      addAll = state { users = add (users state)  }
+	      plus = matches "++" (line state)
+	      minus = matches "--" (line state)
 
-data Command = Command String String (Conf -> IO ()) 
-
-instance Show Command where
-   show (Command a b _) = "\t" ++ a ++ " - " ++ b ++ "\n"
-
-main :: IO ()	
-main = do
-   let conf = load
-   conf' <- conf -- Extract Conf from the IO Monad 
-   connect conf'
-
-load :: IO Conf
+load :: IO State
 load = do
    file <- readFile database
-   return ( read file :: Conf )
+   return ( read file :: State )
 
-save :: Conf -> IO ()
+save :: State -> IO ()
 save = writeFile database . show
 
-saveIO :: IO Conf -> IO ()
-saveIO conf = do
-   conf' <- conf
-   writeFile database (show conf')
+saveIO :: IO State -> IO ()
+saveIO state = do
+   state' <- state
+   writeFile database (show state')
 
-makeIOConf :: IO Conf
-makeIOConf = return (makeConf)
+makeIOState :: IO State
+makeIOState = return (makeState)
 
-connect conf = do
-   let con = irc conf
-   h <- connectTo (server con) (PortNumber (fromIntegral (port con)))
-   hSetBuffering h NoBuffering
-   write h "NICK" (nick con)
-   write h "USER" ((nick con) ++ " 0 * :hsbot.haskell.eu")
-   listen h conf
+-- 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
 
 write :: Handle -> String -> String -> IO ()
 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)
+privmsg :: Handle -> IrcMessage -> State -> Conf -> String -> IO ()
+privmsg h msg state conf s = 
+      if isMultiline s then privmsg' (lines s) else privmsg' [s]
+   where
+      privmsg' [] = return ()
+      privmsg' (x:xs) =
+         let receiver = if (isQuery msg) then from msg else channel state
+          in if length x > maxMessageSize
+               then do write h "PRIVMSG" (receiver ++ " :" 
+                              ++ (take maxMessageSize x) ++ "...")
+                       write h "PRIVMSG" (receiver ++ " :" 
+                              ++ "...this message has been cut to " 
+                              ++ (show maxMessageSize) ++ " chars")
+                       privmsg' xs
+               else do write h "PRIVMSG" (receiver ++ " :" ++ x)
+                       privmsg' xs
+
+connect :: State -> Conf -> IO ()
+connect state conf = do
+   ircNick <- get "ircNick" conf
+   ircChannel <- get "ircChannel" conf
+   ircServer <- get "ircServer" conf
+   ircPort <- get "ircPort" conf
+   let state' = state { channel = ircChannel }
+   h <- connectTo ircServer (PortNumber (fromIntegral 6667))
+   hSetBuffering h NoBuffering
+   write h "NICK" ircNick
+   write h "USER" (ircNick ++ " 0 * :hsbot.haskell.eu")
+   listen h state' conf
 
-listen :: Handle -> Conf -> IO ()
-listen h conf = forever $ do
+listen :: Handle -> State -> Conf -> IO ()
+listen h state conf = forever $ do
       t <- hGetLine h
       let s = init t
       if ping s 
@@ -248,71 +217,56 @@ listen h conf = forever $ do
                   from = from s, 
                   clean = clean s, 
                   isQuery = isQuery s }
-               in eval h msg conf
+               in eval 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 == (nick $ irc conf)
-      ping x      = "PING :" `isPrefixOf` x
-      pong x      = write h "PONG" (':' : drop 6 x)
-
-eval :: Handle -> IrcMessage -> Conf-> IO ()
-eval h msg conf = 
+      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 = write h "PONG" (':' : drop 6 x)
+
+eval :: Handle -> IrcMessage -> State -> Conf -> IO ()
+eval h msg state conf = 
    case isCommand (clean msg) of
-      Just xs -> evalCommand h xs msg conf
+      Just xs -> dispatch h xs msg state conf
       Nothing -> evalServerMessage (clean msg)
    where
       isCommand ('!':xs) = Just xs
       isCommand _ = Nothing
-      evalServerMessage "+x" = write h "JOIN" (channel $ irc conf)
+      evalServerMessage "+x" = do
+            ircChannel <- get "ircChannel" conf
+            write h "JOIN" ircChannel
       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?") msg conf
-      | otherwise = dispatch h cmd msg conf
+data Command = Command String String (State -> IO ()) 
+instance Show Command where 
+   show (Command a b _) = a ++ " - " ++ b
 
-dispatch :: Handle -> String -> IrcMessage -> Conf-> IO ()
-dispatch h cmd msg conf = do
-   getLambda ("!" ++ cmd) conf -- Eval the specific lambda function of 'command'
+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" 
-               (\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; } ),
+               (\_ -> 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 { putStrLn "Good bye"; save x; exitWith ExitSuccess } ) 
+               (\x -> do { sendMessage "Good bye"; save x; exitWith ExitSuccess } ) 
             ]
-         printHelp = putStr . foldr (++) "" . map show
+         sendMessage = privmsg 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 "!h" -- If there is no such command print out the help
+                     then getCommand "!i" 
                      else head command
 
--- Will be removed some day:
-makeConf :: Conf
-makeConf = makeDefaultConf
-
-makeDefaultConf :: Conf
-makeDefaultConf = Conf {
-   irc = IrcConnection {
-      server = "",
-      port = 6667,
-      channel = [],
-      nick = ""
-   },
-	line = "",
-	loggs = [],
-	maxLoggs = 10,
-	users = [ ],
-	karmas = [ ]
-} 
diff --git a/IRC.hs b/IRC.hs
new file mode 100644
index 0000000..6897c71
--- /dev/null
+++ b/IRC.hs
@@ -0,0 +1,10 @@
+module IRC where
+
+import IO
+import System
+
+import List
+import Network
+import System.IO
+import Text.Printf
+
diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..f89ac3b
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,13 @@
+module Main where
+
+import HsBot
+import Conf
+
+main :: IO ()	
+main = do
+   let conf = load
+   conf' <- conf -- Extract Conf from the IO Monad 
+   connect conf' makeConf
+
+r = main
+
diff --git a/State.hs b/State.hs
new file mode 100644
index 0000000..6076901
--- /dev/null
+++ b/State.hs
@@ -0,0 +1,3 @@
+module State where
+
+
diff --git a/Tools.hs b/Tools.hs
new file mode 100644
index 0000000..e28d4f9
--- /dev/null
+++ b/Tools.hs
@@ -0,0 +1,32 @@
+module Tools where
+
+uniq :: (Eq a) => [a] -> [a]
+uniq list = 
+	let r = u' list 0                    
+            u' [] _ = []              
+  	    u' (x:list) n 
+		   | member x r n = u' list n 
+		   | otherwise = x:(u' list (n + 1))
+  	    member e list 0 = False
+  	    member y (x:list) n = x == y || member y list (n - 1)
+    in r
+
+split :: String -> Char -> [String]
+split [] delim = [""]
+split (c:cs) delim 
+      | c == delim = "" : rest
+   	| otherwise = (c : head rest) : tail rest
+   where rest = split cs delim
+
+empty :: String -> Bool
+empty str = length str == 0
+
+contains :: String -> Char -> Bool
+contains str char = takeWhile (/= char) str /= str
+
+isMultiline :: String -> Bool
+isMultiline str = contains str '\n'
+
+showL :: Show a => [a] -> [String]
+showL = map (\x -> show x ++ "\n")
+
diff --git a/hsbot.db b/hsbot.db
index 809dcea..1786071 100644
--- a/hsbot.db
+++ b/hsbot.db
@@ -1 +1 @@
-Conf {irc = IrcConnection {server = "irc.german-elite.net", port = 6667, channel = "#buetow.org", nick = "hsbot"}, line = "!w\DELs", loggs = [], maxLoggs = 10, 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 {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
diff --git a/hsbot.db.bak b/hsbot.db.bak
deleted file mode 100644
index 884103e..0000000
--- a/hsbot.db.bak
+++ /dev/null
@@ -1 +0,0 @@
-Conf {line = "!w\DELs", loggs = [], maxLoggs = 10, 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