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.

Annex.hs

@@ -60,6 +60,7 @@ import Types.FileMatcher
 import Types.NumCopies
 import Types.LockPool
 import Types.MetaData
+import Types.DesktopNotify
 import Types.CleanupActions
 import qualified Utility.Matcher
 import qualified Data.Map as M
@@ -122,6 +123,7 @@ data AnnexState = AnnexState
 	, unusedkeys :: Maybe (S.Set Key)
 	, quviversion :: Maybe QuviVersion
 	, existinghooks :: M.Map Git.Hook.Hook Bool
+	, desktopnotify :: DesktopNotify
 	}
 
 newState :: GitConfig -> Git.Repo -> AnnexState
@@ -163,6 +165,7 @@ newState c r = AnnexState
 	, unusedkeys = Nothing
 	, quviversion = Nothing
 	, existinghooks = M.empty
+	, desktopnotify = mempty
 	}
 
 {- Makes an Annex state object for the specified git repo.

Annex/Transfer.hs

@@ -0,0 +1,178 @@
+{- git-annex transfers
+ -
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Annex.Transfer (
+	module X,
+	upload,
+	download,
+	runTransfer,
+	notifyTransfer,	
+	NotifyWitness,
+	noRetry,
+	forwardRetry,
+) where
+
+import qualified Annex
+import Logs.Transfer 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
+
+import Control.Concurrent
+
+upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> NotifyWitness -> Annex Bool
+upload u key f d a _witness = runTransfer (Transfer Upload u key) f d a
+
+download :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> NotifyWitness -> Annex Bool
+download u key f d a _witness = runTransfer (Transfer Download u key) f d a
+
+{- Runs a transfer action. Creates and locks the lock file while the
+ - action is running, and stores info in the transfer information
+ - file.
+ -
+ - If the transfer action returns False, the transfer info is 
+ - left in the failedTransferDir.
+ -
+ - If the transfer is already in progress, returns False.
+ -
+ - An upload can be run from a read-only filesystem, and in this case
+ - no transfer information or lock file is used.
+ -}
+runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
+runTransfer t file shouldretry a = do
+	info <- liftIO $ startTransferInfo file
+	(meter, tfile, metervar) <- mkProgressUpdater t info
+	mode <- annexFileMode
+	(fd, inprogress) <- liftIO $ prep tfile mode info
+	if inprogress
+		then do
+			showNote "transfer already in progress"
+			return False
+		else do
+			ok <- retry info metervar $
+		 		bracketIO (return fd) (cleanup tfile) (const $ a meter)
+			unless ok $ recordFailedTransfer t info
+			return ok
+  where
+#ifndef mingw32_HOST_OS
+	prep tfile mode info = do
+		mfd <- catchMaybeIO $
+			openFd (transferLockFile tfile) ReadWrite (Just mode)
+				defaultFileFlags { trunc = True }
+		case mfd of
+			Nothing -> return (Nothing, False)
+			Just fd -> do
+				locked <- catchMaybeIO $
+					setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+				if isNothing locked
+					then return (Nothing, True)
+					else do
+						void $ tryIO $ writeTransferInfoFile info tfile
+						return (mfd, False)
+#else
+	prep tfile _mode info = do
+		v <- catchMaybeIO $ lockExclusive (transferLockFile tfile)
+		case v of
+			Nothing -> return (Nothing, False)
+			Just Nothing -> return (Nothing, True)
+			Just (Just lockhandle) -> do
+				void $ tryIO $ writeTransferInfoFile info tfile
+				return (Just lockhandle, False)
+#endif
+	cleanup _ Nothing = noop
+	cleanup tfile (Just lockhandle) = do
+		void $ tryIO $ removeFile tfile
+#ifndef mingw32_HOST_OS
+		void $ tryIO $ removeFile $ transferLockFile tfile
+		closeFd lockhandle
+#else
+		{- Windows cannot delete the lockfile until the lock
+		 - is closed. So it's possible to race with another
+		 - process that takes the lock before it's removed,
+		 - so ignore failure to remove.
+		 -}
+		dropLock lockhandle
+		void $ tryIO $ removeFile $ transferLockFile tfile
+#endif
+	retry oldinfo metervar run = do
+		v <- tryAnnex run
+		case v of
+			Right b -> return b
+			Left _ -> do
+				b <- getbytescomplete metervar
+				let newinfo = oldinfo { bytesComplete = Just b }
+				if shouldretry oldinfo newinfo
+					then retry newinfo metervar run
+					else return False
+	getbytescomplete metervar
+		| transferDirection t == Upload =
+			liftIO $ readMVar metervar
+		| otherwise = do
+			f <- fromRepo $ gitAnnexTmpObjectLocation (transferKey t)
+			liftIO $ catchDefaultIO 0 $
+				fromIntegral . fileSize <$> getFileStatus f
+
+type RetryDecider = TransferInfo -> TransferInfo -> Bool
+
+noRetry :: RetryDecider
+noRetry _ _ = False
+
+{- Retries a transfer when it fails, as long as the failed transfer managed
+ - 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 = "finished " ++ basedesc
+	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
+			r <- a NotifyWitness
+			when (notifyFinish wanted) $ liftIO $ void $ maybe 
+				(Notify.notify client $ mknote enddesc)
+				(\n -> Notify.replace client n $ mknote enddesc)
+				startnotification
+			return r
+		else a NotifyWitness
+#else
+	a NotifyWitness
+#endif

Assistant/Alert/Utility.hs

@@ -14,7 +14,6 @@ import Utility.Tense
 import qualified Data.Text as T
 import Data.Text (Text)
 import qualified Data.Map as M
-import Data.Monoid
 
 {- This is as many alerts as it makes sense to display at a time.
  - A display might be smaller, or larger, the point is to not overwhelm the

BuildFlags.hs

@@ -57,6 +57,9 @@ buildFlags = filter (not . null)
 #ifdef WITH_DBUS
 	, "DBus"
 #endif
+#ifdef WITH_DESKTOP_NOTIFY
+	, "DesktopNotify"
+#endif
 #ifdef WITH_XMPP
 	, "XMPP"
 #else

CmdLine/Option.hs

@@ -20,6 +20,7 @@ import System.Console.GetOpt
 import Common.Annex
 import qualified Annex
 import Types.Messages
+import Types.DesktopNotify
 import Limit
 import CmdLine.Usage
 
@@ -41,6 +42,10 @@ commonOptions =
 		"don't show debug messages"
 	, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
 		"specify key-value backend to use"
+	, Option [] ["notify-finish"] (NoArg (setdesktopnotify mkNotifyFinish))
+		"show desktop notification after transfer finishes"
+	, Option [] ["notify-start"] (NoArg (setdesktopnotify mkNotifyStart))
+		"show desktop notification after transfer completes"
 	]
   where
 	setforce v = Annex.changeState $ \s -> s { Annex.force = v }
@@ -49,6 +54,7 @@ commonOptions =
 	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
 	setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True }
 	unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }
+	setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }
 
 matcherOptions :: [Option]
 matcherOptions =

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

