diff options
Diffstat (limited to 'main')
| -rw-r--r-- | main/Main.hs | 25 | ||||
| -rw-r--r-- | main/Test.hs | 24 |
2 files changed, 47 insertions, 2 deletions
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 |