summaryrefslogtreecommitdiff
path: root/Assistant/Threads/Watcher.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-28 18:02:11 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-28 18:02:11 -0400
commit3cc18857936e5a09e033439971dc9c43e6ccbaa2 (patch)
treea817de04aa65271b3036370d447cf1b228a4bffb /Assistant/Threads/Watcher.hs
parenta17fde22fabdb706086ac945bc331e32527b58bd (diff)
move DaemonStatus manipulation out of the Annex monad to IO
I've convinced myself that nothing in DaemonStatus can deadlock, as it always keepts the TMVar full. That was the only reason it was in the Annex monad.
Diffstat (limited to 'Assistant/Threads/Watcher.hs')
-rw-r--r--Assistant/Threads/Watcher.hs9
1 files changed, 4 insertions, 5 deletions
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 31025361b..ab57bf04a 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -76,8 +76,7 @@ statupScan st dstatus scanner = do
runThreadState st $
showAction "scanning"
r <- scanner
- runThreadState st $
- modifyDaemonStatus_ dstatus $ \s -> s { scanComplete = True }
+ modifyDaemonStatus_ dstatus $ \s -> s { scanComplete = True }
-- Notice any files that were deleted before watching was started.
runThreadState st $ do
@@ -132,7 +131,7 @@ runHandler threadname st dstatus transferqueue changechan handler file filestatu
onAdd :: Handler
onAdd threadname file filestatus dstatus _
| maybe False isRegularFile filestatus = do
- ifM (scanComplete <$> getDaemonStatus dstatus)
+ ifM (scanComplete <$> liftIO (getDaemonStatus dstatus))
( go
, ifM (null <$> inRepo (Git.LsFiles.notInRepo False [file]))
( noChange
@@ -156,7 +155,7 @@ onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.l
link <- calcGitLink file key
ifM ((==) link <$> liftIO (readSymbolicLink file))
( do
- s <- getDaemonStatus dstatus
+ s <- liftIO $ getDaemonStatus dstatus
checkcontent key s
ensurestaged link s
, do
@@ -167,7 +166,7 @@ onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.l
)
go Nothing = do -- other symlink
link <- liftIO (readSymbolicLink file)
- ensurestaged link =<< getDaemonStatus dstatus
+ ensurestaged link =<< liftIO (getDaemonStatus dstatus)
{- This is often called on symlinks that are already
- staged correctly. A symlink may have been deleted