make slow commands asynchronous (#258)

This commit is contained in:
Evgeny Poberezkin 2022-02-02 17:47:27 +00:00 committed by GitHub
parent dafdf66ada
commit 292c334460
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 15 additions and 13 deletions

View File

@ -358,17 +358,19 @@ processChatCommand user@User {userId, profile} = \case
ShowVersion -> pure CRVersionInfo ShowVersion -> pure CRVersionInfo
where where
procCmd :: m ChatResponse -> m ChatResponse procCmd :: m ChatResponse -> m ChatResponse
procCmd a = do procCmd action = do
a -- below code would make command responses asynchronous where they can be slow
-- ! below code would make command responses asynchronous where they can be slow -- in View.hs `r'` should be defined as `id` in this case
-- ! in View.hs `r'` should be defined as `id` in this case ChatController {chatLock = l, smpAgent = a, outputQ = q, idsDrg = gVar} <- ask
-- gVar <- asks idsDrg corrId <- liftIO $ SMP.CorrId <$> randomBytes gVar 8
-- corrId <- liftIO $ CorrId <$> randomBytes gVar 8 void . forkIO $
-- q <- asks outputQ withAgentLock a . withLock l $
-- void . forkIO $ atomically . writeTBQueue q =<< atomically . writeTBQueue q
-- (Just corrId,) <$> (a `catchError` (pure . CRChatError)) =<< (Just corrId,) <$> (action `catchError` (pure . CRChatError))
-- pure $ CRCmdAccepted corrId pure $ CRCmdAccepted corrId
-- a corrId -- use function below to make commands "synchronous"
-- procCmd :: m ChatResponse -> m ChatResponse
-- procCmd action = action
connect :: ConnectionRequestUri c -> ChatMsgEvent -> m () connect :: ConnectionRequestUri c -> ChatMsgEvent -> m ()
connect cReq msg = do connect cReq msg = do
connId <- withAgent $ \a -> joinConnection a cReq $ directMessage msg connId <- withAgent $ \a -> joinConnection a cReq $ directMessage msg

View File

@ -117,8 +117,8 @@ responseToView cmd = \case
where where
api = (highlight cmd :) api = (highlight cmd :)
r = (plain cmd :) r = (plain cmd :)
-- this function should be `id` in case of asynchronous command responses -- this function should be `r` for "synchronous" command responses
r' = r r' = id
viewChatItem :: ChatInfo c -> ChatItem c d -> [StyledString] viewChatItem :: ChatInfo c -> ChatItem c d -> [StyledString]
viewChatItem chat (ChatItem cd meta content) = case (chat, cd) of viewChatItem chat (ChatItem cd meta content) = case (chat, cd) of