blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: output messages and events while executing the CLI command passed via -e option (#3683)

Browse Source 
* core: output messages and events while executing the CLI command passed via -e option

* option

* add option
This commit is contained in:
Evgeny Poberezkin
2024-01-20 14:59:13 +00:00
committed by GitHub
parent 5aa4b7687e
commit c65a17fccb
6 changed files with 54 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files
apps/simplex-chat/Main.hs
+27 -17
View File
@@ -1,13 +1,15 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
module Main where
import Control.Concurrent (threadDelay)
import Control.Concurrent.STM.TVar (readTVarIO)
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM
import Control.Monad
import Data.Time.Clock (getCurrentTime)
import Data.Time.LocalTime (getCurrentTimeZone)
import Server
import Simplex.Chat.Controller (currentRemoteHost, versionNumber, versionString)
import Simplex.Chat.Controller (ChatController (..), ChatResponse (..), currentRemoteHost, versionNumber, versionString)
import Simplex.Chat.Core
import Simplex.Chat.Options
import Simplex.Chat.Terminal
@@ -22,20 +24,28 @@ main = do
opts@ChatOpts {chatCmd, chatServerPort} <- getChatOpts appDir "simplex_v1"
if null chatCmd
then case chatServerPort of
Just chatPort ->
simplexChatServer defaultChatServerConfig {chatPort} terminalChatConfig opts
_ -> do
welcome opts
t <- withTerminal pure
simplexChatTerminal terminalChatConfig opts t
else simplexChatCore terminalChatConfig opts $ \user cc -> do
rh <- readTVarIO $ currentRemoteHost cc
let cmdRH = rh -- response RemoteHost is the same as for the command itself
r <- sendChatCmdStr cc chatCmd
ts <- getCurrentTime
tz <- getCurrentTimeZone
putStrLn $ serializeChatResponse (rh, Just user) ts tz cmdRH r
threadDelay $ chatCmdDelay opts * 1000000
Just chatPort -> simplexChatServer defaultChatServerConfig {chatPort} terminalChatConfig opts
_ -> runCLI opts
else simplexChatCore terminalChatConfig opts $ runCommand opts
where
runCLI opts = do
welcome opts
t <- withTerminal pure
simplexChatTerminal terminalChatConfig opts t
runCommand ChatOpts {chatCmd, chatCmdLog, chatCmdDelay} user cc = do
when (chatCmdLog /= CCLNone) . void . forkIO . forever $ do
(_, _, r') <- atomically . readTBQueue $ outputQ cc
case r' of
CRNewChatItem {} -> printResponse r'
_ -> when (chatCmdLog == CCLAll) $ printResponse r'
sendChatCmdStr cc chatCmd >>= printResponse
threadDelay $ chatCmdDelay * 1000000
where
printResponse r = do
ts <- getCurrentTime
tz <- getCurrentTimeZone
rh <- readTVarIO $ currentRemoteHost cc
putStrLn $ serializeChatResponse (rh, Just user) ts tz rh r
welcome :: ChatOpts -> IO ()
welcome ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, networkConfig}} =