add desktop notifications

Motivation: Hook scripts for nautilus or other file managers
need to provide the user with feedback that a file is being downloaded.

This commit was sponsored by THM Schoemaker.

Command/AddUrl.hs

@@ -26,7 +26,7 @@ import Types.KeySource
 import Config
 import Annex.Content.Direct
 import Logs.Location
-import qualified Logs.Transfer as Transfer
+import qualified Annex.Transfer as Transfer
 #ifdef WITH_QUVI
 import Annex.Quvi
 import qualified Utility.Quvi as Quvi
@@ -116,9 +116,10 @@ addUrlFileQuvi relaxed quviurl videourl file = do
 			prepGetViaTmpChecked sizedkey $ do
 				tmp <- fromRepo $ gitAnnexTmpObjectLocation key
 				showOutput
-				ok <- Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do
-					liftIO $ createDirectoryIfMissing True (parentDir tmp)
-					downloadUrl [videourl] tmp
+				ok <- Transfer.notifyTransfer Transfer.Download (Just file) $
+					Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do
+						liftIO $ createDirectoryIfMissing True (parentDir tmp)
+						downloadUrl [videourl] tmp
 				if ok
 					then cleanup quviurl file key (Just tmp)
 					else return False
@@ -179,7 +180,7 @@ download url file = do
 			, return False
 			)
   where
-  	runtransfer dummykey tmp = 
+  	runtransfer dummykey tmp =  Transfer.notifyTransfer Transfer.Download (Just file) $
 		Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ const $ do
 			liftIO $ createDirectoryIfMissing True (parentDir tmp)
 			downloadUrl [url] tmp

Command/Get.hs

@@ -11,7 +11,7 @@ import Common.Annex
 import Command
 import qualified Remote
 import Annex.Content
-import Logs.Transfer
+import Annex.Transfer
 import Config.NumCopies
 import Annex.Wanted
 import qualified Command.Move
@@ -69,15 +69,15 @@ getKeyFile' key afile dest = dispatch
 		showNote "not available"
 		showlocs
 		return False
-	dispatch remotes = trycopy remotes remotes
-	trycopy full [] = do
+	dispatch remotes = notifyTransfer Download afile $ trycopy remotes remotes
+	trycopy full [] _ = do
 		Remote.showTriedRemotes full
 		showlocs
 		return False
-	trycopy full (r:rs) =
+	trycopy full (r:rs) witness =
 		ifM (probablyPresent r)
-			( docopy r (trycopy full rs)
-			, trycopy full rs
+			( docopy r witness <||> trycopy full rs witness
+			, trycopy full rs witness
 			)
 	showlocs = Remote.showLocations key []
 		"No other repository is known to contain the file."
@@ -87,8 +87,6 @@ getKeyFile' key afile dest = dispatch
 		| Remote.hasKeyCheap r =
 			either (const False) id <$> Remote.hasKey r key
 		| otherwise = return True
-	docopy r continue = do
-		ok <- download (Remote.uuid r) key afile noRetry $ \p -> do
-			showAction $ "from " ++ Remote.name r
-			Remote.retrieveKeyFile r key afile dest p
-		if ok then return ok else continue
+	docopy r = download (Remote.uuid r) key afile noRetry $ \p -> do
+		showAction $ "from " ++ Remote.name r
+		Remote.retrieveKeyFile r key afile dest p

Command/List.hs

@@ -38,7 +38,7 @@ seek ps = do
 
 getList :: Annex [(UUID, RemoteName, TrustLevel)]
 getList = ifM (Annex.getFlag $ optionName allrepos)
-	( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAll)
+	( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)
 	, getRemotes
 	)
   where
@@ -48,7 +48,7 @@ getList = ifM (Annex.getFlag $ optionName allrepos)
 		hereu <- getUUID
 		heretrust <- lookupTrust hereu
 		return $ (hereu, "here", heretrust) : zip3 (map uuid rs) (map name rs) ts
