generalize notifyTransfer

support not only AssociatedFile but also URLString
This commit is contained in:
Joey Hess 2017-11-28 16:11:30 -04:00
parent 4781ca297b
commit 53f91bddfa
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -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