diff options
Diffstat (limited to 'Assistant/Threads/Watcher.hs')
| -rw-r--r-- | Assistant/Threads/Watcher.hs | 37 |
1 files changed, 20 insertions, 17 deletions
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index ef8bcd41f..6a56eadbb 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -5,11 +5,11 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE DeriveDataTypeable, BangPatterns, CPP #-} +{-# LANGUAGE DeriveDataTypeable, CPP #-} module Assistant.Threads.Watcher ( watchThread, - WatcherException(..), + WatcherControl(..), checkCanWatch, needLsof, onAddSymlink, @@ -23,7 +23,7 @@ import Assistant.Types.Changes import Assistant.Alert import Utility.DirWatcher import Utility.DirWatcher.Types -import Utility.Lsof +import qualified Utility.Lsof as Lsof import qualified Annex import qualified Annex.Queue import qualified Git @@ -50,7 +50,7 @@ import Data.Time.Clock checkCanWatch :: Annex () checkCanWatch | canWatch = do - liftIO setupLsof + liftIO Lsof.setup unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force) needLsof | otherwise = error "watch mode is not available on this system" @@ -64,10 +64,10 @@ needLsof = error $ unlines ] {- A special exception that can be thrown to pause or resume the watcher. -} -data WatcherException = PauseWatcher | ResumeWatcher +data WatcherControl = PauseWatcher | ResumeWatcher deriving (Show, Eq, Typeable) -instance E.Exception WatcherException +instance E.Exception WatcherControl watchThread :: NamedThread watchThread = namedThread "Watcher" $ @@ -79,7 +79,7 @@ watchThread = namedThread "Watcher" $ runWatcher :: Assistant () runWatcher = do startup <- asIO1 startupScan - matcher <- liftAnnex $ largeFilesMatcher + matcher <- liftAnnex largeFilesMatcher direct <- liftAnnex isDirect symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig addhook <- hook $ if direct @@ -107,9 +107,9 @@ runWatcher = do where hook a = Just <$> asIO2 (runHandler a) -waitFor :: WatcherException -> Assistant () -> Assistant () +waitFor :: WatcherControl -> Assistant () -> Assistant () waitFor sig next = do - r <- liftIO $ (E.try pause :: IO (Either E.SomeException ())) + r <- liftIO (E.try pause :: IO (Either E.SomeException ())) case r of Left e -> case E.fromException e of Just s @@ -124,7 +124,7 @@ startupScan :: IO a -> Assistant a startupScan scanner = do liftAnnex $ showAction "scanning" alertWhile' startupScanAlert $ do - r <- liftIO $ scanner + r <- liftIO scanner -- Notice any files that were deleted before -- watching was started. @@ -133,7 +133,7 @@ startupScan scanner = do forM_ fs $ \f -> do liftAnnex $ onDel' f maybe noop recordChange =<< madeChange f RmChange - void $ liftIO $ cleanup + void $ liftIO cleanup liftAnnex $ showAction "started" liftIO $ putStrLn "" @@ -176,7 +176,7 @@ runHandler handler file filestatus = void $ do Right (Just change) -> do -- Just in case the commit thread is not -- flushing the queue fast enough. - liftAnnex $ Annex.Queue.flushWhenFull + liftAnnex Annex.Queue.flushWhenFull recordChange change where normalize f @@ -200,6 +200,9 @@ onAdd matcher file filestatus add matcher file | otherwise = noChange +shouldRestage :: DaemonStatus -> Bool +shouldRestage ds = scanComplete ds || forceRestage ds + {- In direct mode, add events are received for both new files, and - modified existing files. -} @@ -214,7 +217,7 @@ onAddDirect symlinkssupported matcher file fs = do - really modified, but it might have - just been deleted and been put back, - so it symlink is restaged to make sure. -} - ( ifM (scanComplete <$> getDaemonStatus) + ( ifM (shouldRestage <$> getDaemonStatus) ( do link <- liftAnnex $ inRepo $ gitAnnexLink file key addLink file link (Just key) @@ -286,7 +289,7 @@ onAddSymlink' linktarget mk isdirect file filestatus = go mk - links too.) -} ensurestaged (Just link) daemonstatus - | scanComplete daemonstatus = addLink file link mk + | shouldRestage daemonstatus = addLink file link mk | otherwise = case filestatus of Just s | not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange @@ -300,7 +303,7 @@ addLink file link mk = do liftAnnex $ do v <- catObjectDetails $ Ref $ ':':file case v of - Just (currlink, sha) + Just (currlink, sha, _type) | s2w8 link == L.unpack currlink -> stageSymlink file sha _ -> stageSymlink file =<< hashSymlink link @@ -340,8 +343,8 @@ onDelDir dir _ = do now <- liftIO getCurrentTime recordChanges $ map (\f -> Change now f RmChange) fs - void $ liftIO $ clean - liftAnnex $ Annex.Queue.flushWhenFull + void $ liftIO clean + liftAnnex Annex.Queue.flushWhenFull noChange {- Called when there's an error with inotify or kqueue. -} |