-	getAll = do
+	getAllUUIDs = do
 		rs <- M.toList <$> uuidMap
 		rs3 <- forM rs $ \(u, n) -> (,,)
 			<$> pure u

Command/Move.hs

@@ -14,8 +14,8 @@ import qualified Annex
 import Annex.Content
 import qualified Remote
 import Annex.UUID
+import Annex.Transfer
 import Logs.Presence
-import Logs.Transfer
 
 def :: [Command]
 def = [withOptions moveOptions $ command "move" paramPaths seek
@@ -98,8 +98,9 @@ toPerform dest move key afile fastcheck isthere = moveLock move key $
 			stop
 		Right False -> do
 			showAction $ "to " ++ Remote.name dest
-			ok <- upload (Remote.uuid dest) key afile noRetry $
-				Remote.storeKey dest key afile
+			ok <- notifyTransfer Upload afile $
+				upload (Remote.uuid dest) key afile noRetry $
+					Remote.storeKey dest key afile
 			if ok
 				then do
 					Remote.logStatus dest key InfoPresent
@@ -155,9 +156,10 @@ fromPerform src move key afile = moveLock move key $
 		, handle move =<< go
 		)
   where
-	go = download (Remote.uuid src) key afile noRetry $ \p -> do
-		showAction $ "from " ++ Remote.name src
-		getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p
+	go = notifyTransfer Download afile $ 
+		download (Remote.uuid src) key afile noRetry $ \p -> do
+			showAction $ "from " ++ Remote.name src
+			getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p
 	handle _ False = stop -- failed
 	handle False True = next $ return True -- copy complete
 	handle True True = do -- finish moving

Command/SendKey.hs

@@ -12,7 +12,7 @@ import Command
 import Annex.Content
 import Annex
 import Utility.Rsync
-import Logs.Transfer
+import Annex.Transfer
 import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Utility.Metered
 

Command/TransferKey.hs

@@ -11,7 +11,7 @@ import Common.Annex
 import Command
 import Annex.Content
 import Logs.Location
-import Logs.Transfer
+import Annex.Transfer
 import qualified Remote
 import Types.Remote
 
@@ -41,7 +41,7 @@ start to from file key =
 		_ -> error "specify either --from or --to"
 
 toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
-toPerform remote key file = go $
+toPerform remote key file = go Upload file $
 	upload (uuid remote) key file forwardRetry $ \p -> do
 		ok <- Remote.storeKey remote key file p
 		when ok $
@@ -49,9 +49,9 @@ toPerform remote key file = go $
 		return ok
 
 fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
-fromPerform remote key file = go $
+fromPerform remote key file = go Upload file $
 	download (uuid remote) key file forwardRetry $ \p ->
 		getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
 
-go :: Annex Bool -> CommandPerform
-go a = a >>= liftIO . exitBool
+go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform
+go direction file a = notifyTransfer direction file a >>= liftIO . exitBool

Command/TransferKeys.hs

@@ -13,7 +13,7 @@ import Common.Annex
 import Command
 import Annex.Content
 import Logs.Location
-import Logs.Transfer
+import Annex.Transfer
 import qualified Remote
 import Types.Key
 
@@ -34,14 +34,15 @@ start = withHandles $ \(readh, writeh) -> do
 	stop
   where
 	runner (TransferRequest direction remote key file)
-		| direction == Upload = 
+		| direction == Upload = notifyTransfer direction file $
 			upload (Remote.uuid remote) key file forwardRetry $ \p -> do
 				ok <- Remote.storeKey remote key file p
 				when ok $
 					Remote.logStatus remote key InfoPresent
 				return ok
-		| otherwise = download (Remote.uuid remote) key file forwardRetry $ \p ->
-			getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
+		| otherwise = notifyTransfer direction file $
+			download (Remote.uuid remote) key file forwardRetry $ \p ->
+				getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
 
 {- stdin and stdout are connected with the caller, to be used for
  - communication with it. But doing a transfer might involve something