summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--HsBot/Base.hs4
-rw-r--r--HsBot/Base/State.hs1
-rw-r--r--HsBot/Callbacks.hs20
-rw-r--r--HsBot/Callbacks/Dummy.hs8
-rw-r--r--HsBot/Callbacks/MessageCounter.hs12
-rw-r--r--HsBot/IRC.hs5
-rw-r--r--HsBot/IRC/User.hs27
-rw-r--r--HsBot/Logics.hs18
-rw-r--r--HsBot/Logics/Dummy.hs10
-rw-r--r--hsbot.db2
10 files changed, 74 insertions, 33 deletions
diff --git a/HsBot/Base.hs b/HsBot/Base.hs
index f2b1139..8f6d099 100644
--- a/HsBot/Base.hs
+++ b/HsBot/Base.hs
@@ -8,7 +8,7 @@ import HsBot.Base.Env
import HsBot.Base.State
import HsBot.General.Tools
import HsBot.IRC
-import HsBot.Logics
+import HsBot.Callbacks
startBase :: IO ()
startBase = do
@@ -27,7 +27,7 @@ dispatch msg sendMessage env@(Env state conf) = dispatch' msg
cmdAction state
return (env)
Nothing -> return (env)
- dispatch' _ = logicsRun msg sendMessage env
+ dispatch' _ = callbacksRun msg sendMessage env
commands = [
Cmd "!h" "Prints help" printHelp,
Cmd "!i" "Prints infos" printInfos,
diff --git a/HsBot/Base/State.hs b/HsBot/Base/State.hs
index 6d4efdc..c4c361a 100644
--- a/HsBot/Base/State.hs
+++ b/HsBot/Base/State.hs
@@ -7,6 +7,7 @@ import HsBot.IRC.User
data State = State {
isReady :: Bool,
+ currentSender :: String,
currentChannel :: String,
line :: String,
users :: [User]
diff --git a/HsBot/Callbacks.hs b/HsBot/Callbacks.hs
new file mode 100644
index 0000000..d15d89b
--- /dev/null
+++ b/HsBot/Callbacks.hs
@@ -0,0 +1,20 @@
+module HsBot.Callbacks (callbacksRun) where
+
+import HsBot.Base.Env
+import HsBot.Base.State
+
+import HsBot.Callbacks.Dummy
+import HsBot.Callbacks.MessageCounter
+
+registeredCallbacks = [dummy, messageCounter]
+
+callbacksRun :: String -> SendMessage -> Env -> IO Env
+callbacksRun str sendMessage env@(Env state _)
+ | isReady state = callbackAll registeredCallbacks env
+ | otherwise = do { putStrLn str; return (env) }
+ where
+ callbackAll [] env = return (env)
+ callbackAll (callback:restCallbacks) env = do
+ env' <- callback str sendMessage env
+ callbackAll restCallbacks env'
+
diff --git a/HsBot/Callbacks/Dummy.hs b/HsBot/Callbacks/Dummy.hs
new file mode 100644
index 0000000..071a9f4
--- /dev/null
+++ b/HsBot/Callbacks/Dummy.hs
@@ -0,0 +1,8 @@
+module HsBot.Callbacks.Dummy (dummy) where
+
+import HsBot.Base.Env
+import HsBot.Base.State
+
+dummy :: String -> SendMessage -> Env -> IO Env
+dummy str sendMessage env@(Env state _) = return (env)
+
diff --git a/HsBot/Callbacks/MessageCounter.hs b/HsBot/Callbacks/MessageCounter.hs
new file mode 100644
index 0000000..e4f8f3d
--- /dev/null
+++ b/HsBot/Callbacks/MessageCounter.hs
@@ -0,0 +1,12 @@
+module HsBot.Callbacks.MessageCounter (messageCounter) where
+
+import HsBot.Base.Env
+import HsBot.Base.State
+
+import HsBot.IRC.User
+
+messageCounter :: String -> SendMessage -> Env -> IO Env
+messageCounter str sendMessage (Env state conf) = do
+ let (user, users') = userGet (currentSender state) (users state)
+ return (Env state { users = users' } conf)
+
diff --git a/HsBot/IRC.hs b/HsBot/IRC.hs
index da488ea..c0382cc 100644
--- a/HsBot/IRC.hs
+++ b/HsBot/IRC.hs
@@ -88,9 +88,12 @@ ircEval h msg env@(DispatchEnv state conf dispatch) = ircEval' (clean msg)
where
ircEval' "+x" = do
ircWrite h "JOIN" (currentChannel state)
+ return (env)
+ ircEval' "End of /NAMES list." =
return (DispatchEnv state { isReady = True } conf dispatch)
ircEval' cleanMsg = do
- (Env s c) <- dispatch cleanMsg sendReplyMsg (castEnv env)
+ let env' = (Env state { currentSender = from msg } conf)
+ (Env s c) <- dispatch cleanMsg sendReplyMsg env'
return (DispatchEnv s c dispatch)
sendReplyMsg = ircPrivMsg h msg (castEnv env)
diff --git a/HsBot/IRC/User.hs b/HsBot/IRC/User.hs
index 422f910..375e55e 100644
--- a/HsBot/IRC/User.hs
+++ b/HsBot/IRC/User.hs
@@ -6,9 +6,18 @@ import HsBot.General.Render
data User = User {
userName :: String,
+ userMessages :: Int,
userPts :: Int
} deriving (Show, Read)
+userMakeDefault :: String -> User
+userMakeDefault name =
+ User {
+ userName = name,
+ userMessages = 0,
+ userPts = 0
+ }
+
instance Eq User where
x == y = (userPts x) == (userPts y)
@@ -20,8 +29,24 @@ instance Ord User where
instance Render User where
render user = userName user ++ ": " ++
- (show $ userPts user) ++ "pts"
+ (show $ userPts user) ++ "pts; " ++
+ (show $ userMessages user) ++ "msgs"
userEquals :: User -> User -> Bool
userEquals x y = (userName x) == (userName y)
+userGetIfExists :: String -> [User] -> Maybe User
+userGetIfExists name [] = Nothing
+userGetIfExists name (x:xs)
+ | userName x == name = Just x
+ | otherwise = userGetIfExists name xs
+
+userGet :: String -> [User] -> (User, [User])
+userGet name xs =
+ case userGetIfExists name xs of
+ Just user -> (user, xs)
+ Nothing -> let user = userMakeDefault name in (user, user : xs)
+
+
+
+
diff --git a/HsBot/Logics.hs b/HsBot/Logics.hs
deleted file mode 100644
index e66a238..0000000
--- a/HsBot/Logics.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module HsBot.Callbacks (logicsRun) where
-
-import HsBot.Base.Env
-import HsBot.Base.State
-import HsBot.Callbacks.Dummy
-
-registeredCallbacks = [dummyRun]
-
-logicsRun :: String -> SendMessage -> Env -> IO Env
-logicsRun str sendMessage env@(Env state _)
- | isReady state = logicsRun' registeredCallbacks env
- | otherwise = do { putStrLn str; return (env) }
- where
- logicsRun' [] env = return (env)
- logicsRun' (logic:rest) env = do
- env' <- logic str sendMessage env
- logicsRun' rest env'
-
diff --git a/HsBot/Logics/Dummy.hs b/HsBot/Logics/Dummy.hs
deleted file mode 100644
index edc8056..0000000
--- a/HsBot/Logics/Dummy.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module HsBot.Callbacks.Dummy (dummyRun) where
-
-import HsBot.Base.Env
-import HsBot.Base.State
-
-dummyRun :: String -> SendMessage -> Env -> IO Env
-dummyRun str sendMessage env@(Env state _) = do
- putStrLn $ "::::" ++ str
- return (env)
-
diff --git a/hsbot.db b/hsbot.db
index 9fc7b2e..55934e8 100644
--- a/hsbot.db
+++ b/hsbot.db
@@ -1 +1 @@
-State {isReady = True, currentChannel = "#buetow.org", line = "!w\DELs", 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}]} \ No newline at end of file
+State {isReady = False, currentSender = "", currentChannel = "#buetow.org", line = "!w\DELs", users = []}
generated by cgit v1.2.3 (git 2.25.1) at 2026-06-08 04:23:33 +0000