webapp now starts up when run not in a git repo

Assistant.hs

@@ -122,7 +122,7 @@ import Utility.ThreadScheduler
 
 import Control.Concurrent
 
-startDaemon :: Bool -> Bool -> Maybe (IO ()) -> Annex ()
+startDaemon :: Bool -> Bool -> Maybe (FilePath -> IO ()) -> Annex ()
 startDaemon assistant foreground webappwaiter
 	| foreground = do
 		showStart (if assistant then "assistant" else "watch") "."
@@ -155,7 +155,7 @@ startDaemon assistant foreground webappwaiter
 				, mountWatcherThread st dstatus scanremotes
 				, transferScannerThread st dstatus scanremotes transferqueue
 #ifdef WITH_WEBAPP
-				, webAppThread st dstatus transferqueue webappwaiter
+				, webAppThread (Just st) dstatus transferqueue webappwaiter
 #endif
 				, watchThread st dstatus transferqueue changechan
 				]

Assistant/Threads/WebApp.hs

@@ -1,4 +1,4 @@
-{- git-annex assistant webapp
+{- git-annex assistant webapp thread
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
@@ -38,47 +38,46 @@ thisThread = "WebApp"
 
 mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
 
-webAppThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Maybe (IO ()) -> IO ()
-webAppThread st dstatus transferqueue onstartup = do
-	webapp <- mkWebApp
+webAppThread :: (Maybe ThreadState) -> DaemonStatusHandle -> TransferQueue -> Maybe (FilePath -> IO ()) -> IO ()
+webAppThread mst dstatus transferqueue onstartup = do
+	webapp <- WebApp
+		<$> pure mst
+		<*> pure dstatus
+		<*> pure transferqueue
+		<*> (pack <$> genRandomToken)
+		<*> getreldir mst
+		<*> pure $(embed "static")
+		<*> newWebAppState
 	app <- toWaiAppPlain webapp
 	app' <- ifM debugEnabled
 		( return $ httpDebugLogger app
 		, return app
 		)
-	runWebApp app' $ \port -> do
-		runThreadState st $ writeHtmlShim webapp port
-		maybe noop id onstartup
+	runWebApp app' $ \port -> case mst of
+		Nothing -> withTempFile "webapp.html" $ \tmpfile _ -> go port webapp tmpfile
+		Just st -> go port webapp =<< runThreadState st (fromRepo gitAnnexHtmlShim)
 	where
-		mkWebApp = do
+		getreldir Nothing = return Nothing
+		getreldir (Just st) = do
 			dir <- absPath =<< runThreadState st (fromRepo repoPath)
 			home <- myHomeDir
-			let reldir = if dirContains home dir
+			return $ Just $ if dirContains home dir
 				then relPathDirToFile home dir
 				else dir
-			token <- genRandomToken 
-			s <- newWebAppState
-			return $ WebApp 
-				{ threadState = Just st
-				, daemonStatus = dstatus
-				, transferQueue = transferqueue
-				, secretToken = pack token
-				, relDir = reldir
-				, getStatic = $(embed "static")
-				, webAppState = s
-				}
+		go port webapp htmlshim = do
+			writeHtmlShim webapp port htmlshim
+			maybe noop (\a -> a htmlshim) onstartup
 
 {- Creates a html shim file that's used to redirect into the webapp,
  - to avoid exposing the secretToken when launching the web browser. -}
-writeHtmlShim :: WebApp -> PortNumber -> Annex ()
-writeHtmlShim webapp port = do
-	liftIO $ debug thisThread ["running on port", show port]
-	htmlshim <- fromRepo gitAnnexHtmlShim
-	liftIO $ viaTmp go htmlshim $ genHtmlShim webapp port
+writeHtmlShim :: WebApp -> PortNumber -> FilePath -> IO ()
+writeHtmlShim webapp port file = do
+	debug thisThread ["running on port", show port]
+	viaTmp go file $ genHtmlShim webapp port
 	where
-		go file content = do
-			h <- openFile file WriteMode
-			modifyFileMode file $ removeModes [groupReadMode, otherReadMode]
+		go tmpfile content = do
+			h <- openFile tmpfile WriteMode
+			modifyFileMode tmpfile $ removeModes [groupReadMode, otherReadMode]
 			hPutStr h content
 			hClose h
 

Assistant/WebApp.hs

@@ -34,7 +34,7 @@ data WebApp = WebApp
 	, daemonStatus :: DaemonStatusHandle
 	, transferQueue :: TransferQueue
 	, secretToken :: Text
-	, relDir :: FilePath
+	, relDir :: Maybe FilePath
 	, getStatic :: Static
 	, webAppState :: TMVar WebAppState
 	}

Assistant/WebApp/Configurators.hs

@@ -25,7 +25,6 @@ import Data.Text (Text)
 introDisplay :: Text -> Widget
 introDisplay ident = do
 	webapp <- lift getYesod
-	let reldir = relDir webapp
 	l <- lift $ runAnnex [] $ do
 		u <- getUUID
 		rs <- map Remote.uuid <$> Remote.remoteList

Command/WebApp.hs

@@ -10,12 +10,19 @@ module Command.WebApp where
 import Common.Annex
 import Command
 import Assistant
+import Assistant.DaemonStatus
+import Assistant.TransferQueue
+import Assistant.Threads.WebApp
 import Utility.WebApp
+import Utility.ThreadScheduler
 import Utility.Daemon (checkDaemon)
 import qualified Command.Watch
 
+import Control.Concurrent.STM
+
 def :: [Command]
-def = [withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption] $
+def = [oneShot $ noRepo firstRun $ dontCheck repoExists $
+	withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption] $
         command "webapp" paramNothing seek "launch webapp"]
 
 seek :: [CommandSeek]
