From 6b770f7797588e687ef5b4e567d86a0fd08809ea Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 22 Nov 2013 23:53:24 -0400 Subject: got assistant upgrade detection to notice when I build a new version with cabal build! --- Assistant/Threads/UpgradeWatcher.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'Assistant') diff --git a/Assistant/Threads/UpgradeWatcher.hs b/Assistant/Threads/UpgradeWatcher.hs index 707dc0f1d..acf68a0a6 100644 --- a/Assistant/Threads/UpgradeWatcher.hs +++ b/Assistant/Threads/UpgradeWatcher.hs @@ -40,6 +40,7 @@ upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ go =<< liftIO p changed <- Just <$> asIO2 (changedFile urlrenderer mvar program) let hooks = mkWatchHooks { addHook = changed + , delHook = changed , addSymlinkHook = changed , modifyHook = changed , delDirHook = changed @@ -76,12 +77,13 @@ changedFile urlrenderer mvar program file _status -} sanityCheck :: FilePath -> Assistant Bool sanityCheck program = do - whileM (liftIO haswriter) $ do + whileM (liftIO $ haswriter <||> missing) $ do debug [program, "is still being written; waiting"] liftIO $ threadDelaySeconds (Seconds 60) debug [program, "has changed, and seems to be ready to run"] liftIO $ boolSystem program [Param "version"] where + missing = not <$> doesFileExist program haswriter = not . null . filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly]) . map snd3 @@ -89,6 +91,10 @@ sanityCheck program = do handleUpgrade :: UrlRenderer -> Assistant () handleUpgrade urlrenderer = do + -- Wait 2 minutes for any final upgrade changes to settle. + -- (For example, other associated files may be being put into + -- place.) + liftIO $ threadDelaySeconds (Seconds 120) #ifdef WITH_WEBAPP button <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer ConfigFinishUpgradeR void $ addAlert (upgradeReadyAlert button) -- cgit v1.2.3