This commit is contained in:
Joey Hess 2013-10-02 22:59:07 -04:00
parent f25991ca33
commit 3ac9c4e672
11 changed files with 52 additions and 54 deletions

View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE DeriveDataTypeable, BangPatterns, CPP #-}
{-# LANGUAGE DeriveDataTypeable, CPP #-}
module Assistant.Threads.Watcher (
watchThread,
@ -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
@ -109,7 +109,7 @@ runWatcher = do
waitFor :: WatcherException -> 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
@ -340,8 +340,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. -}