From d8e2b580d7569e2a3d6d775515582be898ee265f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 10 Aug 2024 21:52:06 +0200
Subject: Chatroom members and join/leave commands
---
main/Main.hs | 25 +++++++++++++++++++++++--
main/Test.hs | 24 ++++++++++++++++++++++++
2 files changed, 47 insertions(+), 2 deletions(-)
(limited to 'main')
diff --git a/main/Main.hs b/main/Main.hs
index e7615ed..94c0418 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -452,6 +452,11 @@ getSelectedPeer = gets csContext >>= \case
SelectedPeer peer -> return peer
_ -> throwError "no peer selected"
+getSelectedChatroom :: CommandM ChatroomState
+getSelectedChatroom = gets csContext >>= \case
+ SelectedChatroom rstate -> return rstate
+ _ -> throwError "no chatroom selected"
+
getSelectedConversation :: CommandM Conversation
getSelectedConversation = gets csContext >>= \case
SelectedPeer peer -> peerIdentity peer >>= \case
@@ -496,6 +501,9 @@ commands =
, ("ice-connect", cmdIceConnect)
, ("ice-send", cmdIceSend)
#endif
+ , ("join", cmdJoin)
+ , ("leave", cmdLeave)
+ , ("members", cmdMembers)
, ("select", cmdSelectContext)
, ("quit", cmdQuit)
]
@@ -548,6 +556,19 @@ showPeer pidentity paddr =
PeerIdentityFull pid -> T.unpack $ displayIdentity pid
in name ++ " [" ++ show paddr ++ "]"
+cmdJoin :: Command
+cmdJoin = joinChatroom =<< getSelectedChatroom
+
+cmdLeave :: Command
+cmdLeave = leaveChatroom =<< getSelectedChatroom
+
+cmdMembers :: Command
+cmdMembers = do
+ Just room <- findChatroomByStateData . head . roomStateData =<< getSelectedChatroom
+ forM_ (chatroomMembers room) $ \x -> do
+ liftIO $ putStrLn $ maybe "<unnamed>" T.unpack $ idName x
+
+
cmdSelectContext :: Command
cmdSelectContext = do
n <- read <$> asks ciLine
@@ -653,8 +674,8 @@ watchChatroomsForCli eprint h chatroomSetVar contextVar autoSubscribe = do
[ maybe "<unnamed>" T.unpack $ roomName =<< cmsgRoom msg
, formatTime defaultTimeLocale " [%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ cmsgTime msg
, maybe "<unnamed>" T.unpack $ idName $ cmsgFrom msg
- , ": "
- , maybe "<no message>" T.unpack $ cmsgText msg
+ , if cmsgLeave msg then " left" else ""
+ , maybe (if cmsgLeave msg then "" else " joined") ((": " ++) . T.unpack) $ cmsgText msg
]
modifyMVar_ subscribedNumVar $ return
. (if roomStateSubscribe rstate then (+ 1) else id)
diff --git a/main/Test.hs b/main/Test.hs
index 6e10b54..c6448b8 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -283,6 +283,9 @@ commands = map (T.pack *** id)
, ("chatroom-set-name", cmdChatroomSetName)
, ("chatroom-subscribe", cmdChatroomSubscribe)
, ("chatroom-unsubscribe", cmdChatroomUnsubscribe)
+ , ("chatroom-members", cmdChatroomMembers)
+ , ("chatroom-join", cmdChatroomJoin)
+ , ("chatroom-leave", cmdChatroomLeave)
, ("chatroom-message-send", cmdChatroomMessageSend)
]
@@ -732,6 +735,7 @@ cmdChatroomWatchLocal = do
, [ show . refDigest . storedRef . head . filterAncestors . concatMap storedRoots . toComponents $ room ]
, [ "room", maybe "<unnamed>" T.unpack $ roomName =<< cmsgRoom msg ]
, [ "from", maybe "<unnamed>" T.unpack $ idName $ cmsgFrom msg ]
+ , if cmsgLeave msg then [ "leave" ] else []
, maybe [] (("text":) . (:[]) . T.unpack) $ cmsgText msg
]
@@ -754,6 +758,26 @@ cmdChatroomUnsubscribe = do
to <- getChatroomStateData cid
void $ chatroomSetSubscribe to False
+cmdChatroomMembers :: Command
+cmdChatroomMembers = do
+ [ cid ] <- asks tiParams
+ Just chatroom <- findChatroomByStateData =<< getChatroomStateData cid
+ forM_ (chatroomMembers chatroom) $ \user -> do
+ cmdOut $ unwords [ "chatroom-members-item", maybe "<unnamed>" T.unpack $ idName user ]
+ cmdOut "chatroom-members-done"
+
+cmdChatroomJoin :: Command
+cmdChatroomJoin = do
+ [ cid ] <- asks tiParams
+ joinChatroomByStateData =<< getChatroomStateData cid
+ cmdOut "chatroom-join-done"
+
+cmdChatroomLeave :: Command
+cmdChatroomLeave = do
+ [ cid ] <- asks tiParams
+ leaveChatroomByStateData =<< getChatroomStateData cid
+ cmdOut "chatroom-leave-done"
+
cmdChatroomMessageSend :: Command
cmdChatroomMessageSend = do
[cid, msg] <- asks tiParams
--
cgit v1.2.3