aboutsummaryrefslogtreecommitdiff
path: root/Assistant/Threads
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-30 15:39:15 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-30 15:39:15 -0400
commit07cd1b2b40735d460c8225762fcf3992b9886c60 (patch)
treec08c38417dfd9cba94ac56e212fa9d5864927ac0 /Assistant/Threads
parentbab7e83221468905b76e28bb123ebe26e146b97b (diff)
pushed Assistant monad down into DaemonStatus code
Currently have three old versions of functions that more reworking is needed to remove: getDaemonStatusOld, modifyDaemonStatusOld_, and modifyDaemonStatusOld
Diffstat (limited to 'Assistant/Threads')
-rw-r--r--Assistant/Threads/ConfigMonitor.hs2
-rw-r--r--Assistant/Threads/MountWatcher.hs2
-rw-r--r--Assistant/Threads/PairListener.hs6
-rw-r--r--Assistant/Threads/SanityChecker.hs9
-rw-r--r--Assistant/Threads/TransferPoller.hs4
-rw-r--r--Assistant/Threads/TransferWatcher.hs10
-rw-r--r--Assistant/Threads/Transferrer.hs13
-rw-r--r--Assistant/Threads/Watcher.hs7
8 files changed, 20 insertions, 33 deletions
diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs
index ce44105df..a1726a361 100644
--- a/Assistant/Threads/ConfigMonitor.hs
+++ b/Assistant/Threads/ConfigMonitor.hs
@@ -74,7 +74,7 @@ reloadConfigs changedconfigs = do
{- Changes to the remote log, or the trust log, can affect the
- syncRemotes list -}
when (Logs.Remote.remoteLog `elem` fs || Logs.Trust.trustLog `elem` fs) $
- liftAnnex . updateSyncRemotes =<< getAssistant daemonStatusHandle
+ updateSyncRemotes
where
(fs, as) = unzip $ filter (flip S.member changedfiles . fst)
configFilesActions
diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs
index 503f9b76c..bb63e840f 100644
--- a/Assistant/Threads/MountWatcher.hs
+++ b/Assistant/Threads/MountWatcher.hs
@@ -177,7 +177,7 @@ remotesUnder dir = do
let (waschanged, rs') = unzip pairs
when (any id waschanged) $ do
liftAnnex $ Annex.changeState $ \s -> s { Annex.remotes = rs' }
- liftAnnex . updateSyncRemotes =<< getAssistant daemonStatusHandle
+ updateSyncRemotes
return $ map snd $ filter fst pairs
where
checkremote repotop r = case Remote.localpath r of
diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs
index b8e5f4683..f682dd6da 100644
--- a/Assistant/Threads/PairListener.hs
+++ b/Assistant/Threads/PairListener.hs
@@ -104,12 +104,12 @@ pairReqReceived :: Bool -> UrlRenderer -> PairMsg -> Assistant ()
pairReqReceived True _ _ = noop -- ignore our own PairReq
pairReqReceived False urlrenderer msg = do
url <- liftIO $ renderUrl urlrenderer (FinishPairR msg) []
- dstatus <- getAssistant daemonStatusHandle
- liftIO $ void $ addAlert dstatus $ pairRequestReceivedAlert repo
+ close <- asIO removeAlert
+ void $ addAlert $ pairRequestReceivedAlert repo
AlertButton
{ buttonUrl = url
, buttonLabel = T.pack "Respond"
- , buttonAction = Just $ removeAlert dstatus
+ , buttonAction = Just close
}
where
repo = pairRepo msg
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index 2ffdc9f32..1871b680e 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -28,14 +28,12 @@ sanityCheckerThread = NamedThread "SanityChecker" $ forever $ do
debug ["sanity check complete"]
where
go = do
- dstatus <- getAssistant daemonStatusHandle
- liftIO $ modifyDaemonStatus_ dstatus $ \s -> s
- { sanityCheckRunning = True }
+ modifyDaemonStatus_ $ \s -> s { sanityCheckRunning = True }
now <- liftIO $ getPOSIXTime -- before check started
r <- either showerr return =<< tryIO <~> check
- liftIO $ modifyDaemonStatus_ dstatus $ \s -> s
+ modifyDaemonStatus_ $ \s -> s
{ sanityCheckRunning = False
, lastSanityCheck = Just now
}
@@ -84,8 +82,7 @@ check = do
slop = fromIntegral tenMinutes
insanity msg = do
liftAnnex $ warning msg
- dstatus <- getAssistant daemonStatusHandle
- liftIO $ void $ addAlert dstatus $ sanityCheckFixAlert msg
+ void $ addAlert $ sanityCheckFixAlert msg
addsymlink file s = do
Watcher.runHandler Watcher.onAddSymlink file s
insanity $ "found unstaged symlink: " ++ file
diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs
index c9e20757d..9118e9be3 100644
--- a/Assistant/Threads/TransferPoller.hs
+++ b/Assistant/Threads/TransferPoller.hs
@@ -52,7 +52,5 @@ transferPollerThread = NamedThread "TransferPoller" $ do
newsize t info sz
| bytesComplete info /= sz && isJust sz =
- withAssistant daemonStatusHandle $ \h ->
- alterTransferInfo h t $
- \i -> i { bytesComplete = sz }
+ alterTransferInfo t $ \i -> i { bytesComplete = sz }
| otherwise = noop
diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs
index a9925c9e5..f18a2acd8 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -64,8 +64,7 @@ onAdd file = case parseTransferFile file of
debug [ "transfer starting:", show t]
r <- headMaybe . filter (sameuuid t)
<$> liftAnnex Remote.remoteList
- dstatus <- getAssistant daemonStatusHandle
- liftIO $ updateTransferInfo dstatus t info { transferRemote = r }
+ updateTransferInfo t info { transferRemote = r }
sameuuid t r = Remote.uuid r == transferUUID t
{- Called when a transfer information file is updated.
@@ -79,9 +78,8 @@ onModify file = do
Just t -> go t =<< liftIO (readTransferInfoFile Nothing file)
where
go _ Nothing = noop
- go t (Just newinfo) = withAssistant daemonStatusHandle $ \h ->
- alterTransferInfo h t $
- \i -> i { bytesComplete = bytesComplete newinfo }
+ go t (Just newinfo) = alterTransferInfo t $
+ \i -> i { bytesComplete = bytesComplete newinfo }
{- This thread can only watch transfer sizes when the DirWatcher supports
- tracking modificatons to files. -}
@@ -94,7 +92,7 @@ onDel file = case parseTransferFile file of
Nothing -> noop
Just t -> do
debug [ "transfer finishing:", show t]
- minfo <- flip removeTransfer t <<~ daemonStatusHandle
+ minfo <- removeTransfer t
finished <- asIO2 finishedTransfer
void $ liftIO $ forkIO $ do
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 6bcb05e0e..c60790f9b 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -32,9 +32,8 @@ transfererThread = NamedThread "Transferr" $ do
program <- liftIO readProgramFile
transferqueue <- getAssistant transferQueue
dstatus <- getAssistant daemonStatusHandle
- slots <- getAssistant transferSlots
starter <- asIO2 $ startTransfer program
- liftIO $ forever $ inTransferSlot dstatus slots $
+ forever $ inTransferSlot $ liftIO $
maybe (return Nothing) (uncurry starter)
=<< getNextTransfer transferqueue dstatus notrunning
where
@@ -48,12 +47,12 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
(Just remote, Just file) -> ifM (liftAnnex $ shouldTransfer t info)
( do
debug [ "Transferring:" , show t ]
- notifyTransfer <<~ daemonStatusHandle
+ notifyTransfer
tp <- asIO2 transferprocess
return $ Just (t, info, tp remote file)
, do
debug [ "Skipping unnecessary transfer:" , show t ]
- void $ flip removeTransfer t <<~ daemonStatusHandle
+ void $ removeTransfer t
return Nothing
)
_ -> return Nothing
@@ -77,10 +76,8 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
- in the transfer.
-}
whenM (liftIO $ (==) ExitSuccess <$> waitForProcess pid) $ do
- dstatus <- getAssistant daemonStatusHandle
- liftIO $ void $ addAlert dstatus $
- makeAlertFiller True $
- transferFileAlert direction True file
+ void $ addAlert $ makeAlertFiller True $
+ transferFileAlert direction True file
recordCommit
where
params =
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 8d155ecb1..7dcde1f46 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -85,9 +85,7 @@ startupScan scanner = do
inRepo $ Git.Command.run "add" [Param "--update"]
showAction "started"
- dstatus <- getAssistant daemonStatusHandle
- liftIO $ modifyDaemonStatus_ dstatus $
- \s -> s { scanComplete = True }
+ modifyDaemonStatus_ $ \s -> s { scanComplete = True }
return (True, r)
@@ -218,8 +216,7 @@ onDelDir dir _ = do
onErr :: Handler
onErr msg _ = do
liftAnnex $ warning msg
- dstatus <- getAssistant daemonStatusHandle
- void $ liftIO $ addAlert dstatus $ warningAlert "watcher" msg
+ void $ addAlert $ warningAlert "watcher" msg
noChange
{- Adds a symlink to the index, without ever accessing the actual symlink