Command to mark messages as seen

Changelog: Added `/seen` command to mark messages as seen.

6 files changed, 26 insertions, 3 deletions

diff --git a/README.md b/README.md
index a84a3aa..912640b 100644
--- a/README.md
+++ b/README.md
@@ -95,12 +95,12 @@ Test chatroom [19:03] Some Name: Hi
 `/conversations`  
 : List started conversations with contacts or other peers.
 
-`/new`
+`/new`  
 : List conversations with new (unread) messages.
 
 `/<number>`  
 : Select conversation, contact or peer `<number>` based on the last
-  `/conversations`, `/contacts` or `/peers` output list.
+  `/conversations`, `/contacts`, `/peers` or `/new` output list.
 
 `<message>`  
 : Send `<message>` to selected conversation.
@@ -113,6 +113,9 @@ Test chatroom [19:03] Some Name: Hi
 : Show information about the selected conversations, contact or peer; or the
   one identified by `<number>` if given.
 
+`/seen`  
+: Mark all messages in the current conversation as seen.
+
 ### Chatrooms
 
 Currently only public unmoderated chatrooms are supported, which means that any
diff --git a/main/Main.hs b/main/Main.hs
index 8d7cc08..4b09d3d 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -385,7 +385,9 @@ interactiveLoop st opts = withTerminal commandCompletion $ \term -> do
                 Right prompt -> return prompt
             lift $ setPrompt term $ plainText $ T.pack prompt
             join $ lift $ getInputLine term $ \case
-                Just input@('/' : _) -> KeepPrompt $ return input
+                Just input@('/' : _)
+                    | "/seen" : _ <- words input -> ErasePrompt $ return input
+                    | otherwise -> KeepPrompt $ return input
                 Just input -> ErasePrompt $ case reverse input of
                     _ | all isSpace input -> getInputLinesTui eprompt
                     '\\':rest -> (reverse ('\n':rest) ++) <$> getInputLinesTui (Right ">> ")
@@ -711,6 +713,7 @@ commands =
     , ( "invite-accept", cmdInviteAccept )
     , ( "conversations", cmdConversations )
     , ( "new", cmdNew )
+    , ( "seen", cmdSeen )
     , ( "details", cmdDetails )
     , ( "discovery", cmdDiscovery )
     , ( "join", cmdJoin )
@@ -1113,6 +1116,9 @@ cmdNew = do
         = Just ( conv, msg )
     checkNew _ = Nothing
 
+cmdSeen :: Command
+cmdSeen = markAllSeen =<< getSelectedConversation
+
 
 cmdDetails :: Command
 cmdDetails = do
diff --git a/src/Erebos/Chatroom.hs b/src/Erebos/Chatroom.hs
index aa5e3ee..fce8b1d 100644
--- a/src/Erebos/Chatroom.hs
+++ b/src/Erebos/Chatroom.hs
@@ -72,6 +72,8 @@ instance ConversationType ChatroomState ChatMessage where
     convMessageListSince mbSince cstate = ( 0, ) $
         map (, False) $ threadToListSince (maybe [] roomStateMessageData mbSince) (roomStateMessageData cstate)
 
+    convMarkAllSeen _ = return ()
+
 
 data ChatroomData = ChatroomData
     { rdPrev :: [Stored (Signed ChatroomData)]
diff --git a/src/Erebos/Conversation.hs b/src/Erebos/Conversation.hs
index 1d72f41..472195c 100644
--- a/src/Erebos/Conversation.hs
+++ b/src/Erebos/Conversation.hs
@@ -26,6 +26,7 @@ module Erebos.Conversation (
 
     sendMessage,
     deleteConversation,
+    markAllSeen,
 ) where
 
 import Control.Monad.Except
@@ -141,3 +142,6 @@ sendMessage (ChatroomConversation rstate) text = sendChatroomMessage rstate text
 deleteConversation :: (MonadHead LocalState m, MonadError e m, FromErebosError e) => Conversation -> m ()
 deleteConversation (DirectMessageConversation _) = throwOtherError "deleting direct message conversation is not supported"
 deleteConversation (ChatroomConversation rstate) = deleteChatroomByStateData (head $ roomStateData rstate)
+
+markAllSeen :: (MonadHead LocalState m, MonadError e m, FromErebosError e) => Conversation -> m ()
+markAllSeen = withConversation convMarkAllSeen
diff --git a/src/Erebos/Conversation/Class.hs b/src/Erebos/Conversation/Class.hs
index 96a0e6a..d7bac5d 100644
--- a/src/Erebos/Conversation/Class.hs
+++ b/src/Erebos/Conversation/Class.hs
@@ -3,12 +3,16 @@ module Erebos.Conversation.Class (
     RefDigest,
 ) where
 
+import Control.Monad.Except
+
 import Data.Text (Text)
 import Data.Time.LocalTime
 import Data.Typeable
 
+import Erebos.Error
 import Erebos.Identity
 import Erebos.Object
+import Erebos.State
 
 
 class (Typeable conv, Typeable msg) => ConversationType conv msg | conv -> msg, msg -> conv where
@@ -21,3 +25,5 @@ class (Typeable conv, Typeable msg) => ConversationType conv msg | conv -> msg,
         :: Maybe conv -- ^ Original state to diff from
         -> conv       -- ^ Current state
         -> ( Int, [ ( msg, Bool ) ] ) -- ^ Number of removed, list of added messages
+
+    convMarkAllSeen :: (MonadHead LocalState m, MonadError e m, FromErebosError e) => conv -> m ()
diff --git a/src/Erebos/DirectMessage.hs b/src/Erebos/DirectMessage.hs
index 62a25a2..2108587 100644
--- a/src/Erebos/DirectMessage.hs
+++ b/src/Erebos/DirectMessage.hs
@@ -58,6 +58,8 @@ instance ConversationType DirectMessageThread DirectMessage where
     convMessageListSince Nothing      thread = ( 0, ) $ dmThreadToListUnread thread
     convMessageListSince (Just since) thread = dmThreadToListChange since thread
 
+    convMarkAllSeen DirectMessageThread {..} = dmMarkAsSeen msgPeer
+
 
 data DirectMessage = DirectMessage
     { msgFrom :: ComposedIdentity