generalize notifyTransfer
support not only AssociatedFile but also URLString
This commit is contained in:
parent
4781ca297b
commit
53f91bddfa
1 changed files with 33 additions and 21 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue