diff --git a/Annex/Notification.hs b/Annex/Notification.hs index 0501c0db7e..6a13d91dd2 100644 --- a/Annex/Notification.hs +++ b/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 _ (AssociatedFile Nothing) a = a NotifyWitness +notifyTransfer :: Transferrable t => Direction -> t -> (NotifyWitness -> Annex Bool) -> Annex Bool +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 - if (notifyStart wanted || notifyFinish wanted) - then do - client <- liftIO DBus.Client.connectSession - startnotification <- liftIO $ if notifyStart wanted - then Just <$> Notify.notify client (startedTransferNote direction f) - else pure Nothing - ok <- a NotifyWitness - when (notifyFinish wanted) $ liftIO $ void $ maybe - (Notify.notify client $ finishedTransferNote ok direction f) - (\n -> Notify.replace client n $ finishedTransferNote ok direction f) - startnotification - return ok - else a NotifyWitness + wanted <- Annex.getState Annex.desktopnotify + if (notifyStart wanted || notifyFinish wanted) + then do + client <- liftIO DBus.Client.connectSession + startnotification <- liftIO $ if notifyStart wanted + then Just <$> Notify.notify client (startedTransferNote direction desc) + else pure Nothing + ok <- a NotifyWitness + when (notifyFinish wanted) $ liftIO $ void $ maybe + (Notify.notify client $ finishedTransferNote ok direction desc) + (\n -> Notify.replace client n $ finishedTransferNote ok direction desc) + startnotification + return ok + 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