summaryrefslogtreecommitdiff
path: root/Assistant/Threads/TransferWatcher.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-20 19:29:59 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-20 19:29:59 -0400
commitb48d7747a3ac8bea7d58e8fff8faf791f98699c0 (patch)
treef5662f9161fd3c74c2f6467be270651d92ac3ead /Assistant/Threads/TransferWatcher.hs
parent42e73537d1977eac2da2760647e9131f5c9b9eed (diff)
debugging improvements
add timestamps to debug messages Add lots of debug output in the assistant's threads.
Diffstat (limited to 'Assistant/Threads/TransferWatcher.hs')
-rw-r--r--Assistant/Threads/TransferWatcher.hs25
1 files changed, 20 insertions, 5 deletions
diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs
index 364ce0468..be520aaf9 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -7,7 +7,7 @@
module Assistant.Threads.TransferWatcher where
-import Common.Annex
+import Assistant.Common
import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Logs.Transfer
@@ -16,6 +16,9 @@ import Utility.Types.DirWatcher
import Data.Map as M
+thisThread :: ThreadName
+thisThread = "TransferWatcher"
+
{- This thread watches for changes to the gitAnnexTransferDir,
- and updates the DaemonStatus's map of ongoing transfers. -}
transferWatcherThread :: ThreadState -> DaemonStatusHandle -> IO ()
@@ -30,6 +33,7 @@ transferWatcherThread st dstatus = do
, errHook = hook onErr
}
void $ watchDir dir (const False) hooks id
+ debug thisThread ["watching for transfers"]
type Handler = ThreadState -> DaemonStatusHandle -> FilePath -> Maybe FileStatus -> IO ()
@@ -51,11 +55,17 @@ onErr _ _ msg _ = error msg
onAdd :: Handler
onAdd st dstatus file _ = case parseTransferFile file of
Nothing -> noop
- Just t -> runThreadState st $ go t =<< checkTransfer t
+ Just t -> do
+ runThreadState st $ go t =<< checkTransfer t
where
go _ Nothing = noop -- transfer already finished
- go t (Just info) = adjustTransfers dstatus $
- M.insertWith' merge t info
+ go t (Just info) = do
+ liftIO $ debug thisThread
+ [ "transfer starting:"
+ , show t
+ ]
+ adjustTransfers dstatus $
+ M.insertWith' merge t info
-- preseve transferTid, which is not written to disk
merge new old = new { transferTid = transferTid old }
@@ -63,4 +73,9 @@ onAdd st dstatus file _ = case parseTransferFile file of
onDel :: Handler
onDel st dstatus file _ = case parseTransferFile file of
Nothing -> noop
- Just t -> void $ runThreadState st $ removeTransfer dstatus t
+ Just t -> do
+ debug thisThread
+ [ "transfer finishing:"
+ , show t
+ ]
+ void $ runThreadState st $ removeTransfer dstatus t