From 620e5840aba91d683bf7b4ee115079550aae8569 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 19 May 2024 21:37:46 +0200
Subject: Conversation interface

Changelog: Added `/conversations` command to list and select conversations
---
 main/Main.hs | 46 ++++++++++++++++++++++++++++------------------
 1 file changed, 28 insertions(+), 18 deletions(-)

(limited to 'main/Main.hs')

diff --git a/main/Main.hs b/main/Main.hs
index 0144564..22a7831 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -36,12 +36,13 @@ import System.IO
 
 import Erebos.Attach
 import Erebos.Contact
+import Erebos.Conversation
 #ifdef ENABLE_ICE_SUPPORT
 import Erebos.Discovery
 import Erebos.ICE
 #endif
 import Erebos.Identity
-import Erebos.Message
+import Erebos.Message hiding (formatMessage)
 import Erebos.Network
 import Erebos.PubKey
 import Erebos.Service
@@ -222,7 +223,7 @@ interactiveLoop st opts = runInputT inputSettings $ do
     _ <- liftIO $ do
         tzone <- getCurrentTimeZone
         watchReceivedMessages erebosHead $
-            extPrintLn . formatMessage tzone . fromStored
+            extPrintLn . formatDirectMessage tzone . fromStored
 
     server <- liftIO $ do
         startServer (optServer opts) erebosHead extPrintLn $
@@ -264,6 +265,7 @@ interactiveLoop st opts = runInputT inputSettings $ do
                             PeerIdentityRef wref _ -> "<" ++ BC.unpack (showRefDigest $ wrDigest wref) ++ ">"
                             PeerIdentityUnknown _  -> "<unknown>"
                         SelectedContact contact -> return $ T.unpack $ contactName contact
+                        SelectedConversation conv -> return $ T.unpack $ conversationName conv
             input <- getInputLines $ pname ++ "> "
             let (CommandM cmd, line) = case input of
                     '/':rest -> let (scmd, args) = dropWhile isSpace <$> span (\c -> isAlphaNum c || c == '-') rest
@@ -321,6 +323,7 @@ data CommandState = CommandState
 data CommandContext = NoContext
                     | SelectedPeer Peer
                     | SelectedContact Contact
+                    | SelectedConversation Conversation
 
 newtype CommandM a = CommandM (ReaderT CommandInput (StateT CommandState (ExceptT String IO)) a)
     deriving (Functor, Applicative, Monad, MonadReader CommandInput, MonadState CommandState, MonadError String)
@@ -353,15 +356,16 @@ getSelectedPeer = gets csContext >>= \case
     SelectedPeer peer -> return peer
     _ -> throwError "no peer selected"
 
-getSelectedIdentity :: CommandM ComposedIdentity
-getSelectedIdentity = gets csContext >>= \case
+getSelectedConversation :: CommandM Conversation
+getSelectedConversation = gets csContext >>= \case
     SelectedPeer peer -> peerIdentity peer >>= \case
-        PeerIdentityFull pid -> return $ toComposedIdentity pid
+        PeerIdentityFull pid -> directMessageConversation $ finalOwner pid
         _ -> throwError "incomplete peer identity"
     SelectedContact contact -> case contactIdentity contact of
-        Just cid -> return cid
+        Just cid -> directMessageConversation cid
         Nothing -> throwError "contact without erebos identity"
-    _ -> throwError "no contact or peer selected"
+    SelectedConversation conv -> reloadConversation conv
+    _ -> throwError "no contact, peer or conversation selected"
 
 commands :: [(String, Command)]
 commands =
@@ -377,6 +381,7 @@ commands =
     , ("contact-add", cmdContactAdd)
     , ("contact-accept", cmdContactAccept)
     , ("contact-reject", cmdContactReject)
+    , ("conversations", cmdConversations)
 #ifdef ENABLE_ICE_SUPPORT
     , ("discovery-init", cmdDiscoveryInit)
     , ("discovery", cmdDiscovery)
@@ -433,22 +438,19 @@ cmdSelectContext n = join (asks ciContextOptions) >>= \ctxs -> if
 cmdSend :: Command
 cmdSend = void $ do
     text <- asks ciLine
-    powner <- finalOwner <$> getSelectedIdentity
-    smsg <- sendDirectMessage powner $ T.pack text
+    conv <- getSelectedConversation
+    msg <- sendMessage conv $ T.pack text
     tzone <- liftIO $ getCurrentTimeZone
-    liftIO $ putStrLn $ formatMessage tzone $ fromStored smsg
+    liftIO $ putStrLn $ formatMessage tzone msg
 
 cmdHistory :: Command
 cmdHistory = void $ do
-    ehead <- gets csHead
-    powner <- finalOwner <$> getSelectedIdentity
-
-    case find (sameIdentity powner . msgPeer) $
-            toThreadList $ lookupSharedValue $ lsShared $ headObject ehead of
-        Just thread -> do
+    conv <- getSelectedConversation
+    case conversationHistory conv of
+        thread@(_:_) -> do
             tzone <- liftIO $ getCurrentTimeZone
-            liftIO $ mapM_ (putStrLn . formatMessage tzone) $ reverse $ take 50 $ threadToList thread
-        Nothing -> do
+            liftIO $ mapM_ (putStrLn . formatMessage tzone) $ reverse $ take 50 thread
+        [] -> do
             liftIO $ putStrLn $ "<empty history>"
 
 cmdUpdateIdentity :: Command
@@ -493,6 +495,14 @@ cmdContactAccept = contactAccept =<< getSelectedPeer
 cmdContactReject :: Command
 cmdContactReject = contactReject =<< getSelectedPeer
 
+cmdConversations :: Command
+cmdConversations = do
+    conversations <- lookupConversations
+    set <- asks ciSetContextOptions
+    set $ map SelectedConversation conversations
+    forM_ (zip [1..] conversations) $ \(i :: Int, conv) -> do
+        liftIO $ putStrLn $ "[" ++ show i ++ "] " ++ T.unpack (conversationName conv)
+
 #ifdef ENABLE_ICE_SUPPORT
 
 cmdDiscoveryInit :: Command
-- 
cgit v1.2.3