From 4446a955b0a94020fd2f20418d07cf9b2e30f7fc Mon Sep 17 00:00:00 2001 From: pb Date: Mon, 23 Nov 2009 21:35:37 +0000 Subject: git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@2 9f8f72e9-4bf4-416e-b76e-7d4203597157 --- COPYING | 8 ++-- HsBot.hs | 157 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Main.hs | 157 --------------------------------------------------------------- Makefile | 4 +- 4 files changed, 163 insertions(+), 163 deletions(-) create mode 100644 HsBot.hs delete mode 100644 Main.hs diff --git a/COPYING b/COPYING index 60035b6..2049847 100644 --- a/COPYING +++ b/COPYING @@ -1,5 +1,5 @@ -SLoad (http://sload.buetow.org) is ... -... Copyright (c) 2009 by Dipl.-Inf. (FH) Paul C. Buetow +HsBot (http://hsbot.buetow.org) is ... +... Copyright (c) 2009 by Dipl.-Inform. (FH) Paul C. Buetow All rights reserved. Redistribution and use in source and binary forms, with or without @@ -10,8 +10,8 @@ modification, are permitted provided that the following conditions are met: 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. + 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 diff --git a/HsBot.hs b/HsBot.hs new file mode 100644 index 0000000..ab6ec7e --- /dev/null +++ b/HsBot.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/Main.hs b/Main.hs deleted file mode 100644 index ab6ec7e..0000000 --- a/Main.hs +++ /dev/null @@ -1,157 +0,0 @@ --- 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 index f84a83e..5cf710f 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ all: - ghc Main.hs -o karmabot + ghc HsBot.hs -o hsbot test: all - ./karmabot + ./hsbot -- cgit v1.2.3