notifications on drop

Annex/Notification.hs

@@ -0,0 +1,81 @@
+{- git-annex desktop notifications
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Annex.Notification where
+
+import qualified Annex
+import Logs.Transfer
+#ifdef WITH_DBUS_NOTIFICATIONS
+import Common.Annex
+import Types.DesktopNotify
+import qualified DBus.Notify as Notify
+import qualified DBus.Client
+#endif
+
+-- Witness that notification has happened.
+data NotifyWitness = NotifyWitness
+
+{- Wrap around an action that performs a transfer, which may run multiple
+ - attempts. Displays notification when supported and when the user asked
+ - for it. -}
+notifyTransfer :: Direction -> Maybe FilePath -> (NotifyWitness -> Annex Bool) -> Annex Bool
+notifyTransfer _ Nothing a = a NotifyWitness
+notifyTransfer direction (Just f) a = do
+#ifdef WITH_DBUS_NOTIFICATIONS
+	wanted <- Annex.getState Annex.desktopnotify
+	let action = if direction == Upload then "uploading" else "downloading"
+	let basedesc = action ++ " " ++ f
+	let startdesc = "started " ++ basedesc
+	let enddesc ok = if ok
+		then "finished " ++ basedesc
+		else basedesc ++ " failed"
+	if (notifyStart wanted || notifyFinish wanted)
+		then do
+			client <- liftIO DBus.Client.connectSession
+			startnotification <- liftIO $ if notifyStart wanted
+				then Just <$> Notify.notify client (mkNote startdesc)
+				else pure Nothing
+			ok <- a NotifyWitness
+			when (notifyFinish wanted) $ liftIO $ void $ maybe 
+				(Notify.notify client $ mkNote $ enddesc ok)
+				(\n -> Notify.replace client n $ mkNote $ enddesc ok)
+				startnotification
+			return ok
+		else a NotifyWitness
+#else
+	a NotifyWitness
+#endif
+
+notifyDrop :: Maybe FilePath -> Bool -> Annex ()
+notifyDrop Nothing _ = noop
+notifyDrop (Just f) ok = do
+#ifdef WITH_DBUS_NOTIFICATIONS
+	wanted <- Annex.getState Annex.desktopnotify
+	when (notifyFinish wanted) $ liftIO $ do
+		client <- DBus.Client.connectSession
+		let msg = if ok
+			then "dropped " ++ f
+			else "failed to drop" ++ f
+		void $ Notify.notify client (mkNote msg)
+#else
+	noop
+#endif
+
+#ifdef WITH_DBUS_NOTIFICATIONS
+mkNote :: String -> Notify.Note
+mkNote desc = Notify.blankNote
+	{ Notify.appName = "git-annex"
+	, Notify.body = Just $ Notify.Text desc
+	, Notify.hints =
+		[ Notify.Category Notify.Transfer
+		, Notify.Urgency Notify.Low
+		, Notify.SuppressSound True
+		]
+	}
+#endif

Annex/Transfer.hs

@@ -12,23 +12,16 @@ module Annex.Transfer (
 	upload,
 	download,
 	runTransfer,
-	notifyTransfer,	
-	NotifyWitness,
 	noRetry,
 	forwardRetry,
 ) where
 
-import qualified Annex
+import Common.Annex
 import Logs.Transfer as X
+import Annex.Notification as X
 import Annex.Perms
 import Annex.Exception
 import Utility.Metered
-#ifdef WITH_DBUS_NOTIFICATIONS
-import Common.Annex
-import Types.DesktopNotify
-import qualified DBus.Notify as Notify
-import qualified DBus.Client
-#endif
 #ifdef mingw32_HOST_OS
 import Utility.WinLock
 #endif
@@ -136,45 +129,3 @@ noRetry _ _ = False
  - to send some data. -}
 forwardRetry :: RetryDecider
 forwardRetry old new = bytesComplete old < bytesComplete new
