blob: cbfefdbbc93d052052a80d6534731bd55324cd85 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
{- git-annex assistant thread to detect when git-annex binary is changed
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Assistant.Threads.UpgradeWatcher (
upgradWatcherThread
) where
import Assistant.Common
import Utility.DirWatcher
import Utility.DirWatcher.Types
import Config.Files
import Control.Concurrent.MVar
data WatcherState = InStartupScan | Started | Upgrading
deriving (Eq)
upgradWatcherThread :: NamedThread
upgradWatcherThread = namedThread "UpgradeWatcher" $ go =<< liftIO programPath
where
go Nothing = debug [ "cannot determine program path" ]
go (Just program) = do
mvar <- liftIO $ newMVar InStartupScan
changed <- Just <$> asIO2 (changedFile mvar program)
let hooks = mkWatchHooks
{ addHook = changed
, addSymlinkHook = changed
, modifyHook = changed
, delDirHook = changed
}
let dir = parentDir program
let depth = length (splitPath dir) + 1
let nosubdirs f = length (splitPath f) == depth
void $ liftIO $ watchDir dir nosubdirs hooks (startup mvar)
-- Ignore bogus events generated during the startup scan.
startup mvar scanner = do
r <- scanner
void $ swapMVar mvar Started
return r
changedFile :: MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant ()
changedFile mvar program file _status
| program == file = do
state <- liftIO $ readMVar mvar
when (state == Started) $
debug [ "saw change to", file ]
| otherwise = noop
|
