much better webapp startup of the assistant

This avoids forking another process, avoids polling, fixes a race,
and avoids a rare forkProcess thread hang that I saw once time
when starting the webapp.

Assistant.hs

@@ -124,8 +124,8 @@ import Utility.ThreadScheduler
 
 import Control.Concurrent
 
-startDaemon :: Bool -> Bool -> Annex ()
-startDaemon assistant foreground
+startDaemon :: Bool -> Bool -> Maybe (IO ()) -> Annex ()
+startDaemon assistant foreground webappwaiter
 	| foreground = do
 		showStart (if assistant then "assistant" else "watch") "."
 		go id
@@ -157,12 +157,11 @@ startDaemon assistant foreground
 				, mountWatcherThread st dstatus scanremotes
 				, transferScannerThread st scanremotes transferqueue
 #ifdef WITH_WEBAPP
-				, webAppThread st dstatus transferqueue
+				, webAppThread st dstatus transferqueue webappwaiter
 #endif
 				, watchThread st dstatus transferqueue changechan
 				]
-			debug "assistant"
-				["all git-annex assistant threads started"]
+			debug "Assistant" ["all threads started"]
 			waitForTermination
 
 stopDaemon :: Annex ()

Assistant/Threads/WebApp.hs

@@ -145,15 +145,17 @@ getConfigR = defaultLayout $ do
 	setTitle "configuration"
 	[whamlet|<a href="@{HomeR}">main|]
 
-webAppThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> IO ()
-webAppThread st dstatus transferqueue = do
+webAppThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Maybe (IO ()) -> IO ()
+webAppThread st dstatus transferqueue onstartup = do
 	webapp <- mkWebApp
 	app <- toWaiAppPlain webapp
 	app' <- ifM debugEnabled
 		( return $ httpDebugLogger app
 		, return app
 		)
-	runWebApp app' $ \port -> runThreadState st $ writeHtmlShim webapp port
+	runWebApp app' $ \port -> do
+		runThreadState st $ writeHtmlShim webapp port
+		maybe noop id onstartup
 	where
 		mkWebApp = do
 			dir <- absPath =<< runThreadState st (fromRepo repoPath)

Command/Watch.hs

@@ -34,5 +34,5 @@ start :: Bool -> Bool -> Bool -> CommandStart
 start assistant foreground stopdaemon = notBareRepo $ do
 	if stopdaemon
 		then stopDaemon
-		else startDaemon assistant foreground -- does not return
+		else startDaemon assistant foreground Nothing -- does not return
 	stop

Command/WebApp.hs

@@ -12,12 +12,8 @@ import Command
 import Assistant
 import Utility.WebApp
 import Utility.Daemon (checkDaemon)
-import qualified Annex
 import Option
 
-import Control.Concurrent
-import System.Posix.Process
-
 def :: [Command]
 def = [withOptions [restartOption] $
         command "webapp" paramNothing seek "launch webapp"]
@@ -34,31 +30,20 @@ start restart = notBareRepo $ do
 	if restart
 		then do
 			stopDaemon
-			nuke =<< fromRepo gitAnnexPidFile
+			void $ liftIO . nukeFile =<< fromRepo gitAnnexPidFile
 			startassistant f
-		else unlessM (checkpid f) $
-			startassistant f
-	let url = "file://" ++ f
-	ifM (liftIO $ runBrowser url)
-		( stop
-		, error $ "failed to start web browser on url " ++ url
-		)
+		else ifM (checkpid <&&> checkshim f) $
+			( liftIO $ go f 
+			, startassistant f
+			)
+	stop
 	where
-		nuke f = void $ liftIO $ catchMaybeIO $ removeFile f
-		checkpid f = do
+		checkpid = do
 			pidfile <- fromRepo gitAnnexPidFile
-			liftIO $
-				doesFileExist f <&&> (isJust <$> checkDaemon pidfile)
-		startassistant f = do
-			nuke f
-			{- Fork a separate process to run the assistant,
-			 - with a copy of the Annex state. -}
-			state <- Annex.getState id
-			liftIO $ void $ forkProcess $
-				Annex.eval state $ startDaemon True False
-			waitdaemon f (1000 :: Int)
-		waitdaemon _ 0 = error "failed to start git-annex assistant"
-		waitdaemon f n = unlessM (checkpid f) $ do
-			-- wait 0.1 seconds before retry
-			liftIO $ threadDelay 100000
-			waitdaemon f (n - 1)
+			liftIO $ isJust <$> checkDaemon pidfile
+		checkshim f = liftIO $ doesFileExist f
+		startassistant = startDaemon True False . Just . go
+		go f = unlessM (runBrowser url) $
+			error $ "failed to start web browser on url " ++ url
+			where
+				url = "file://" ++ f

Utility/WebApp.hs

@@ -32,6 +32,7 @@ import Blaze.ByteString.Builder.Char.Utf8 (fromText)
 import Blaze.ByteString.Builder (Builder)
 import Data.Monoid
 import Control.Arrow ((***))
+import Control.Concurrent
 
 localhost :: String
 localhost = "localhost"
@@ -52,12 +53,12 @@ runBrowser url = boolSystem cmd [Param url]
  -
  - An IO action can also be run, to do something with the port number,
  - such as start a web browser to view the webapp.
-  -}
+ -}
 runWebApp :: Application -> (PortNumber -> IO ()) -> IO ()
 runWebApp app observer = do
 	sock <- localSocket
+	void $ forkIO $ runSettingsSocket defaultSettings sock app
 	observer =<< socketPort sock
-	runSettingsSocket defaultSettings sock app
 
 {- Binds to a local socket, selecting any free port.
  -