generalized ExternalState to not be limited to a ExternalAddonProcess

Idea is for ASYNC extension, it will instead contain methods that communicate
with the thread that handles all communication with the external process.

Remote/External.hs

@@ -12,7 +12,7 @@ module Remote.External (remote) where
 import Remote.External.Types
 import qualified Annex
 import Annex.Common
-import Annex.ExternalAddonProcess
+import qualified Annex.ExternalAddonProcess as AddonProcess
 import Types.Remote
 import Types.Export
 import Types.CleanupActions
@@ -504,13 +504,26 @@ handleRequest' st external req mp responsehandler
 		setDownloader (show uri) OtherDownloader
 
 sendMessage :: Sendable m => ExternalState -> m -> Annex ()
-sendMessage st m = liftIO $ do
+sendMessage st m = liftIO $ externalSend st line
-	protocolDebug (externalAddonProcess st) True line
+  where
+	line = unwords $ formatMessage m
+
+sendMessageAddonProcess :: AddonProcess.ExternalAddonProcess -> String -> IO ()
+sendMessageAddonProcess p line = do
+	AddonProcess.protocolDebug p True line
 	hPutStrLn h line
 	hFlush h
   where
-	line = unwords $ formatMessage m
+	h = AddonProcess.externalSend p
-	h = externalSend (externalAddonProcess st)
+
+receiveMessageAddonProcess :: AddonProcess.ExternalAddonProcess -> IO (Maybe String)
+receiveMessageAddonProcess p = do
+	v <- catchMaybeIO $ hGetLine $ AddonProcess.externalReceive p
+	maybe noop (AddonProcess.protocolDebug p False) v
+	return v
+
+shutdownAddonProcess :: AddonProcess.ExternalAddonProcess -> Bool -> IO ()
+shutdownAddonProcess = AddonProcess.externalShutdown 
 
 {- A response handler can yeild a result, or it can request that another
  - message be consumed from the external. -}
@@ -535,23 +548,21 @@ receiveMessage
 	-> (ExceptionalMessage -> Maybe (Annex a))
 	-> Annex a
 receiveMessage st external handleresponse handlerequest handleexceptional =
-	go =<< liftIO (catchMaybeIO $ hGetLine $ externalReceive $ externalAddonProcess st)
+	go =<< liftIO (externalReceive st)
   where
 	go Nothing = protocolError False ""
-	go (Just s) = do
+	go (Just s) = case parseMessage s :: Maybe Response of
-		liftIO $ protocolDebug (externalAddonProcess st) False s
+		Just resp -> case handleresponse resp of
-		case parseMessage s :: Maybe Response of
+			Nothing -> protocolError True s
-			Just resp -> case handleresponse resp of
+			Just callback -> callback >>= \case
-				Nothing -> protocolError True s
+				Result a -> return a
-				Just callback -> callback >>= \case
+				GetNextMessage handleresponse' ->
-					Result a -> return a
+					receiveMessage st external handleresponse' handlerequest handleexceptional
-					GetNextMessage handleresponse' ->
+		Nothing -> case parseMessage s :: Maybe RemoteRequest of
-						receiveMessage st external handleresponse' handlerequest handleexceptional
+			Just req -> maybe (protocolError True s) id (handlerequest req)
-			Nothing -> case parseMessage s :: Maybe RemoteRequest of
+			Nothing -> case parseMessage s :: Maybe ExceptionalMessage of
-				Just req -> maybe (protocolError True s) id (handlerequest req)
+				Just msg -> maybe (protocolError True s) id (handleexceptional msg)
-				Nothing -> case parseMessage s :: Maybe ExceptionalMessage of
+				Nothing -> protocolError False s
-					Just msg -> maybe (protocolError True s) id (handleexceptional msg)
-					Nothing -> protocolError False s
 	protocolError parsed s = giveup $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\" " ++
 		if parsed
 			then "(command not allowed at this time)"
@@ -571,7 +582,7 @@ receiveMessage st external handleresponse handlerequest handleexceptional =
 withExternalState :: External -> (ExternalState -> Annex a) -> Annex a
 withExternalState external a = do
 	st <- get
-	r <- a st `onException` liftIO (externalShutdown (externalAddonProcess st) True)
+	r <- a st `onException` liftIO (externalShutdown st True)
 	put st -- only when no exception is thrown
 	return r
   where
@@ -597,9 +608,9 @@ startExternal external = do
 		n <- succ <$> readTVar (externalLastPid external)
 		writeTVar (externalLastPid external) n
 		return n
-	startExternalAddonProcess basecmd pid >>= \case
+	AddonProcess.startExternalAddonProcess basecmd pid >>= \case
-		Left (ProgramFailure err) -> giveup err
+		Left (AddonProcess.ProgramFailure err) -> giveup err
-		Left (ProgramNotInstalled err) ->
+		Left (AddonProcess.ProgramNotInstalled err) ->
 			case (lookupName (unparsedRemoteConfig (externalDefaultConfig external)), remoteAnnexReadOnly <$> externalGitConfig external) of
 				(Just rname, Just True) -> giveup $ unlines
 					[ err
@@ -614,7 +625,9 @@ startExternal external = do
 			ccv <- liftIO $ newTVarIO id
 			pv <- liftIO $ newTVarIO Unprepared
 			let st = ExternalState
-				{ externalAddonProcess = p
+				{ externalSend = sendMessageAddonProcess p
+				, externalReceive = receiveMessageAddonProcess p
+				, externalShutdown = shutdownAddonProcess p
 				, externalPrepared = pv
 				, externalConfig = cv
 				, externalConfigChanges = ccv
@@ -644,7 +657,7 @@ startExternal external = do
 stopExternal :: External -> Annex ()
 stopExternal external = liftIO $ do
 	l <- atomically $ swapTVar (externalState external) []
-	mapM_ (flip (externalShutdown . externalAddonProcess) False) l
+	mapM_ (flip externalShutdown False) l
 
 checkVersion :: ExternalState -> RemoteRequest -> Maybe (Annex ())
 checkVersion st (VERSION v) = Just $

Remote/External/Types.hs

@@ -34,7 +34,6 @@ module Remote.External.Types (
 ) where
 
 import Annex.Common
-import Annex.ExternalAddonProcess
 import Types.StandardGroups (PreferredContentExpression)
 import Utility.Metered (BytesProcessed(..))
 import Types.Transfer (Direction(..))
@@ -75,12 +74,15 @@ newExternal externaltype u c gc rs = liftIO $ External
 
 type ExternalType = String
 
-data ExternalState = ExternalState
+data ExternalState
-	{ externalAddonProcess :: ExternalAddonProcess
+	= ExternalState
-	, externalPrepared :: TVar PrepareStatus
+		{ externalSend :: String -> IO ()
-	, externalConfig :: TVar ParsedRemoteConfig
+		, externalReceive :: IO (Maybe String)
-	, externalConfigChanges :: TVar (RemoteConfig -> RemoteConfig)
+		, externalShutdown :: Bool -> IO ()
-	}
+		, externalPrepared :: TVar PrepareStatus
+		, externalConfig :: TVar ParsedRemoteConfig
+		, externalConfigChanges :: TVar (RemoteConfig -> RemoteConfig)
+		}
 
 type PID = Int