support prompt in message serialization

That seems to be the last thing needed for message serialization.
Although it's only used in the assistant currently, so hard to tell if I
forgot something.

At this point, it should be possible to start using transferkeys
when performing transfers, which will allow killing a transferkeys
process if a transfer times out or stalls. But that's for another day.

This commit was sponsored by Ethan Aubin.
This commit is contained in:
Joey Hess 2020-12-04 14:54:09 -04:00
parent 581792bcf0
commit 438d5be1f7
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 77 additions and 29 deletions

View file

@ -288,7 +288,7 @@ commandProgressDisabled = withMessageState $ \s -> return $
NormalOutput -> concurrentOutputEnabled s
QuietOutput -> True
JSONOutput _ -> True
SerializedOutput _ -> True
SerializedOutput _ _ -> True
jsonOutputEnabled :: Annex Bool
jsonOutputEnabled = withMessageState $ \s -> return $
@ -314,8 +314,20 @@ mkPrompter = getConcurrency >>= \case
where
goconcurrent = withMessageState $ \s -> do
let l = promptLock s
let (run, cleanup) = case outputType s of
SerializedOutput h hr ->
( \a -> do
liftIO $ outputSerialized h StartPrompt
liftIO $ waitOutputSerializedResponse hr ReadyPrompt
a
, liftIO $ outputSerialized h EndPrompt
)
_ ->
( hideRegionsWhile s
, noop
)
return $ \a ->
debugLocks $ bracketIO
(takeMVar l)
(putMVar l)
(const $ hideRegionsWhile s a)
(\v -> putMVar l v >> cleanup)
(const $ run a)