Common.hs

@@ -11,6 +11,7 @@ import Control.Exception.Extensible as X (IOException)
 import Data.Maybe as X
 import Data.List as X hiding (head, tail, init, last)
 import Data.String.Utils as X hiding (join)
+import Data.Monoid as X
 
 import System.FilePath as X
 import System.Directory as X

Logs/Transfer.hs

@@ -88,108 +88,6 @@ percentComplete :: Transfer -> TransferInfo -> Maybe Percentage
 percentComplete (Transfer { transferKey = key }) info =
 	percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info)
 
-type RetryDecider = TransferInfo -> TransferInfo -> Bool
-
-noRetry :: RetryDecider
-noRetry _ _ = False
-
-{- Retries a transfer when it fails, as long as the failed transfer managed
- - to send some data. -}
-forwardRetry :: RetryDecider
-forwardRetry old new = bytesComplete old < bytesComplete new
-
-upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
-upload u key = runTransfer (Transfer Upload u key)
-
-download :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
-download u key = runTransfer (Transfer Download u key)
-
-{- Runs a transfer action. Creates and locks the lock file while the
- - action is running, and stores info in the transfer information
- - file.
- -
- - If the transfer action returns False, the transfer info is 
- - left in the failedTransferDir.
- -
- - If the transfer is already in progress, returns False.
- -
- - An upload can be run from a read-only filesystem, and in this case
- - no transfer information or lock file is used.
- -}
-runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
-runTransfer t file shouldretry a = do
-	info <- liftIO $ startTransferInfo file
-	(meter, tfile, metervar) <- mkProgressUpdater t info
-	mode <- annexFileMode
-	(fd, inprogress) <- liftIO $ prep tfile mode info
-	if inprogress
-		then do
-			showNote "transfer already in progress"
-			return False
-		else do
-			ok <- retry info metervar $
-		 		bracketIO (return fd) (cleanup tfile) (const $ a meter)
-			unless ok $ recordFailedTransfer t info
-			return ok
-  where
-#ifndef mingw32_HOST_OS
-	prep tfile mode info = do
-		mfd <- catchMaybeIO $
-			openFd (transferLockFile tfile) ReadWrite (Just mode)
-				defaultFileFlags { trunc = True }
-		case mfd of
-			Nothing -> return (Nothing, False)
-			Just fd -> do
-				locked <- catchMaybeIO $
-					setLock fd (WriteLock, AbsoluteSeek, 0, 0)
-				if isNothing locked
-					then return (Nothing, True)
-					else do
-						void $ tryIO $ writeTransferInfoFile info tfile
-						return (mfd, False)
-#else
-	prep tfile _mode info = do
-		v <- catchMaybeIO $ lockExclusive (transferLockFile tfile)
-		case v of
-			Nothing -> return (Nothing, False)
-			Just Nothing -> return (Nothing, True)
-			Just (Just lockhandle) -> do
-				void $ tryIO $ writeTransferInfoFile info tfile
-				return (Just lockhandle, False)
-#endif
-	cleanup _ Nothing = noop
-	cleanup tfile (Just lockhandle) = do
-		void $ tryIO $ removeFile tfile
-#ifndef mingw32_HOST_OS
-		void $ tryIO $ removeFile $ transferLockFile tfile
-		closeFd lockhandle
-#else
-		{- Windows cannot delete the lockfile until the lock
-		 - is closed. So it's possible to race with another
-		 - process that takes the lock before it's removed,
-		 - so ignore failure to remove.
-		 -}
-		dropLock lockhandle
-		void $ tryIO $ removeFile $ transferLockFile tfile
-#endif
-	retry oldinfo metervar run = do
-		v <- tryAnnex run
-		case v of
-			Right b -> return b
-			Left _ -> do
-				b <- getbytescomplete metervar
-				let newinfo = oldinfo { bytesComplete = Just b }
-				if shouldretry oldinfo newinfo
-					then retry newinfo metervar run
-					else return False
-	getbytescomplete metervar
-		| transferDirection t == Upload =
-			liftIO $ readMVar metervar
-		| otherwise = do
-			f <- fromRepo $ gitAnnexTmpObjectLocation (transferKey t)
-			liftIO $ catchDefaultIO 0 $
-				fromIntegral . fileSize <$> getFileStatus f
-
 {- Generates a callback that can be called as transfer progresses to update
  - the transfer info file. Also returns the file it'll be updating, and a
  - MVar that can be used to read the number of bytesComplete. -}

