Deleting chatrooms

Changelog: Added `/delete` command to delete chatrooms for current user

2 files changed, 16 insertions, 2 deletions

diff --git a/main/Main.hs b/main/Main.hs
index c9c9156..8a4729f 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -501,6 +501,7 @@ commands =
     , ("peer-add-public", cmdPeerAddPublic)
     , ("peer-drop", cmdPeerDrop)
     , ("send", cmdSend)
+    , ("delete", cmdDelete)
     , ("update-identity", cmdUpdateIdentity)
     , ("attach", cmdAttach)
     , ("attach-accept", cmdAttachAccept)
@@ -632,6 +633,11 @@ cmdSend = void $ do
             liftIO $ putStrLn $ formatMessage tzone msg
         Nothing -> return ()
 
+cmdDelete :: Command
+cmdDelete = void $ do
+    deleteConversation =<< getSelectedConversation
+    modify $ \s -> s { csContext = NoContext }
+
 cmdHistory :: Command
 cmdHistory = void $ do
     conv <- getSelectedConversation
@@ -678,7 +684,7 @@ watchChatroomsForCli eprint h chatroomSetVar contextVar autoSubscribe = do
 
     watchChatrooms h $ \set -> \case
         Nothing -> do
-            let chatroomList = fromSetBy (comparing roomStateData) set
+            let chatroomList = filter (not . roomStateDeleted) $ fromSetBy (comparing roomStateData) set
                 (subscribed, notSubscribed) = partition roomStateSubscribe chatroomList
                 subscribedNum = length subscribed
 
@@ -738,7 +744,7 @@ cmdChatrooms :: Command
 cmdChatrooms = do
     ensureWatchedChatrooms
     chatroomSetVar <- asks ciChatroomSetVar
-    chatroomList <- fromSetBy (comparing roomStateData) <$> liftIO (readMVar chatroomSetVar)
+    chatroomList <- filter (not . roomStateDeleted) . fromSetBy (comparing roomStateData) <$> liftIO (readMVar chatroomSetVar)
     set <- asks ciSetContextOptions
     set $ map SelectedChatroom chatroomList
     forM_ (zip [1..] chatroomList) $ \(i :: Int, rstate) -> do
diff --git a/main/Test.hs b/main/Test.hs
index 183ed51..0181575 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -287,6 +287,7 @@ commands = map (T.pack *** id)
     , ("dm-list-peer", cmdDmListPeer)
     , ("dm-list-contact", cmdDmListContact)
     , ("chatroom-create", cmdChatroomCreate)
+    , ("chatroom-delete", cmdChatroomDelete)
     , ("chatroom-list-local", cmdChatroomListLocal)
     , ("chatroom-watch-local", cmdChatroomWatchLocal)
     , ("chatroom-set-name", cmdChatroomSetName)
@@ -764,6 +765,13 @@ cmdChatroomCreate = do
     room <- createChatroom (Just name) Nothing
     cmdOut $ unwords $ "chatroom-create-done" : chatroomInfo room
 
+cmdChatroomDelete :: Command
+cmdChatroomDelete = do
+    [ cid ] <- asks tiParams
+    sdata <- getChatroomStateData cid
+    deleteChatroomByStateData sdata
+    cmdOut $ unwords [ "chatroom-delete-done", T.unpack cid ]
+
 getChatroomStateData :: Text -> CommandM (Stored ChatroomStateData)
 getChatroomStateData tref = do
     st <- asks tiStorage