upload progress bar for git remote on same filesystem

cp is used here, but we can just watch the size of the destination file

This commit made from within the ruins of an old mill, overlooking a
beautiful waterfall.

Assistant/Threads/TransferPoller.hs

@@ -45,5 +45,6 @@ transferPollerThread st dstatus = thread $ do
 				when (bytesComplete info /= sz && isJust sz) $
 					alterTransferInfo dstatus t $
 						\i -> i { bytesComplete = sz }
-			{- can't poll uploads -}
+			{- Can't poll uploads, instead the upload code
+			 - updates the files. -}
 			| otherwise = noop

Remote/Git.hs

@@ -37,6 +37,8 @@ import Init
 import Types.Key
 import qualified Fields
 
+import Control.Concurrent
+
 remote :: RemoteType
 remote = RemoteType {
 	typename = "git",
@@ -297,13 +299,27 @@ rsyncHelper callback params = do
  - filesystem. Then cp could be faster. -}
 rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> ProgressCallback -> Annex Bool
 rsyncOrCopyFile rsyncparams src dest p =
-	ifM (sameDeviceIds src dest)
+	ifM (sameDeviceIds src dest) (dorsync, docopy)
-		( liftIO $ copyFileExternal src dest
-		, rsyncHelper (Just p) $ rsyncparams ++ [Param src, Param dest]
-		)
 	where
 		sameDeviceIds a b = (==) <$> (getDeviceId a) <*> (getDeviceId b)
 		getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
+		dorsync = rsyncHelper (Just p) $
+			rsyncparams ++ [Param src, Param dest]
+		docopy = liftIO $ bracket
+			(forkIO $ watchfilesize 0)
+			(void . tryIO . killThread)
+			(const $ copyFileExternal src dest)
+		watchfilesize oldsz = do
+			threadDelay 500000 -- 0.5 seconds
+			v <- catchMaybeIO $
+				fromIntegral . fileSize
+					<$> getFileStatus dest
+			case v of
+				Just sz
+					| sz /= oldsz -> do
+						p sz
+						watchfilesize sz
+				_ -> watchfilesize oldsz
 
 {- Generates rsync parameters that ssh to the remote and asks it
  - to either receive or send the key's content. -}