diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-29 02:21:04 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-29 02:21:04 -0400 |
commit | 579f63b6b756ca51b8f9fe53c3e668500718d91f (patch) | |
tree | 20039581df67e034ef434749d37de41e9802d21d /Assistant/Threads/TransferWatcher.hs | |
parent | 040f68d628120e112e22bfb7100f9650dec940c8 (diff) |
Assistant monad, stage 2.5
Converted several threads to run in the monad.
Added a lot of useful combinators for working with the monad.
Now the monad includes the name of the thread.
Some debugging messages are disabled pending converting other threads.
Diffstat (limited to 'Assistant/Threads/TransferWatcher.hs')
-rw-r--r-- | Assistant/Threads/TransferWatcher.hs | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index 168ff2688..bb195e519 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -26,7 +26,7 @@ thisThread = "TransferWatcher" {- This thread watches for changes to the gitAnnexTransferDir, - and updates the DaemonStatus's map of ongoing transfers. -} transferWatcherThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> NamedThread -transferWatcherThread st dstatus transferqueue = thread $ do +transferWatcherThread st dstatus transferqueue = thread $ liftIO $ do g <- runThreadState st gitRepo let dir = gitAnnexTransferDir g createDirectoryIfMissing True dir @@ -38,7 +38,7 @@ transferWatcherThread st dstatus transferqueue = thread $ do , errHook = hook onErr } void $ watchDir dir (const False) hooks id - debug thisThread ["watching for transfers"] + brokendebug thisThread ["watching for transfers"] where thread = NamedThread thisThread @@ -66,7 +66,7 @@ onAdd st dstatus _ file _ = case parseTransferFile file of where go _ Nothing = noop -- transfer already finished go t (Just info) = do - debug thisThread + brokendebug thisThread [ "transfer starting:" , show t ] @@ -87,8 +87,9 @@ onModify _ dstatus _ file _ = do Just t -> go t =<< readTransferInfoFile Nothing file where go _ Nothing = noop - go t (Just newinfo) = alterTransferInfo dstatus t $ \info -> - info { bytesComplete = bytesComplete newinfo } + go t (Just newinfo) = alterTransferInfo t + (\i -> i { bytesComplete = bytesComplete newinfo }) + dstatus {- This thread can only watch transfer sizes when the DirWatcher supports - tracking modificatons to files. -} @@ -100,7 +101,7 @@ onDel :: Handler onDel st dstatus transferqueue file _ = case parseTransferFile file of Nothing -> noop Just t -> do - debug thisThread + brokendebug thisThread [ "transfer finishing:" , show t ] |