always run webapp in foreground

This commit is contained in:
Joey Hess 2012-08-01 16:34:17 -04:00
parent 7606f3e7c1
commit ca512f1450

View file

@ -25,16 +25,15 @@ import Control.Concurrent.STM
def :: [Command] def :: [Command]
def = [oneShot $ noRepo firstRun $ dontCheck repoExists $ def = [oneShot $ noRepo firstRun $ dontCheck repoExists $
withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption] $ withOptions [Command.Watch.stopOption] $
command "webapp" paramNothing seek "launch webapp"] command "webapp" paramNothing seek "launch webapp"]
seek :: [CommandSeek] seek :: [CommandSeek]
seek = [withFlag Command.Watch.stopOption $ \stopdaemon -> seek = [withFlag Command.Watch.stopOption $ \stopdaemon ->
withFlag Command.Watch.foregroundOption $ \foreground -> withNothing $ start stopdaemon]
withNothing $ start foreground stopdaemon]
start :: Bool -> Bool -> CommandStart start :: Bool -> CommandStart
start foreground stopdaemon = notBareRepo $ do start stopdaemon = notBareRepo $ do
if stopdaemon if stopdaemon
then stopDaemon then stopDaemon
else ifM (isInitialized) ( go , liftIO firstRun ) else ifM (isInitialized) ( go , liftIO firstRun )
@ -44,7 +43,7 @@ start foreground stopdaemon = notBareRepo $ do
f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
ifM (checkpid <&&> checkshim f) $ ifM (checkpid <&&> checkshim f) $
( liftIO $ openBrowser f ( liftIO $ openBrowser f
, startDaemon True foreground $ Just $ , startDaemon True True $ Just $
const openBrowser const openBrowser
) )
checkpid = do checkpid = do
@ -84,10 +83,7 @@ firstRun = do
where where
signaler v = do signaler v = do
putMVar v "" putMVar v ""
putStrLn "signaler waiting..." takeMVar v
r <- takeMVar v
putStrLn "signaler got value"
return r
mainthread v _url htmlshim = do mainthread v _url htmlshim = do
openBrowser htmlshim openBrowser htmlshim