git annex webapp now opens a browser to the webapp

Also, starts the assistant if it wasn't already running.
This commit is contained in:
Joey Hess 2012-07-25 23:13:01 -04:00
parent e6ce54de82
commit 1ffef3ad75
6 changed files with 122 additions and 23 deletions

58
Command/WebApp.hs Normal file
View file

@ -0,0 +1,58 @@
{- git-annex webapp launcher
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.WebApp where
import Common.Annex
import Command
import Assistant
import Utility.WebApp
import Utility.Daemon
import qualified Annex
import Control.Concurrent
import System.Posix.Process
def :: [Command]
def = [command "webapp" paramNothing seek "launch webapp"]
seek :: [CommandSeek]
seek = [withNothing start]
start :: CommandStart
start = notBareRepo $ do
r <- checkpid
when (r == Nothing) $
startassistant
f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
let url = "file://" ++ f
ifM (liftIO $ runBrowser url)
( stop
, error $ "failed to start web browser on url " ++ url
)
where
checkpid = do
pidfile <- fromRepo gitAnnexPidFile
liftIO $ checkDaemon pidfile
startassistant = do
{- 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 (100 :: Int)
waitdaemon 0 = error "failed to start git-annex assistant"
waitdaemon n = do
r <- checkpid
case r of
Just _ -> return ()
Nothing -> do
liftIO $
threadDelay 100000 -- 0.1 seconds
waitdaemon (n - 1)