reformat

src/Propellor/CmdLine.hs

@@ -197,54 +197,55 @@ spin hn hst = do
 	void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
 	void $ boolSystem "git" [Param "push"]
 	cacheparams <- toCommand <$> sshCachingParams hn
-	go cacheparams =<< hostprivdata
+	comm cacheparams =<< hostprivdata
 	unlessM (boolSystem "ssh" (map Param (cacheparams ++ ["-t", user, runcmd]))) $
 		error $ "remote propellor failed (running: " ++ runcmd ++")"
   where
 	hostprivdata = show . filterPrivData hst <$> decryptPrivData
 
-	go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
+	comm cacheparams privdata = 
-		let loop = do
+		withBothHandles createProcessSuccess
-			status <- getMarked fromh statusMarker
+			(proc "ssh" $ cacheparams ++ [user, bootstrapcmd])
-			case readish =<< status of
+			(comm' cacheparams privdata)
-				Just NeedRepoUrl -> do
+	comm' cacheparams privdata (toh, fromh) = loop
-					sendMarked toh repoUrlMarker
+	  where
-						=<< (fromMaybe "" <$> getRepoUrl)
+		loop = dispatch =<< (maybe Nothing readish <$> getMarked fromh statusMarker)
-					loop
+		dispatch (Just NeedRepoUrl) = do
-				Just NeedPrivData -> do
+			sendMarked toh repoUrlMarker
-					sendprivdata toh privdata
+				=<< (fromMaybe "" <$> getRepoUrl)
-					loop
+			loop
-				Just NeedGitPush -> void $ actionMessage "Git update" $ do
+		dispatch (Just NeedPrivData) = do
-					sendMarked toh gitPushMarker ""
+			sendprivdata toh privdata
-					let p = (proc "git" ["upload-pack", "."])
+			loop
-						{ std_in = UseHandle fromh
+		dispatch (Just NeedGitPush) = do
-						, std_out = UseHandle toh
+			void $ actionMessage ("Sending git update to " ++ hn) $ do
-						}
+				sendMarked toh gitPushMarker ""
-					(Nothing, Nothing, Nothing, h) <- createProcess p
+				let p = (proc "git" ["upload-pack", "."])
-					r <- waitForProcess h
+					{ std_in = UseHandle fromh
-					-- no more protocol possible after
+					, std_out = UseHandle toh
-					-- git push
+					}
-					hClose fromh
+				(Nothing, Nothing, Nothing, h) <- createProcess p
-					hClose toh
+				r <- waitForProcess h
-					return (r == ExitSuccess)
+				-- no more protocol possible after git push
-				Just NeedGitClone -> do
+				hClose fromh
-					hClose toh
+				hClose toh
-					hClose fromh
+				return (r == ExitSuccess)
-					sendGitClone hn
+		dispatch (Just NeedGitClone) = do
-					go cacheparams privdata
+			hClose toh
-				-- Ready is only sent by old versions of
+			hClose fromh
-				-- propellor. They expect to get privdata,
+			sendGitClone hn
-				-- and then no more protocol communication.
+			comm cacheparams privdata
-				Just Ready -> do
+		-- Ready is only sent by old versions of
-					sendprivdata toh privdata
+		-- propellor. They expect to get privdata,
-					hClose toh
+		-- and then no more protocol communication.
-					
+		dispatch (Just Ready) = do
-					-- Display remaining output.
+			sendprivdata toh privdata
-					void $ tryIO $ forever $
+			hClose toh
-						showremote =<< hGetLine fromh
+			-- Display remaining output.
-					hClose fromh
+			void $ tryIO $ forever $
-				Nothing -> return ()
+				showremote =<< hGetLine fromh
-		loop
+			hClose fromh
+		dispatch Nothing = return ()
 	
 	user = "root@"++hn