dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-04-05 04:36:03 +00:00
Code Issues Packages Projects Releases Wiki Activity

cli: decouple key reading from processing via TQueue

Browse Source
This commit is contained in:
shum
2026-04-01 14:40:21 +00:00
committed by Dev
parent e0770dce13
commit 0eb24ec374
2 changed files with 16 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/Simplex/Chat/Terminal.hs
View File

@@ -8,6 +8,7 @@
module Simplex.Chat.Terminal where
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import qualified Data.List.NonEmpty as L
import Simplex.Chat (defaultChatConfig)
import Simplex.Chat.Controller
@@ -22,6 +23,8 @@ import Simplex.Chat.Terminal.Output
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
import Simplex.Messaging.Client (NetworkConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig)
import Simplex.Messaging.Util (raceAny_)
import System.Terminal (Key, Modifiers)
import UnliftIO.STM
#if !defined(dbPostgres)
import Control.Exception (handle, throwIO)
import qualified Data.ByteArray as BA
@@ -97,4 +100,9 @@ simplexChatTerminal cfg options t = run options
#endif
runChatTerminal :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
runChatTerminal ct cc opts = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc opts, runInputLoop ct cc]
runChatTerminal ct cc opts = do
keyQ <- newTQueueIO
raceAny_ [runKeyReader ct keyQ, runTerminalInput ct cc keyQ, runTerminalOutput ct cc opts, runInputLoop ct cc]
runKeyReader :: ChatTerminal -> TQueue (Key, Modifiers) -> IO ()
runKeyReader ct q = withChatTerm ct $ forever $ getKey >>= liftIO . atomically . writeTQueue q

14
src/Simplex/Chat/Terminal/Input.hs
View File

@@ -151,14 +151,14 @@ sendUpdatedLiveMessage cc sentMsg LiveMessage {chatName, chatItemId} live = do
let cmd = UpdateLiveMessage chatName chatItemId live $ T.pack sentMsg
execChatCommand' cmd 0 `runReaderT` cc
runTerminalInput :: ChatTerminal -> ChatController -> IO ()
runTerminalInput ct cc = withChatTerm ct $ do
updateInput ct
receiveFromTTY cc ct
runTerminalInput :: ChatTerminal -> ChatController -> TQueue (Key, Modifiers) -> IO ()
runTerminalInput ct cc keyQ = do
updateInputView ct
receiveFromTTY keyQ cc ct
receiveFromTTY :: forall m. MonadTerminal m => ChatController -> ChatTerminal -> m ()
receiveFromTTY cc@ChatController {inputQ, currentUser, currentRemoteHost, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState, activeTo} =
forever $ getKey >>= liftIO . processKey >> withTermLock ct (updateInput ct)
receiveFromTTY :: TQueue (Key, Modifiers) -> ChatController -> ChatTerminal -> IO ()
receiveFromTTY keyQ cc@ChatController {inputQ, currentUser, currentRemoteHost, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState, activeTo} =
forever $ atomically (readTQueue keyQ) >>= processKey >> updateInputView ct
where
processKey :: (Key, Modifiers) -> IO ()
processKey key = case key of