diff options
author | 2012-08-28 14:04:28 -0400 | |
---|---|---|
committer | 2012-08-28 14:04:28 -0400 | |
commit | 7024a973b222c32f44a7168532afae520e7474ed (patch) | |
tree | 36dc8bccf53e19eecc29d6343b786637e01bf70c /Assistant/Threads/TransferPoller.hs | |
parent | 9ea389ee2f741b4b7af69c02a6376a0a4cf7feb8 (diff) |
add download progress polling thread
Diffstat (limited to 'Assistant/Threads/TransferPoller.hs')
-rw-r--r-- | Assistant/Threads/TransferPoller.hs | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs new file mode 100644 index 000000000..d720bcc45 --- /dev/null +++ b/Assistant/Threads/TransferPoller.hs @@ -0,0 +1,49 @@ +{- git-annex assistant transfer polling thread + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Assistant.Threads.TransferPoller where + +import Assistant.Common +import Assistant.ThreadedMonad +import Assistant.DaemonStatus +import Logs.Transfer +import Utility.NotificationBroadcaster + +import Control.Concurrent +import qualified Data.Map as M + +thisThread :: ThreadName +thisThread = "TransferPoller" + +{- This thread polls the status of ongoing transfers, determining how much + - of each transfer is complete. -} +transferPollerThread :: ThreadState -> DaemonStatusHandle -> IO () +transferPollerThread st dstatus = do + g <- runThreadState st $ fromRepo id + tn <- newNotificationHandle =<< + transferNotifier <$> getDaemonStatus dstatus + forever $ do + threadDelay 500000 -- 0.5 seconds + ts <- currentTransfers <$> getDaemonStatus dstatus + if M.null ts + then waitNotification tn -- block until transfers running + else mapM_ (poll g) $ M.toList ts + where + poll g (t, info) + {- Downloads are polled by checking the size of the + - temp file being used for the transfer. -} + | transferDirection t == Download = do + let f = gitAnnexTmpLocation (transferKey t) g + sz <- catchMaybeIO $ + fromIntegral . fileSize + <$> getFileStatus f + when (bytesComplete info /= sz && isJust sz) $ do + putStrLn $ "download size " ++ show sz + updateTransferInfo dstatus t info + { bytesComplete = sz } + {- can't poll uploads -} + | otherwise = noop |