Remote/Git.hs

@@ -24,7 +24,7 @@ import qualified Git.Command
 import qualified Git.GCrypt
 import qualified Annex
 import Logs.Presence
-import Logs.Transfer
+import Annex.Transfer
 import Annex.UUID
 import Annex.Exception
 import qualified Annex.Content
@@ -321,7 +321,7 @@ copyFromRemote' r key file dest
 			case v of
 				Nothing -> return False
 				Just (object, checksuccess) ->
-					upload u key file noRetry
+					runTransfer (Transfer Download u key) file noRetry
 						(rsyncOrCopyFile params object dest)
 						<&&> checksuccess
 	| Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> do
@@ -418,7 +418,7 @@ copyToRemote r key file p
 			( return True
 			, do
 				ensureInitialized
-				download u key file noRetry $ const $
+				runTransfer (Transfer Download u key) file noRetry $ const $
 					Annex.Content.saveState True `after`
 						Annex.Content.getViaTmpChecked (liftIO checksuccessio) key
 							(\d -> rsyncOrCopyFile params object d p)

Types/DesktopNotify.hs

@@ -0,0 +1,27 @@
+{- git-annex DesktopNotify type
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.DesktopNotify where
+
+import Data.Monoid
+
+data DesktopNotify = DesktopNotify
+	{ notifyStart :: Bool
+	, notifyFinish :: Bool
+	}
+	deriving (Show)
+
+instance Monoid DesktopNotify where
+	mempty = DesktopNotify False False
+	mappend (DesktopNotify s1 f1) (DesktopNotify s2 f2) =
+		DesktopNotify (s1 || s2) (f1 || f2)
+
+mkNotifyStart :: DesktopNotify
+mkNotifyStart = DesktopNotify True False
+
+mkNotifyFinish :: DesktopNotify
+mkNotifyFinish = DesktopNotify False True

Utility/WebApp.hs

@@ -33,7 +33,6 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import Blaze.ByteString.Builder.Char.Utf8 (fromText)
 import Blaze.ByteString.Builder (Builder)
-import Data.Monoid
 import Control.Arrow ((***))
 import Control.Concurrent
 #ifdef WITH_WEBAPP_SECURE

debian/changelog

@@ -2,6 +2,11 @@ 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 
+    (using the dbus Desktop Notifications Specification)
+  * --notify-start switch will show desktop notifications when each
+    file upload/download starts.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 21 Mar 2014 14:08:41 -0400
 

debian/control

@@ -30,6 +30,7 @@ Build-Depends:
 	libghc-hinotify-dev [linux-any],
 	libghc-stm-dev (>= 2.3),
 	libghc-dbus-dev (>= 0.10.3) [linux-any],
+	libghc-fdo-notify-dev (>= 0.3) [linux-any],
 	libghc-yesod-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
 	libghc-yesod-static-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
 	libghc-yesod-default-dev [i386 amd64 kfreebsd-amd64 powerpc sparc],

doc/git-annex.mdwn

@@ -1053,6 +1053,19 @@ subdirectories).
 
   Overrides the User-Agent to use when downloading files from the web.
 
+* `--notify-finish`
+
+  Caused a desktop notification to be displayed after each successful
+  file download and upload.
+
+  (Only supported on some platforms, eg Linux with dbus. A no-op when
+  not supported.)
+
+* `--notify-start`
+
+  Caused a desktop notification to be displayed when a file upload
+  or download has started.
+
 * `-c name=value`
 
   Overrides git configuration settings. May be specified multiple times.

git-annex.cabal

@@ -85,6 +85,9 @@ Flag Tahoe
 Flag CryptoHash
   Description: Enable use of cryptohash for checksumming
 
+Flag DesktopNotify
+  Description: Enable desktop environment notifications
+
 Flag EKG
   Description: Enable use of EKG to monitor git-annex as it runs (at http://localhost:4242/)
   Default: False
@@ -167,10 +170,15 @@ Executable git-annex
               CPP-Options: -DWITH_KQUEUE
               C-Sources: Utility/libkqueue.c
 
-  if os(linux) && flag(Dbus)
+  if flag(Dbus)
     Build-Depends: dbus (>= 0.10.3)
     CPP-Options: -DWITH_DBUS
   
+  if flag(DesktopNotify)
+    if flag(Dbus)
+      Build-Depends: dbus (>= 0.10.3), fdo-notify (>= 0.3)
+      CPP-Options: -DWITH_DESKTOP_NOTIFY -DWITH_DBUS_NOTIFICATIONS
+
   if flag(Android)
     Build-Depends: data-endian
     CPP-Options: -D__ANDROID__ -DANDROID_SPLICES -D__NO_TH__