diff options
Diffstat (limited to 'Assistant/Threads')
| -rw-r--r-- | Assistant/Threads/Committer.hs | 21 | ||||
| -rw-r--r-- | Assistant/Threads/Pusher.hs | 12 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 5 | ||||
| -rw-r--r-- | Assistant/Threads/TransferScanner.hs | 4 | ||||
| -rw-r--r-- | Assistant/Threads/Watcher.hs | 4 |
5 files changed, 19 insertions, 27 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 7bcdaa836..b3a737872 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -58,8 +58,7 @@ commitThread = NamedThread "Committer" $ do , show (length readychanges) , "changes" ] - dstatus <- getAssistant daemonStatusHandle - void $ alertWhile dstatus commitAlert <~> + void $ alertWhile commitAlert $ liftAnnex commitStaged recordCommit <<~ commitChan else refill readychanges @@ -177,21 +176,19 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do add :: Change -> Assistant (Maybe Change) add change@(InProcessAddChange { keySource = ks }) = do - dstatus <- getAssistant daemonStatusHandle - alertWhile' dstatus (addFileAlert $ keyFilename ks) <~> add' change ks - add _ = return Nothing - - add' change ks = liftM ret $ catchMaybeIO <~> do - sanitycheck ks $ do - key <- liftAnnex $ do - showStart "add" $ keyFilename ks - Command.Add.ingest ks - done (finishedChange change) (keyFilename ks) key + alertWhile' (addFileAlert $ keyFilename ks) $ + liftM ret $ catchMaybeIO <~> do + sanitycheck ks $ do + key <- liftAnnex $ do + showStart "add" $ keyFilename ks + Command.Add.ingest ks + done (finishedChange change) (keyFilename ks) key where {- Add errors tend to be transient and will be automatically - dealt with, so don't pass to the alert code. -} ret (Just j@(Just _)) = (True, j) ret _ = (True, Nothing) + add _ = return Nothing done _ _ Nothing = do liftAnnex showEndFail diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index 0235e6efc..95e4e1276 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -31,9 +31,8 @@ pushRetryThread = NamedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do topush <- liftIO $ getFailedPushesBefore pushmap (fromIntegral halfhour) unless (null topush) $ do debug ["retrying", show (length topush), "failed pushes"] - now <- liftIO $ getCurrentTime - dstatus <- getAssistant daemonStatusHandle - void $ alertWhile dstatus (pushRetryAlert topush) <~> + void $ alertWhile (pushRetryAlert topush) $ do + now <- liftIO $ getCurrentTime pushToRemotes now True topush where halfhour = 1800 @@ -48,10 +47,9 @@ pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do if shouldPush commits then do remotes <- filter pushable . syncRemotes <$> daemonStatus - unless (null remotes) $ do - now <- liftIO $ getCurrentTime - dstatus <- getAssistant daemonStatusHandle - void $ alertWhile dstatus (pushAlert remotes) <~> + unless (null remotes) $ + void $ alertWhile (pushAlert remotes) $ do + now <- liftIO $ getCurrentTime pushToRemotes now True remotes else do debug ["delaying push of", show (length commits), "commits"] diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index d92c6c394..46f399dab 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -24,10 +24,7 @@ sanityCheckerThread = NamedThread "SanityChecker" $ forever $ do waitForNextCheck debug ["starting sanity check"] - - dstatus <- getAssistant daemonStatusHandle - void $ alertWhile dstatus sanityCheckAlert <~> go - + void $ alertWhile sanityCheckAlert go debug ["sanity check complete"] where go = do diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 8c46a79fa..3e99b60f5 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -100,10 +100,10 @@ failedTransferScan r = do expensiveScan :: [Remote] -> Assistant () expensiveScan rs = unless onlyweb $ do debug ["starting scan of", show visiblers] - dstatus <- getAssistant daemonStatusHandle - void $ alertWhile dstatus (scanAlert visiblers) <~> do + void $ alertWhile (scanAlert visiblers) $ do g <- liftAnnex gitRepo (files, cleanup) <- liftIO $ LsFiles.inRepo [] g + dstatus <- getAssistant daemonStatusHandle forM_ files $ \f -> do ts <- liftAnnex $ ifAnnexed f (findtransfers dstatus f) (return []) diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 172b7976e..1c796a521 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -75,8 +75,7 @@ watchThread = NamedThread "Watcher" $ do startupScan :: IO a -> Assistant a startupScan scanner = do liftAnnex $ showAction "scanning" - dstatus <- getAssistant daemonStatusHandle - alertWhile' dstatus startupScanAlert <~> do + alertWhile' startupScanAlert $ do r <- liftIO $ scanner -- Notice any files that were deleted before @@ -85,6 +84,7 @@ startupScan scanner = do inRepo $ Git.Command.run "add" [Param "--update"] showAction "started" + dstatus <- getAssistant daemonStatusHandle liftIO $ modifyDaemonStatus_ dstatus $ \s -> s { scanComplete = True } |