Merge branch 'master' into master-ghc8107

This commit is contained in:
Evgeny Poberezkin
2023-12-04 10:07:16 +00:00
16 changed files with 225 additions and 172 deletions
+8
View File
@@ -42,6 +42,7 @@ data ChatOpts = ChatOpts
allowInstantFiles :: Bool,
autoAcceptFileSize :: Integer,
muteNotifications :: Bool,
markRead :: Bool,
maintenance :: Bool
}
@@ -268,6 +269,12 @@ chatOptsP appDir defaultDbFileName = do
( long "mute"
<> help "Mute notifications"
)
markRead <-
switch
( long "mark-read"
<> short 'r'
<> help "Mark shown messages as read"
)
maintenance <-
switch
( long "maintenance"
@@ -286,6 +293,7 @@ chatOptsP appDir defaultDbFileName = do
allowInstantFiles,
autoAcceptFileSize,
muteNotifications,
markRead,
maintenance
}
+3 -3
View File
@@ -44,7 +44,7 @@ simplexChatTerminal cfg opts t =
handle checkDBKeyError . simplexChatCore cfg opts $ \u cc -> do
ct <- newChatTerminal t opts
when (firstTime cc) . printToTerminal ct $ chatWelcome u
runChatTerminal ct cc
runChatTerminal ct cc opts
checkDBKeyError :: SQLError -> IO ()
checkDBKeyError e = case sqlError e of
@@ -53,5 +53,5 @@ checkDBKeyError e = case sqlError e of
exitFailure
_ -> throwIO e
runChatTerminal :: ChatTerminal -> ChatController -> IO ()
runChatTerminal ct cc = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc, runInputLoop ct cc]
runChatTerminal :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
runChatTerminal ct cc opts = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc opts, runInputLoop ct cc]
+4 -4
View File
@@ -142,13 +142,13 @@ withTermLock ChatTerminal {termLock} action = do
action
atomically $ putTMVar termLock ()
runTerminalOutput :: ChatTerminal -> ChatController -> IO ()
runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = do
runTerminalOutput :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} ChatOpts {markRead} = do
forever $ do
(_, outputRH, r) <- atomically $ readTBQueue outputQ
case r of
CRNewChatItem u ci -> markChatItemRead u ci
CRChatItemUpdated u ci -> markChatItemRead u ci
CRNewChatItem u ci -> when markRead $ markChatItemRead u ci
CRChatItemUpdated u ci -> when markRead $ markChatItemRead u ci
CRRemoteHostConnected {remoteHost = RemoteHostInfo {remoteHostId}} -> getRemoteUser remoteHostId
CRRemoteHostStopped {remoteHostId_} -> mapM_ removeRemoteUser remoteHostId_
_ -> pure ()