summaryrefslogtreecommitdiff
path: root/Assistant/Threads
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/Threads')
-rw-r--r--Assistant/Threads/Committer.hs12
-rw-r--r--Assistant/Threads/ConfigMonitor.hs4
-rw-r--r--Assistant/Threads/Merger.hs2
-rw-r--r--Assistant/Threads/Pusher.hs5
-rw-r--r--Assistant/Threads/TransferScanner.hs8
-rw-r--r--Assistant/Threads/Transferrer.hs2
-rw-r--r--Assistant/Threads/Watcher.hs17
-rw-r--r--Assistant/Threads/WebApp.hs2
8 files changed, 26 insertions, 26 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index b3a737872..79b3812ee 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -11,6 +11,7 @@ module Assistant.Threads.Committer where
import Assistant.Common
import Assistant.Changes
+import Assistant.Types.Changes
import Assistant.Commits
import Assistant.Alert
import Assistant.Threads.Watcher
@@ -45,7 +46,7 @@ commitThread = NamedThread "Committer" $ do
-- We already waited one second as a simple rate limiter.
-- Next, wait until at least one change is available for
-- processing.
- changes <- getChanges <<~ changeChan
+ changes <- getChanges
-- Now see if now's a good time to commit.
time <- liftIO getCurrentTime
if shouldCommit time changes
@@ -60,14 +61,14 @@ commitThread = NamedThread "Committer" $ do
]
void $ alertWhile commitAlert $
liftAnnex commitStaged
- recordCommit <<~ commitChan
+ recordCommit
else refill readychanges
else refill changes
where
refill [] = noop
refill cs = do
debug ["delaying commit of", show (length cs), "changes"]
- flip refillChanges cs <<~ changeChan
+ refillChanges cs
commitStaged :: Annex Bool
commitStaged = do
@@ -148,15 +149,14 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
(postponed, toadd) <- partitionEithers <$> safeToAdd delayadd pending' inprocess
unless (null postponed) $
- flip refillChanges postponed <<~ changeChan
+ refillChanges postponed
returnWhen (null toadd) $ do
added <- catMaybes <$> forM toadd add
if DirWatcher.eventsCoalesce || null added
then return $ added ++ otherchanges
else do
- r <- handleAdds delayadd
- =<< getChanges <<~ changeChan
+ r <- handleAdds delayadd =<< getChanges
return $ r ++ added ++ otherchanges
where
(incomplete, otherchanges) = partition (\c -> isPendingAddChange c || isInProcessAddChange c) cs
diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs
index fe98b10e8..ce44105df 100644
--- a/Assistant/Threads/ConfigMonitor.hs
+++ b/Assistant/Threads/ConfigMonitor.hs
@@ -39,7 +39,7 @@ configMonitorThread = NamedThread "ConfigMonitor" $ loop =<< getConfigs
where
loop old = do
liftIO $ threadDelaySeconds (Seconds 60)
- waitBranchChange <<~ branchChangeHandle
+ waitBranchChange
new <- getConfigs
when (old /= new) $ do
let changedconfigs = new `S.difference` old
@@ -48,7 +48,7 @@ configMonitorThread = NamedThread "ConfigMonitor" $ loop =<< getConfigs
reloadConfigs new
{- Record a commit to get this config
- change pushed out to remotes. -}
- recordCommit <<~ commitChan
+ recordCommit
loop new
{- Config files, and their checksums. -}
diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs
index a766c5977..46511701c 100644
--- a/Assistant/Threads/Merger.hs
+++ b/Assistant/Threads/Merger.hs
@@ -66,7 +66,7 @@ onAdd :: Handler
onAdd file
| ".lock" `isSuffixOf` file = noop
| isAnnexBranch file = do
- branchChanged <<~ branchChangeHandle
+ branchChanged
transferqueue <- getAssistant transferQueue
dstatus <- getAssistant daemonStatusHandle
liftAnnex $
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs
index c87df1610..905cf81db 100644
--- a/Assistant/Threads/Pusher.hs
+++ b/Assistant/Threads/Pusher.hs
@@ -9,6 +9,7 @@ module Assistant.Threads.Pusher where
import Assistant.Common
import Assistant.Commits
+import Assistant.Types.Commits
import Assistant.Pushes
import Assistant.Alert
import Assistant.DaemonStatus
@@ -41,7 +42,7 @@ pushThread :: NamedThread
pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do
-- We already waited two seconds as a simple rate limiter.
-- Next, wait until at least one commit has been made
- commits <- getCommits <<~ commitChan
+ commits <- getCommits
-- Now see if now's a good time to push.
if shouldPush commits
then do
@@ -52,7 +53,7 @@ pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do
pushToRemotes now True remotes
else do
debug ["delaying push of", show (length commits), "commits"]
- flip refillCommits commits <<~ commitChan
+ refillCommits commits
where
pushable r
| Remote.specialRemote r = False
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 3e99b60f5..ec0bc0d9b 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -8,6 +8,7 @@
module Assistant.Threads.TransferScanner where
import Assistant.Common
+import Assistant.Types.ScanRemotes
import Assistant.ScanRemotes
import Assistant.TransferQueue
import Assistant.DaemonStatus
@@ -36,7 +37,7 @@ transferScannerThread = NamedThread "TransferScanner" $ do
where
go scanned = do
liftIO $ threadDelaySeconds (Seconds 2)
- (rs, infos) <- unzip <$> getScanRemote <<~ scanRemoteMap
+ (rs, infos) <- unzip <$> getScanRemote
if any fullScan infos || any (`S.notMember` scanned) rs
then do
expensiveScan rs
@@ -56,10 +57,7 @@ transferScannerThread = NamedThread "TransferScanner" $ do
- and then the system (or us) crashed, and that info was
- lost.
-}
- startupScan = do
- scanremotes <- getAssistant scanRemoteMap
- liftIO . addScanRemotes scanremotes True
- =<< syncRemotes <$> daemonStatus
+ startupScan = addScanRemotes True =<< syncRemotes <$> daemonStatus
{- This is a cheap scan for failed transfers involving a remote. -}
failedTransferScan :: Remote -> Assistant ()
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 145abe86d..6bcb05e0e 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -81,7 +81,7 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
liftIO $ void $ addAlert dstatus $
makeAlertFiller True $
transferFileAlert direction True file
- recordCommit <<~ commitChan
+ recordCommit
where
params =
[ Param "transferkey"
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 1c796a521..dee71b731 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -17,6 +17,7 @@ module Assistant.Threads.Watcher (
import Assistant.Common
import Assistant.DaemonStatus
import Assistant.Changes
+import Assistant.Types.Changes
import Assistant.TransferQueue
import Assistant.Alert
import Assistant.Drop
@@ -114,12 +115,12 @@ runHandler handler file filestatus = void $ do
-- Just in case the commit thread is not
-- flushing the queue fast enough.
liftAnnex $ Annex.Queue.flushWhenFull
- flip recordChange change <<~ changeChan
+ recordChange change
onAdd :: Handler
onAdd file filestatus
- | maybe False isRegularFile filestatus = liftIO $ pendingAddChange file
- | otherwise = liftIO $ noChange
+ | maybe False isRegularFile filestatus = pendingAddChange file
+ | otherwise = noChange
{- A symlink might be an arbitrary symlink, which is just added.
- Or, if it is a git-annex symlink, ensure it points to the content
@@ -160,7 +161,7 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file)
| scanComplete daemonstatus = addlink link
| otherwise = case filestatus of
Just s
- | not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> liftIO noChange
+ | not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange
_ -> addlink link
{- For speed, tries to reuse the existing blob for symlink target. -}
@@ -176,7 +177,7 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file)
sha <- inRepo $
Git.HashObject.hashObject BlobObject link
stageSymlink file sha
- liftIO $ madeChange file LinkChange
+ madeChange file LinkChange
{- When a new link appears, or a link is changed, after the startup
- scan, handle getting or dropping the key's content. -}
@@ -197,7 +198,7 @@ onDel file _ = do
liftAnnex $
Annex.Queue.addUpdateIndex =<<
inRepo (Git.UpdateIndex.unstageFile file)
- liftIO $ madeChange file RmChange
+ madeChange file RmChange
{- A directory has been deleted, or moved, so tell git to remove anything
- that was inside it from its cache. Since it could reappear at any time,
@@ -211,7 +212,7 @@ onDelDir dir _ = do
debug ["directory deleted", dir]
liftAnnex $ Annex.Queue.addCommand "rm"
[Params "--quiet -r --cached --ignore-unmatch --"] [dir]
- liftIO $ madeChange dir RmDirChange
+ madeChange dir RmDirChange
{- Called when there's an error with inotify or kqueue. -}
onErr :: Handler
@@ -219,7 +220,7 @@ onErr msg _ = do
liftAnnex $ warning msg
dstatus <- getAssistant daemonStatusHandle
void $ liftIO $ addAlert dstatus $ warningAlert "watcher" msg
- liftIO noChange
+ noChange
{- Adds a symlink to the index, without ever accessing the actual symlink
- on disk. This avoids a race if git add is used, where the symlink is
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 126c78166..be9a9a16f 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -27,7 +27,7 @@ import Assistant.WebApp.Configurators.S3
import Assistant.WebApp.Configurators.XMPP
import Assistant.WebApp.Documentation
import Assistant.WebApp.OtherRepos
-import Assistant.ThreadedMonad
+import Assistant.Types.ThreadedMonad
import Utility.WebApp
import Utility.FileMode
import Utility.TempFile
generated by cgit v1.2.3 (git 2.39.1) at 2024-10-20 20:34:16 +0000