more build fixes (remove phantom shutdown page)

This commit is contained in:
Joey Hess 2013-11-25 14:33:14 -04:00
parent ab4fd36c0e
commit 8a9928742f

View file

@ -38,19 +38,18 @@ getShutdownConfirmedR = do
- the transfer processes). -} - the transfer processes). -}
ts <- M.keys . currentTransfers <$> getDaemonStatus ts <- M.keys . currentTransfers <$> getDaemonStatus
mapM_ pauseTransfer ts mapM_ pauseTransfer ts
page "Shutdown" Nothing $ do webapp <- getYesod
webapp <- liftH getYesod let url = T.unpack $ yesodRender webapp (T.pack "") NotRunningR []
let url = T.unpack $ yesodRender webapp (T.pack "") NotRunningR [] {- Signal any other web browsers. -}
{- Signal any other web browsers. -} liftAssistant $ do
liftAssistant $ do modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url }
modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url } liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus
liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus {- Wait 2 seconds before shutting down, to give the web
{- Wait 2 seconds before shutting down, to give the web - page time to load in the browser. -}
- page time to load in the browser. -} void $ liftIO $ forkIO $ do
void $ liftIO $ forkIO $ do threadDelay 2000000
threadDelay 2000000 signalProcess sigTERM =<< getProcessID
signalProcess sigTERM =<< getProcessID redirect NotRunningR
redirect NotRunningR
{- Use a custom page to avoid putting long polling elements on it that will {- Use a custom page to avoid putting long polling elements on it that will
- fail and cause the web browser to show an error once the webapp is - fail and cause the web browser to show an error once the webapp is