generalize notifyTransfer

support not only AssociatedFile but also URLString

Annex/Notification.hs

@@ -5,12 +5,14 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 {-# LANGUAGE CPP #-}
 
 module Annex.Notification (NotifyWitness, noNotification, notifyTransfer, notifyDrop) where
 
 import Annex.Common
 import Types.Transfer
+import Utility.Url
 #ifdef WITH_DBUS_NOTIFICATIONS
 import qualified Annex
 import Types.DesktopNotify
@@ -25,29 +27,39 @@ data NotifyWitness = NotifyWitness
 noNotification :: NotifyWitness
 noNotification = NotifyWitness
 
+class Transferrable t where
+	descTransfrerrable :: t -> Maybe String
+
+instance Transferrable AssociatedFile where
+	descTransfrerrable (AssociatedFile af) = af
+
+instance Transferrable URLString where
+	descTransfrerrable = Just
+
 {- 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 -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> Annex Bool
+notifyTransfer :: Transferrable t => Direction -> t -> (NotifyWitness -> Annex Bool) -> Annex Bool
-notifyTransfer _ (AssociatedFile Nothing) a = a NotifyWitness
+notifyTransfer direction t a = case descTransfrerrable t of
+	Nothing -> a NotifyWitness
+	Just desc -> do
 #ifdef WITH_DBUS_NOTIFICATIONS
-notifyTransfer direction (AssociatedFile (Just f)) a = do
+		wanted <- Annex.getState Annex.desktopnotify
-	wanted <- Annex.getState Annex.desktopnotify
+		if (notifyStart wanted || notifyFinish wanted)
-	if (notifyStart wanted || notifyFinish wanted)
+			then do
-		then do
+				client <- liftIO DBus.Client.connectSession
-			client <- liftIO DBus.Client.connectSession
+				startnotification <- liftIO $ if notifyStart wanted
-			startnotification <- liftIO $ if notifyStart wanted
+					then Just <$> Notify.notify client (startedTransferNote direction desc)
-				then Just <$> Notify.notify client (startedTransferNote direction f)
+					else pure Nothing
-				else pure Nothing
+				ok <- a NotifyWitness
-			ok <- a NotifyWitness
+				when (notifyFinish wanted) $ liftIO $ void $ maybe 
-			when (notifyFinish wanted) $ liftIO $ void $ maybe 
+					(Notify.notify client $ finishedTransferNote ok direction desc)
-				(Notify.notify client $ finishedTransferNote ok direction f)
+					(\n -> Notify.replace client n $ finishedTransferNote ok direction desc)
-				(\n -> Notify.replace client n $ finishedTransferNote ok direction f)
+					startnotification
-				startnotification
+				return ok
-			return ok
+			else a NotifyWitness
-		else a NotifyWitness
 #else
-notifyTransfer _ (AssociatedFile (Just _)) a = a NotifyWitness
+		a NotifyWitness
 #endif
 
 notifyDrop :: AssociatedFile -> Bool -> Annex ()
@@ -63,13 +75,13 @@ notifyDrop (AssociatedFile (Just _)) _ = noop
 #endif
 
 #ifdef WITH_DBUS_NOTIFICATIONS
-startedTransferNote :: Direction -> FilePath -> Notify.Note
+startedTransferNote :: Direction -> String -> Notify.Note
 startedTransferNote Upload   = mkNote Notify.Transfer Notify.Low iconUpload
 	"Uploading"
 startedTransferNote Download = mkNote Notify.Transfer Notify.Low iconDownload
 	"Downloading"
 
-finishedTransferNote :: Bool -> Direction -> FilePath -> Notify.Note
+finishedTransferNote :: Bool -> Direction -> String -> Notify.Note
 finishedTransferNote False Upload   = mkNote Notify.TransferError Notify.Normal iconFailure
 	"Failed to upload"
 finishedTransferNote False Download = mkNote Notify.TransferError Notify.Normal iconFailure
@@ -79,7 +91,7 @@ finishedTransferNote True  Upload   = mkNote Notify.TransferComplete Notify.Low
 finishedTransferNote True  Download = mkNote Notify.TransferComplete Notify.Low iconSuccess
 	"Finished downloading"
 
-droppedNote :: Bool -> FilePath -> Notify.Note
+droppedNote :: Bool -> String -> Notify.Note
 droppedNote False = mkNote Notify.TransferError Notify.Normal iconFailure
 	"Failed to drop"
 droppedNote True  = mkNote Notify.TransferComplete Notify.Low iconSuccess