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

3 files changed, 74 insertions, 27 deletions

diff --git a/HsBot.hs b/HsBot.hs
index 7e25de7..d779c0d 100644
--- a/HsBot.hs
+++ b/HsBot.hs
@@ -1,4 +1,4 @@
--- Karmabot By Paul C. Buetow
+-- HsBot - The Karmabot By Paul Buetow
 
 --module Main (main,matches) where
 module Main where
@@ -11,11 +11,19 @@ import System
 version :: String
 version = "0.0"
 
+database :: String
+database = "hsbot.db"
+
 -- End configuration
 
-data Karma = Karma { karmaName :: String, minPts :: Int, minPerc :: Float } deriving (Show, Read)
+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 Eq Karma where 
+   x == y = (minPerc x) == (minPerc y) && (minPts x == minPts y)
 
 instance Ord Karma where
 	x > y	| (minPerc x) > (minPerc y) = True
@@ -25,11 +33,21 @@ instance Ord Karma where
 	x >= y	= not (x < y)
 	x <= y	= not (x > y)
 
-data Conf = Conf { line :: String, loggs :: [String], maxLoggs :: Int, users :: [User], karmas :: [Karma] } deriving (Show, Read)
+data Conf = Conf { 
+      line :: String, 
+      loggs :: [String], 
+      maxLoggs :: Int, 
+      users :: [User], 
+      karmas :: [Karma] } 
+   deriving (Show, Read)
 
-data User = User { userName :: String, userPts :: Int } deriving (Show, Read) 
+data User = User { 
+      userName :: String,
+      userPts :: Int } 
+   deriving (Show, Read) 
 
-instance Eq User where x == y = (userPts x) == (userPts y)
+instance Eq User where 
+   x == y = (userPts x) == (userPts y)
 
 instance Ord User where
 	x < y = (userPts x) < (userPts y)
@@ -48,10 +66,11 @@ instance Render User where
 		(show $ userPerc user) ++ "%)"
 
 loggMessage :: String -> Conf -> Conf
-loggMessage message conf = let l = message : (loggs conf)
-                               l' | (length l) > (maxLoggs conf) = init l
-				  | otherwise = l
-			    in conf { loggs = l' } 
+loggMessage 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)
@@ -150,27 +169,50 @@ processInput conf = addAll --loggMessage "foo" conf
 	      plus = matches "++" (line conf)
 	      minus = matches "--" (line conf)
 
-help :: IO ()
-help = do
-	putStrLn "\t!h - Print help"
-	putStrLn "\t!l - Print loggs"
-	putStrLn "\t!p - Print current configuration"
-	putStrLn "\t!q - Quit"
-
-loop :: Conf -> IO ()
-loop conf = do
-	line <- getLine
-	case line of
-		"!h" -> do { help; loop conf }
-		"!l" -> do { printLoggs conf; loop conf }
-		"!p" -> do { putStrLn $ show conf; loop conf }
-		"!q" -> do { putStrLn "Good bye"; exitWith ExitSuccess }
-		_ -> do { putStrLn line; loop $ processInput $ conf { line = line } }
+loop :: IO Conf -> IO ()
+loop conf = 
+   let loop' :: Conf -> IO ()
+       loop' conf = do
+          line <- readInput
+          getLambda line conf
+       getCommand x = 
+         let command = [ (a, b, c) | (a, b, c) <- commands, a == x ]
+          in if length command == 0
+               then getCommand "!h"
+               else head command
+         where commands = [      
+          	("!h", "Prints help ", (\x -> do { printHelp commands; loop' x } ) ),
+          	("!l", "Prints loggs", (\x -> do { printLoggs x; loop' x } ) ),
+          	("!p", "Prints configuration", (\x -> do { putStrLn $ show x; loop' x } ) ),
+          	("!s", "Saves configuration", (\x -> do { putStrLn "Saving current xiguration"; save x; loop' x } ) ),
+          	("!q", "Quits", (\x -> do { putStrLn "Good bye"; exitWith ExitSuccess } ) )]
+       getLambda x = let (_, _, c) = getCommand x in c
+       getDescr x = let (_, b, _) = getCommand x in b
+       printHelp = putStr . foldr (++) "" . map (\(a,b,_) -> "\t" ++ a ++ " - " ++ b ++ "\n") 
+    in do conf' <- conf
+          loop' conf'
+
+-- Will be connected to IRC input in future instead of getLine
+readInput :: IO String
+readInput = getLine
 
 main :: IO ()	
 main = do
 	putStrLn $ "Welcome to " ++ version ++ " (Enter !h for help)"
-	loop makeConf
+	loop load
+
+save :: Conf -> IO ()
+save = writeFile database . show
+
+saveIO :: IO Conf -> IO ()
+saveIO conf = do
+   conf' <- conf
+   writeFile database (show conf')
+
+load :: IO Conf
+load = do
+   file <- readFile database
+   return ( read file :: Conf )
 
 makeTestConf :: Conf
 makeTestConf = Conf {
@@ -206,3 +248,6 @@ makeTestConf = Conf {
 makeConf :: Conf
 makeConf = makeTestConf
 
+makeIOConf :: IO Conf
+makeIOConf = return (makeConf)
+
diff --git a/hsbot.db b/hsbot.db
new file mode 100644
index 0000000..884103e
--- /dev/null
+++ b/hsbot.db
@@ -0,0 +1 @@
+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
diff --git a/hsbot.db.bak b/hsbot.db.bak
new file mode 100644
index 0000000..884103e
--- /dev/null
+++ b/hsbot.db.bak
@@ -0,0 +1 @@
+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