terminal: make input responsible for echo to keep commands synchronous (as in mobile) and avoid echo delays (#343)

* terminal: make input responsible for echo to keep commands synchronous (as in mobile) and avoid echo delays

* use echo

Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>

Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>

src/Simplex/Chat/Mobile.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 

src/Simplex/Chat/Terminal/Input.hs

@@ -5,15 +5,19 @@
 
 module Simplex.Chat.Terminal.Input where
 
-import Control.Monad.IO.Unlift
+import Control.Monad.Except
 import Control.Monad.Reader
+import qualified Data.ByteString.Char8 as B
+import Data.Char (isSpace)
 import Data.List (dropWhileEnd)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Simplex.Chat
 import Simplex.Chat.Controller
+import Simplex.Chat.Styled
 import Simplex.Chat.Terminal.Output
 import Simplex.Chat.View
+import Simplex.Messaging.Parsers (parseAll)
 import System.Exit (exitSuccess)
 import System.Terminal hiding (insertChars)
 import UnliftIO.STM
@@ -28,9 +32,23 @@ getKey =
 runInputLoop :: ChatTerminal -> ChatController -> IO ()
 runInputLoop ct cc = forever $ do
   s <- atomically . readTBQueue $ inputQ cc
-  r <- runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc
+  let bs = encodeUtf8 $ T.pack s
+      cmd = parseAll chatCommandP $ B.dropWhileEnd isSpace bs
+  unless (isMessage cmd) $ echo s
+  r <- runReaderT (execChatCommand bs) cc
+  case r of
+    CRChatCmdError _ -> when (isMessage cmd) $ echo s
+    _ -> pure ()
   let testV = testView $ config cc
-  printToTerminal ct $ responseToView s testV r
+  printToTerminal ct $ responseToView testV r
+  where
+    echo s = printToTerminal ct [plain s]
+    isMessage = \case
+      Right SendMessage {} -> True
+      Right SendGroupMessage {} -> True
+      Right SendFile {} -> True
+      Right SendGroupFile {} -> True
+      _ -> False
 
 runTerminalInput :: ChatTerminal -> ChatController -> IO ()
 runTerminalInput ct cc = withChatTerm ct $ do

src/Simplex/Chat/Terminal/Output.hs

@@ -76,7 +76,7 @@ runTerminalOutput :: ChatTerminal -> ChatController -> IO ()
 runTerminalOutput ct cc = do
   let testV = testView $ config cc
   forever $
-    atomically (readTBQueue $ outputQ cc) >>= printToTerminal ct . responseToView "" testV . snd
+    atomically (readTBQueue $ outputQ cc) >>= printToTerminal ct . responseToView testV . snd
 
 printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
 printToTerminal ct s =

src/Simplex/Chat/View.hs

@@ -30,58 +30,58 @@ import qualified Simplex.Messaging.Protocol as SMP
 import System.Console.ANSI.Types
 
 serializeChatResponse :: ChatResponse -> String
-serializeChatResponse = unlines . map unStyle . responseToView "" False
+serializeChatResponse = unlines . map unStyle . responseToView False
 
-responseToView :: String -> Bool -> ChatResponse -> [StyledString]
-responseToView cmd testView = \case
-  CRActiveUser User {profile} -> r $ viewUserProfile profile
-  CRChatStarted -> r ["chat started"]
-  CRApiChats chats -> r $ if testView then testViewChats chats else [sShow chats]
-  CRApiChat chat -> r $ if testView then testViewChat chat else [sShow chat]
+responseToView :: Bool -> ChatResponse -> [StyledString]
+responseToView testView = \case
+  CRActiveUser User {profile} -> viewUserProfile profile
+  CRChatStarted -> ["chat started"]
+  CRApiChats chats -> if testView then testViewChats chats else [sShow chats]
+  CRApiChat chat -> if testView then testViewChat chat else [sShow chat]
   CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item
   CRChatItemUpdated _ -> []
   CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr
-  CRCmdAccepted _ -> r []
-  CRCmdOk -> r ["ok"]
+  CRCmdAccepted _ -> []
+  CRCmdOk -> ["ok"]
   CRChatHelp section -> case section of
-    HSMain -> r chatHelpInfo
-    HSFiles -> r filesHelpInfo
-    HSGroups -> r groupsHelpInfo
-    HSMyAddress -> r myAddressHelpInfo
-    HSMarkdown -> r markdownInfo
-  CRWelcome user -> r $ chatWelcome user
-  CRContactsList cs -> r $ viewContactsList cs
-  CRUserContactLink cReqUri _ -> r $ connReqContact_ "Your chat address:" cReqUri
-  CRUserContactLinkUpdated _ autoAccept -> r ["auto_accept " <> if autoAccept then "on" else "off"]
-  CRContactRequestRejected UserContactRequest {localDisplayName = c} -> r [ttyContact c <> ": contact request rejected"]
-  CRGroupCreated g -> r $ viewGroupCreated g
-  CRGroupMembers g -> r $ viewGroupMembers g
-  CRGroupsList gs -> r $ viewGroupsList gs
-  CRSentGroupInvitation g c -> r ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
-  CRFileTransferStatus ftStatus -> r $ viewFileTransferStatus ftStatus
-  CRUserProfile p -> r $ viewUserProfile p
-  CRUserProfileNoChange -> r ["user profile did not change"]
-  CRVersionInfo _ -> r [plain versionStr, plain updateStr]
-  CRChatCmdError e -> r $ viewChatError e
-  CRInvitation cReq -> r' $ viewConnReqInvitation cReq
-  CRSentConfirmation -> r' ["confirmation sent!"]
-  CRSentInvitation -> r' ["connection request sent!"]
-  CRContactDeleted c -> r' [ttyContact' c <> ": contact is deleted"]
-  CRAcceptingContactRequest c -> r [ttyFullContact c <> ": accepting contact request..."]
-  CRContactAlreadyExists c -> r [ttyFullContact c <> ": contact already exists"]
-  CRContactRequestAlreadyAccepted c -> r' [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
-  CRUserContactLinkCreated cReq -> r' $ connReqContact_ "Your new chat address is created!" cReq
-  CRUserContactLinkDeleted -> r' viewUserContactLinkDeleted
-  CRUserAcceptedGroupSent _g -> r' [] -- [ttyGroup' g <> ": joining the group..."]
-  CRUserDeletedMember g m -> r' [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
-  CRLeftMemberUser g -> r' $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
-  CRGroupDeletedUser g -> r' [ttyGroup' g <> ": you deleted the group"]
+    HSMain -> chatHelpInfo
+    HSFiles -> filesHelpInfo
+    HSGroups -> groupsHelpInfo
+    HSMyAddress -> myAddressHelpInfo
+    HSMarkdown -> markdownInfo
+  CRWelcome user -> chatWelcome user
+  CRContactsList cs -> viewContactsList cs
+  CRUserContactLink cReqUri _ -> connReqContact_ "Your chat address:" cReqUri
+  CRUserContactLinkUpdated _ autoAccept -> ["auto_accept " <> if autoAccept then "on" else "off"]
+  CRContactRequestRejected UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"]
+  CRGroupCreated g -> viewGroupCreated g
+  CRGroupMembers g -> viewGroupMembers g
+  CRGroupsList gs -> viewGroupsList gs
+  CRSentGroupInvitation g c -> ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
+  CRFileTransferStatus ftStatus -> viewFileTransferStatus ftStatus
+  CRUserProfile p -> viewUserProfile p
+  CRUserProfileNoChange -> ["user profile did not change"]
+  CRVersionInfo _ -> [plain versionStr, plain updateStr]
+  CRChatCmdError e -> viewChatError e
+  CRInvitation cReq -> viewConnReqInvitation cReq
+  CRSentConfirmation -> ["confirmation sent!"]
+  CRSentInvitation -> ["connection request sent!"]
+  CRContactDeleted c -> [ttyContact' c <> ": contact is deleted"]
+  CRAcceptingContactRequest c -> [ttyFullContact c <> ": accepting contact request..."]
+  CRContactAlreadyExists c -> [ttyFullContact c <> ": contact already exists"]
+  CRContactRequestAlreadyAccepted c -> [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
+  CRUserContactLinkCreated cReq -> connReqContact_ "Your new chat address is created!" cReq
+  CRUserContactLinkDeleted -> viewUserContactLinkDeleted
+  CRUserAcceptedGroupSent _g -> [] -- [ttyGroup' g <> ": joining the group..."]
+  CRUserDeletedMember g m -> [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
+  CRLeftMemberUser g -> [ttyGroup' g <> ": you left the group"] <> groupPreserved g
+  CRGroupDeletedUser g -> [ttyGroup' g <> ": you deleted the group"]
   CRRcvFileAccepted RcvFileTransfer {fileId, senderDisplayName = c} filePath ->
-    r' ["saving file " <> sShow fileId <> " from " <> ttyContact c <> " to " <> plain filePath]
-  CRRcvFileAcceptedSndCancelled ft -> r' $ viewRcvFileSndCancelled ft
-  CRSndGroupFileCancelled fts -> r' $ viewSndGroupFileCancelled fts
-  CRRcvFileCancelled ft -> r' $ receivingFile_ "cancelled" ft
-  CRUserProfileUpdated p p' -> r' $ viewUserProfileUpdated p p'
+    ["saving file " <> sShow fileId <> " from " <> ttyContact c <> " to " <> plain filePath]
+  CRRcvFileAcceptedSndCancelled ft -> viewRcvFileSndCancelled ft
+  CRSndGroupFileCancelled fts -> viewSndGroupFileCancelled fts
+  CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft
+  CRUserProfileUpdated p p' -> viewUserProfileUpdated p p'
   CRContactUpdated c c' -> viewContactUpdated c c'
   CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt
   CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
@@ -123,10 +123,6 @@ responseToView cmd testView = \case
   CRMessageError prefix err -> [plain prefix <> ": " <> plain err]
   CRChatError e -> viewChatError e
   where
-    r = (plain cmd :)
-    -- this function should be `r` for "synchronous", `id` for "asynchronous" command responses
-    r' = r
-    -- r' = id
     testViewChats :: [AChat] -> [StyledString]
     testViewChats chats = [sShow $ map toChatView chats]
       where

tests/ChatTests.hs

@@ -744,7 +744,6 @@ testUserContactLinkAutoAccept =
 
       cath ##> ("/c " <> cLink)
       cath <## "connection request sent!"
-      alice <## ""
       alice <## "cath (Catherine): accepting contact request..."
       concurrently_
         (cath <## "alice (Alice): contact is connected")