mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

remove uses of warningIO

Browse source 
It's not concurrent-output safe, and doesn't support
--json-error-messages.

Using Annex.makeRunner is a bit scary, because what if it's run in a
different thread from an active annex action? Normally the same Annex
state is not used concurrently in several threads, and it's not designed
to be fully concurrency safe. (Annex.Concurrent exists to deal with
that.) I think it will be ok in these simple cases though. Eg,
when buffering a warning message to json, Annex.changeState is used,
and it modifies the MVar in a concurrency safe way.

The only warningIO remaining is not a problem.
This commit is contained in:
Joey Hess 2020-12-02 14:57:43 -04:00
parent 1858b65d88
commit 63839532c9
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 28 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

19
Remote/External/AsyncExtension.hs vendored
View file

@ -11,9 +11,10 @@
module Remote.External.AsyncExtension (runRelayToExternalAsync) where
import Common
import Annex
import Messages
import Remote.External.Types
import Utility.SimpleProtocol as Proto
import qualified Utility.SimpleProtocol as Proto
import Control.Concurrent.Async
import Control.Concurrent.STM
@ -23,13 +24,13 @@ import qualified Data.Map.Strict as M
-- | Starts a thread that will handle all communication with the external
-- process. The input ExternalState communicates directly with the external
-- process.
runRelayToExternalAsync :: External -> ExternalState -> IO ExternalAsyncRelay
runRelayToExternalAsync external st = do
runRelayToExternalAsync :: External -> ExternalState -> (Annex () -> IO ()) -> IO ExternalAsyncRelay
runRelayToExternalAsync external st annexrunner = do
jidmap <- newTVarIO M.empty
sendq <- newSendQueue
nextjid <- newTVarIO (JobId 1)
sender <- async $ sendloop st sendq
receiver <- async $ receiveloop external st jidmap sendq sender
receiver <- async $ receiveloop external st jidmap sendq sender annexrunner
return $ ExternalAsyncRelay $ do
receiveq <- newReceiveQueue
jid <- atomically $ do
@ -65,14 +66,14 @@ newReceiveQueue = newTBMChanIO 10
newSendQueue :: IO SendQueue
newSendQueue = newTBMChanIO 10
receiveloop :: External -> ExternalState -> JidMap -> SendQueue -> Async () -> IO ()
receiveloop external st jidmap sendq sendthread = externalReceive st >>= \case
receiveloop :: External -> ExternalState -> JidMap -> SendQueue -> Async () -> (Annex () -> IO ()) -> IO ()
receiveloop external st jidmap sendq sendthread annexrunner = externalReceive st >>= \case
Just l -> case parseMessage l :: Maybe AsyncMessage of
Just (AsyncMessage jid msg) ->
M.lookup jid <$> readTVarIO jidmap >>= \case
Just c -> do
atomically $ writeTBMChan c msg
receiveloop external st jidmap sendq sendthread
receiveloop external st jidmap sendq sendthread annexrunner
Nothing -> protoerr "unknown job number"
Nothing -> case parseMessage l :: Maybe ExceptionalMessage of
Just _ -> do
@ -80,12 +81,12 @@ receiveloop external st jidmap sendq sendthread = externalReceive st >>= \case
m <- readTVarIO jidmap
forM_ (M.elems m) $ \c ->
atomically $ writeTBMChan c l
receiveloop external st jidmap sendq sendthread
receiveloop external st jidmap sendq sendthread annexrunner
Nothing -> protoerr "unexpected non-async message"
Nothing -> closeandshutdown
where
protoerr s = do
warningIO $ "async external special remote protocol error: " ++ s
annexrunner $ warning $ "async external special remote protocol error: " ++ s
closeandshutdown
closeandshutdown = do