@@ -30,8 +37,8 @@ start foreground stopdaemon = notBareRepo $ do
 		else do
 			f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
 			ifM (checkpid <&&> checkshim f) $
-				( liftIO $ go f 
-				, startDaemon True foreground $ Just $ go f
+				( liftIO $ openBrowser f 
+				, startDaemon True foreground $ Just openBrowser
 				)
 	stop
 	where
@@ -39,7 +46,17 @@ start foreground stopdaemon = notBareRepo $ do
 			pidfile <- fromRepo gitAnnexPidFile
 			liftIO $ isJust <$> checkDaemon pidfile
 		checkshim f = liftIO $ doesFileExist f
-		go f = unlessM (runBrowser url) $
-			error $ "failed to start web browser on url " ++ url
-			where
-				url = "file://" ++ f
+
+openBrowser :: FilePath -> IO ()
+openBrowser htmlshim = unlessM (runBrowser url) $
+	error $ "failed to start web browser on url " ++ url
+	where
+		url = "file://" ++ htmlshim
+
+firstRun :: IO ()
+firstRun = do
+	dstatus <- atomically . newTMVar =<< newDaemonStatus
+	transferqueue <- newTransferQueue
+	webAppThread Nothing dstatus transferqueue $ Just $ \f -> do
+		openBrowser f
+		waitForTermination

templates/bootstrap.hamlet

@@ -1,7 +1,11 @@
 $doctype 5
 <html>
   <head>
-    <title>#{relDir webapp} #{pageTitle page}
+    <title>
+     $maybe reldir <- relDir webapp
+       #{reldir} #{pageTitle page}
+     $nothing
+       #{pageTitle page}
     <link rel="icon" href=@{StaticR favicon_ico} type="image/x-icon">
     <meta name="viewport" content="width=device-width,initial-scale=1.0">
     ^{pageHead page}

templates/configurators/intro.hamlet

@@ -1,27 +1,28 @@
 <div .span9 ##{ident} .hero-unit>
-  <h2>
-    git-annex is watching over your files in <small><tt>#{reldir}</tt></small>
-  <p>
-    It will automatically notice changes, and keep files in sync between #
-    $if notenough
-      repositories on your devices ...
-      <h2>
-        But no other repositories are set up yet.
-      <a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a>
-    $else
-      $if barelyenough
-        <span .badge .badge-warning>#{numrepos}</span>
+  $maybe reldir <- relDir webapp
+   <h2>
+      git-annex is watching over your files in <small><tt>#{reldir}</tt></small>
+    <p>
+      It will automatically notice changes, and keep files in sync between #
+      $if notenough
+        repositories on your devices ...
+        <h2>
+          But no other repositories are set up yet.
+        <a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a>
       $else
-        <span .badge .badge-success>#{numrepos}</span>
-      \ repositories and devices:
-      <table .table .table-striped .table-condensed>
-        <tbody>
-          $forall (num, name) <- remotelist
-            <tr>
-              <td>
-                #{num}
-              <td>
-                #{name}
-      <a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a>
-      <p>
-        Or just sit back, watch the magic, and get on with using your files.
+        $if barelyenough
+          <span .badge .badge-warning>#{numrepos}</span>
+        $else
+          <span .badge .badge-success>#{numrepos}</span>
+        \ repositories and devices:
+        <table .table .table-striped .table-condensed>
+          <tbody>
+            $forall (num, name) <- remotelist
+              <tr>
+                <td>
+                  #{num}
+                <td>
+                  #{name}
+        <a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a>
+        <p>
+          Or just sit back, watch the magic, and get on with using your files.

templates/page.hamlet

@@ -7,16 +7,17 @@
         $forall (name, route, isactive) <- navbar
           <li :isactive:.active>
             <a href="@{route}">#{name}</a>
-      <ul .nav .pull-right>
-        <li .dropdown #menu1>
-          <a .dropdown-toggle data-toggle="dropdown" href="#menu1">
-            Current Repository: #{relDir webapp}
-            <b .caret></b>
-          <ul .dropdown-menu>
-             <li><a href="#">#{relDir webapp}</a></li>
-             <li .divider></li>
-             <li><a href="@{AddRepositoryR}">Add another repository</a></li>
-
+      $maybe reldir <- relDir webapp
+        <ul .nav .pull-right>
+          <li .dropdown #menu1>
+            <a .dropdown-toggle data-toggle="dropdown" href="#menu1">
+              Current Repository: #{reldir}
+              <b .caret></b>
+            <ul .dropdown-menu>
+               <li><a href="#">#{reldir}</a></li>
+               <li .divider></li>
+               <li><a href="@{AddRepositoryR}">Add another repository</a></li>
+      $nothing
 <div .container-fluid>
   <div .row-fluid>
     ^{content}