mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

got assistant upgrade detection to notice when I build a new version with cabal build!

Browse source
This commit is contained in:
Joey Hess 2013-11-22 23:53:24 -04:00
parent 62e6418e64
commit 56e980215f
1 changed files with 7 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
Assistant/Threads/UpgradeWatcher.hs
View file

@ -40,6 +40,7 @@ upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ go =<< liftIO p
changed <- Just <$> asIO2 (changedFile urlrenderer mvar program) changed <- Just <$> asIO2 (changedFile urlrenderer mvar program)
let hooks = mkWatchHooks let hooks = mkWatchHooks
{ addHook = changed { addHook = changed
, delHook = changed
, addSymlinkHook = changed , addSymlinkHook = changed
, modifyHook = changed , modifyHook = changed
, delDirHook = changed , delDirHook = changed
@ -76,12 +77,13 @@ changedFile urlrenderer mvar program file _status
-} -}
sanityCheck :: FilePath -> Assistant Bool sanityCheck :: FilePath -> Assistant Bool
sanityCheck program = do sanityCheck program = do
whileM (liftIO haswriter) $ do whileM (liftIO $ haswriter <||> missing) $ do
debug [program, "is still being written; waiting"] debug [program, "is still being written; waiting"]
liftIO $ threadDelaySeconds (Seconds 60) liftIO $ threadDelaySeconds (Seconds 60)
debug [program, "has changed, and seems to be ready to run"] debug [program, "has changed, and seems to be ready to run"]
liftIO $ boolSystem program [Param "version"] liftIO $ boolSystem program [Param "version"]
where where
missing = not <$> doesFileExist program
haswriter = not . null haswriter = not . null
. filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly]) . filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly])
. map snd3 . map snd3
@ -89,6 +91,10 @@ sanityCheck program = do
handleUpgrade :: UrlRenderer -> Assistant () handleUpgrade :: UrlRenderer -> Assistant ()
handleUpgrade urlrenderer = do 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 #ifdef WITH_WEBAPP
button <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer ConfigFinishUpgradeR button <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer ConfigFinishUpgradeR
void $ addAlert (upgradeReadyAlert button) void $ addAlert (upgradeReadyAlert button)