diff options
| -rw-r--r-- | Command/Watch.hs | 16 | ||||
| -rw-r--r-- | Utility/Inotify.hs | 32 |
2 files changed, 32 insertions, 16 deletions
diff --git a/Command/Watch.hs b/Command/Watch.hs index b38c04d2c..046777685 100644 --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -44,8 +44,11 @@ start = notBareRepo $ do gitdir dir = takeFileName dir /= ".git" {- Inotify events are run in separate threads, and so each is a - - self-contained Annex monad. Exceptions by the handlers are ignored, - - otherwise a whole watcher thread could be crashed. -} + - self-contained Annex monad. + - + - Exceptions by the handlers are ignored, + - otherwise a whole watcher thread could be crashed. + -} run :: Annex.AnnexState -> (FilePath -> Annex a) -> FilePath -> IO () run startstate a f = do r <- E.try go :: IO (Either E.SomeException ()) @@ -89,10 +92,11 @@ onAddSymlink file = go =<< Backend.lookupFile file [Params "--force --", File file] onDel :: FilePath -> Annex () -onDel file = liftIO $ print $ "del " ++ file +onDel file = inRepo $ Git.Command.run "rm" + [Params "--quiet --cached --", File file] -{- A directory has been deleted, so tell git to remove anything that - was inside it from its cache. -} +{- A directory has been deleted, or moved, so tell git to remove anything + - that was inside it from its cache. -} onDelDir :: FilePath -> Annex () onDelDir dir = inRepo $ Git.Command.run "rm" - [Params "--quiet -r --cached --", File dir] + [Params "--quiet -r --cached --ignore-unmatch --", File dir] diff --git a/Utility/Inotify.hs b/Utility/Inotify.hs index 2dcc1ed64..ff3de81b1 100644 --- a/Utility/Inotify.hs +++ b/Utility/Inotify.hs @@ -15,6 +15,7 @@ import qualified System.Posix.Files as Files import System.Posix.Terminal import Control.Concurrent.MVar import System.Posix.Signals +import Control.Exception as E type Hook = Maybe (FilePath -> IO ()) @@ -51,10 +52,13 @@ type Hook = Maybe (FilePath -> IO ()) watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> Hook -> Hook -> Hook -> Hook -> IO () watchDir i dir ignored add addsymlink del deldir | ignored dir = noop - | otherwise = void $ do - _ <- addWatch i watchevents dir go - mapM walk =<< filter (not . dirCruft) <$> - getDirectoryContents dir + | otherwise = do + mvar <- newEmptyMVar + void $ addWatch i watchevents dir $ \event -> + serialized mvar (void $ go event) + serialized mvar $ + mapM_ walk =<< filter (not . dirCruft) <$> + getDirectoryContents dir where recurse d = watchDir i d ignored add addsymlink del deldir @@ -117,14 +121,22 @@ watchDir i dir ignored add addsymlink del deldir filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir f) +{- Uses an MVar to serialize an action, so that only one thread at a time + - runs it. -} +serialized :: MVar () -> IO () -> IO () +serialized mvar a = void $ do + putMVar mvar () -- blocks if action already running + _ <- E.try a :: IO (Either E.SomeException ()) + takeMVar mvar -- allow next action to run + {- Pauses the main thread, letting children run until program termination. -} waitForTermination :: IO () waitForTermination = do - mv <- newEmptyMVar - check softwareTermination mv + mvar <- newEmptyMVar + check softwareTermination mvar whenM (queryTerminal stdInput) $ - check keyboardSignal mv - takeMVar mv + check keyboardSignal mvar + takeMVar mvar where - check sig mv = void $ - installHandler sig (CatchOnce $ putMVar mv ()) Nothing + check sig mvar = void $ + installHandler sig (CatchOnce $ putMVar mvar ()) Nothing |