diff options
author | Joey Hess <joey@kitenet.net> | 2013-01-27 22:43:05 +1100 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-01-27 22:43:05 +1100 |
commit | 9a58cbabc8fb30b181da48191a87ba6520e0fb0c (patch) | |
tree | b64107b98ecc0d779291cad90fada13d0f6f4bf6 /Assistant/Threads | |
parent | 3bd8fba2db932b7730ba497d60030db6ee6f6405 (diff) |
annex.autocommit
New setting, can be used to disable autocommit of changed files by the
assistant, while it still does data syncing and other tasks.
Also wired into webapp UI
Diffstat (limited to 'Assistant/Threads')
-rw-r--r-- | Assistant/Threads/Watcher.hs | 41 |
1 files changed, 39 insertions, 2 deletions
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 2c61b50f5..9c0439231 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -5,8 +5,11 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE DeriveDataTypeable #-} + module Assistant.Threads.Watcher ( watchThread, + WatcherException(..), checkCanWatch, needLsof, stageSymlink, @@ -38,9 +41,12 @@ import Annex.Content.Direct import Annex.CatFile import Git.Types import Config +import Utility.ThreadScheduler import Data.Bits.Utils +import Data.Typeable import qualified Data.ByteString.Lazy as L +import qualified Control.Exception as E checkCanWatch :: Annex () checkCanWatch @@ -58,8 +64,21 @@ needLsof = error $ unlines , "Be warned: This can corrupt data in the annex, and make fsck complain." ] +{- A special exception that can be thrown to pause or resume the watcher. -} +data WatcherException = PauseWatcher | ResumeWatcher + deriving (Show, Eq, Typeable) + +instance E.Exception WatcherException + watchThread :: NamedThread -watchThread = namedThread "Watcher" $ do +watchThread = namedThread "Watcher" $ + ifM (liftAnnex $ annexAutoCommit <$> Annex.getGitConfig) + ( runWatcher + , waitFor ResumeWatcher runWatcher + ) + +runWatcher :: Assistant () +runWatcher = do startup <- asIO1 startupScan direct <- liftAnnex isDirect addhook <- hook $ if direct then onAddDirect else onAdd @@ -74,11 +93,29 @@ watchThread = namedThread "Watcher" $ do , delDirHook = deldirhook , errHook = errhook } - void $ liftIO $ watchDir "." ignored hooks startup + handle <- liftIO $ watchDir "." ignored hooks startup debug [ "watching", "."] + + {- Let the DirWatcher thread run until signalled to pause it, + - then wait for a resume signal, and restart. -} + waitFor PauseWatcher $ do + liftIO $ stopWatchDir handle + waitFor ResumeWatcher runWatcher where hook a = Just <$> asIO2 (runHandler a) +waitFor :: WatcherException -> Assistant () -> Assistant () +waitFor sig next = do + r <- liftIO $ (E.try pause :: IO (Either E.SomeException ())) + case r of + Left e -> case E.fromException e of + Just s + | s == sig -> next + _ -> noop + _ -> noop + where + pause = runEvery (Seconds 86400) noop + {- Initial scartup scan. The action should return once the scan is complete. -} startupScan :: IO a -> Assistant a startupScan scanner = do |