diff options
| -rw-r--r-- | COPYING | 26 | ||||
| -rw-r--r-- | Main.hs | 157 | ||||
| -rw-r--r-- | Makefile | 6 |
3 files changed, 189 insertions, 0 deletions
@@ -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. @@ -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 + |