-
--- Witness that notification has happened.
-data NotifyWitness = NotifyWitness
-
-{- Wrap around an action that performs a transfer, which may run multiple
- - attempts, and displays notification when supported. -}
-notifyTransfer :: Direction -> Maybe FilePath -> (NotifyWitness -> Annex Bool) -> Annex Bool
-notifyTransfer _ Nothing a = a NotifyWitness
-notifyTransfer direction (Just f) a = do
-#ifdef WITH_DBUS_NOTIFICATIONS
-	wanted <- Annex.getState Annex.desktopnotify
-	let action = if direction == Upload then "uploading" else "downloading"
-	let basedesc = action ++ " " ++ f
-	let startdesc = "started " ++ basedesc
-	let enddesc ok = if ok
-		then "finished " ++ basedesc
-		else basedesc ++ " failed"
-	if (notifyStart wanted || notifyFinish wanted)
-		then do
-			client <- liftIO DBus.Client.connectSession
-			let mknote desc = Notify.blankNote
-				{ Notify.appName = "git-annex"
-				, Notify.body = Just $ Notify.Text desc
-				, Notify.hints =
-					[ Notify.Category Notify.Transfer
-					, Notify.Urgency Notify.Low
-					, Notify.SuppressSound True
-					]
-				}
-			startnotification <- liftIO $ if notifyStart wanted
-				then Just <$> Notify.notify client (mknote startdesc)
-				else pure Nothing
-			ok <- a NotifyWitness
-			when (notifyFinish wanted) $ liftIO $ void $ maybe 
-				(Notify.notify client $ mknote $ enddesc ok)
-				(\n -> Notify.replace client n $ mknote $ enddesc ok)
-				startnotification
-			return ok
-		else a NotifyWitness
-#else
-	a NotifyWitness
-#endif

Command/Drop.hs

@@ -17,6 +17,7 @@ import Logs.Trust
 import Config.NumCopies
 import Annex.Content
 import Annex.Wanted
+import Annex.Notification
 
 def :: [Command]
 def = [withOptions [dropFromOption] $ command "drop" paramPaths seek
@@ -44,24 +45,30 @@ start from file (key, _) = checkDropAuto from file key $ \numcopies ->
 startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
 startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
 	showStart' "drop" key afile
-	next $ performLocal key numcopies knownpresentremote
+	next $ performLocal key afile numcopies knownpresentremote
 
 startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart
 startRemote afile numcopies key remote = do
 	showStart' ("drop " ++ Remote.name remote) key afile
 	next $ performRemote key numcopies remote
 
-performLocal :: Key -> NumCopies -> Maybe Remote -> CommandPerform
+performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform
-performLocal key numcopies knownpresentremote = lockContent key $ do
+performLocal key afile numcopies knownpresentremote = lockContent key $ do
 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
 	let trusteduuids' = case knownpresentremote of
 		Nothing -> trusteduuids
 		Just r -> nub (Remote.uuid r:trusteduuids)
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
-	stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do
+	ifM (canDropKey key numcopies trusteduuids' tocheck [])
-		removeAnnex key
+		( do
-		next $ cleanupLocal key
+			removeAnnex key
+			notifyDrop afile True
+			next $ cleanupLocal key
+		, do
+			notifyDrop afile False
+			stop
+		)
 
 performRemote :: Key -> NumCopies -> Remote -> CommandPerform
 performRemote key numcopies remote = lockContent key $ do

Command/DropUnused.hs

@@ -35,7 +35,7 @@ perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<<
 	dropremote r = do
 		showAction $ "from " ++ Remote.name r
 		Command.Drop.performRemote key numcopies r
-	droplocal = Command.Drop.performLocal key numcopies Nothing
+	droplocal = Command.Drop.performLocal key Nothing numcopies Nothing
 	from = Annex.getField $ optionName Command.Drop.dropFromOption
 
 performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform

debian/changelog

@@ -3,7 +3,7 @@ git-annex (5.20140321) UNRELEASED; urgency=medium
   * unannex, uninit: Avoid committing after every file is unannexed,
     for massive speedup.
   * --notify-finish switch will cause desktop notifications after each 
-    file upload/download compltes 
+    file upload/download/drop completes
     (using the dbus Desktop Notifications Specification)
   * --notify-start switch will show desktop notifications when each
     file upload/download starts.

doc/git-annex.mdwn

@@ -1064,7 +1064,7 @@ subdirectories).
 * `--notify-start`
 
   Caused a desktop notification to be displayed when a file upload
-  or download has started.
+  or download has started, or when a file is dropped.
 
 * `-c name=value`