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

3 files changed, 189 insertions, 0 deletions

diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..60035b6
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,26 @@
+SLoad (http://sload.buetow.org) is ...
+... Copyright (c) 2009 by Dipl.-Inf. (FH) Paul C. Buetow 
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of buetow.org nor the names of its contributors may 
+	  be used to endorse or promote products derived from this software 
+	  without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY Paul Buetow ``AS IS'' AND ANY EXPRESS OR 
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL Paul Buetow BE LIABLE FOR ANY DIRECT, 
+INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 
+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 
+IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..ab6ec7e
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,157 @@
+-- Karmabot By Paul C. Buetow
+
+module Main (main) where
+
+import Control.Monad (forM)
+import Control.Monad.State
+import IO
+import Monad
+import Random
+import System
+
+
+version :: String
+version = "0.0"
+
+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 Conf = Conf { users :: [User], karmas :: [Karma] } deriving (Show, Read)
+
+type StateTrans st = s -> (t, s)
+
+
+
+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) ++ "%)"
+
+makeDefaultConf :: Conf
+makeDefaultConf = Conf {
+	users = [
+		User "thunder" 100,
+		User "otto" 1,
+		User "rantanplan" 3,
+		User "rantanplan2" 3,
+		User "icefox2" 11,
+		User "icefox" 10,
+		User "foobar" 5,
+		User "foobar1" 5,
+		User "foobar2" 5,
+		User "foobar3" 5,
+		User "foobar4" 5,
+		User "foobar5" 5,
+		User "foobar6" 5,
+		User "openfire" 2
+	],
+	karmas = [
+		Karma "God" 20 90,
+		Karma "Guru" 10 80,
+		Karma "Nerd" 10 70, 
+		Karma "Expert" 5 60, 
+		Karma "Geek" 3 40,
+		Karma "Advanced" 0 20, 
+		Karma "Cool dude" 0 0 
+	] }
+
+makeConf :: Conf
+makeConf = makeDefaultConf
+
+numUsers :: Int
+numUsers = length $ users makeConf
+
+sortedUsers :: [User]
+sortedUsers = sort $ users makeConf
+
+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
+
+userPerc :: User -> Float
+userPerc user = 
+	let rank = userRank user
+	    userPerc' 
+		| rank == 1 = 100 -- 1st always has 100%
+		| rank == numUsers = 0 -- last 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 makeConf)
+		in karmaName $ cands !! 0 -- Best posible karma 
+			 
+sort :: (Ord a) => [a] -> [a]
+sort [] = []
+sort (x:xs) = sort (filter (>= x) xs) ++ [x] ++ sort (filter (< x) xs)
+
+readline :: IO ()
+readline = do
+	line <- getLine
+	case line of
+		"q" -> do { putStrLn "Good bye"; exitWith ExitSuccess }
+		_ -> putStrLn ""
+
+
+data MyType = MT Int Bool Char Int deriving Show
+
+{- Using the State monad, we can define a function that returns
+   a random value and updates the random generator state at
+   the same time.
+-}
+getAny :: (Random a) => State StdGen a
+getAny = do g      <- get
+            (x,g') <- return $ random g
+            put g'
+            return x
+
+-- similar to getAny, but it bounds the random value returned
+getOne :: (Random a) => (a,a) -> State StdGen a
+getOne bounds = do g      <- get
+                   (x,g') <- return $ randomR bounds g
+                   put g'
+                   return x
+
+{- Using the State monad with StdGen as the state, we can build
+   random complex types without manually threading the
+   random generator states through the code.
+-}   
+makeRandomValueST :: StdGen -> (MyType, StdGen)
+makeRandomValueST = runState (do n <- getOne (1,100)
+                                 b <- getAny
+                                 c <- getOne ('a','z')
+                                 m <- getOne (-n,n)
+                                 return (MT n b c m))
+
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..f84a83e
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,6 @@
+all:
+	ghc Main.hs -o karmabot
+
+test: all
+	./karmabot
+