1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
-- Karmabot By Paul C. Buetow
module Main (main) where
import IO
import System
-- Start configuration
version :: String
version = "0.0"
prompt :: String
prompt = "$ "
-- End configuration
putPrompt :: IO ()
putPrompt = putStr prompt
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 { line :: String, loggs :: [String], maxLoggs :: Int, users :: [User], karmas :: [Karma] } deriving (Show, Read)
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) ++ "%)"
makeTestConf :: Conf
makeTestConf = Conf {
line = "",
loggs = [],
maxLoggs = 10,
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 = makeTestConf
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' }
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
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)
matches :: String -> String -> Maybe (String, String)
matches search string = m' "" search string
where m' pred [] string = Just (init . init $ reverse pred, string)
m' pred matches [] = Nothing
m' pred (m:matches) (s:string)
| m == s = m' (s:pred) matches string
| otherwise = m' (s:pred) search string
processInput :: Conf -> Conf
processInput conf = loggMessage "foo" conf
where plus = matches "++" (line conf)
minus = matches "--" (line conf)
help :: IO ()
help = do
putStrLn "!h - Print help"
putStrLn "!l - Print loggs"
putStrLn "!p - Print current configuration"
putStrLn "!q - Quit"
loop :: Conf -> IO ()
loop conf = do
putPrompt
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 } }
main :: IO ()
main = do
putStrLn $ "Welcome to " ++ version
loop makeConf
|
