diff options
| -rw-r--r-- | Annex/Notification.hs | 81 | ||||
| -rw-r--r-- | Annex/Transfer.hs | 53 | ||||
| -rw-r--r-- | Command/Drop.hs | 19 | ||||
| -rw-r--r-- | Command/DropUnused.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 2 |
6 files changed, 99 insertions, 60 deletions
diff --git a/Annex/Notification.hs b/Annex/Notification.hs new file mode 100644 index 000000000..5bc39d9cb --- /dev/null +++ b/Annex/Notification.hs @@ -0,0 +1,81 @@ +{- git-annex desktop notifications + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Annex.Notification where + +import qualified Annex +import Logs.Transfer +#ifdef WITH_DBUS_NOTIFICATIONS +import Common.Annex +import Types.DesktopNotify +import qualified DBus.Notify as Notify +import qualified DBus.Client +#endif + +-- Witness that notification has happened. +data NotifyWitness = NotifyWitness + +{- 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 -> 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 ok = if ok + then "finished " ++ basedesc + else basedesc ++ " failed" + if (notifyStart wanted || notifyFinish wanted) + then do + client <- liftIO DBus.Client.connectSession + startnotification <- liftIO $ if notifyStart wanted + then Just <$> Notify.notify client (mkNote startdesc) + else pure Nothing + ok <- a NotifyWitness + when (notifyFinish wanted) $ liftIO $ void $ maybe + (Notify.notify client $ mkNote $ enddesc ok) + (\n -> Notify.replace client n $ mkNote $ enddesc ok) + startnotification + return ok + else a NotifyWitness +#else + a NotifyWitness +#endif + +notifyDrop :: Maybe FilePath -> Bool -> Annex () +notifyDrop Nothing _ = noop +notifyDrop (Just f) ok = do +#ifdef WITH_DBUS_NOTIFICATIONS + wanted <- Annex.getState Annex.desktopnotify + when (notifyFinish wanted) $ liftIO $ do + client <- DBus.Client.connectSession + let msg = if ok + then "dropped " ++ f + else "failed to drop" ++ f + void $ Notify.notify client (mkNote msg) +#else + noop +#endif + +#ifdef WITH_DBUS_NOTIFICATIONS +mkNote :: String -> Notify.Note +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 + ] + } +#endif diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index 0d5744d4e..df5aba09c 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -12,23 +12,16 @@ module Annex.Transfer ( upload, download, runTransfer, - notifyTransfer, - NotifyWitness, noRetry, forwardRetry, ) where -import qualified Annex +import Common.Annex import Logs.Transfer as X +import Annex.Notification 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 @@ -136,45 +129,3 @@ noRetry _ _ = False - 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 ok = if ok - then "finished " ++ basedesc - else basedesc ++ " failed" - 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 - ok <- a NotifyWitness - when (notifyFinish wanted) $ liftIO $ void $ maybe - (Notify.notify client $ mknote $ enddesc ok) - (\n -> Notify.replace client n $ mknote $ enddesc ok) - startnotification - return ok - else a NotifyWitness -#else - a NotifyWitness -#endif diff --git a/Command/Drop.hs b/Command/Drop.hs index d29195b05..f6c1880e9 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -17,6 +17,7 @@ import Logs.Trust import Config.NumCopies import Annex.Content import Annex.Wanted +import Annex.Notification def :: [Command] def = [withOptions [dropFromOption] $ command "drop" paramPaths seek @@ -44,24 +45,30 @@ start from file (key, _) = checkDropAuto from file key $ \numcopies -> startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do showStart' "drop" key afile - next $ performLocal key numcopies knownpresentremote + next $ performLocal key afile numcopies knownpresentremote startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart startRemote afile numcopies key remote = do showStart' ("drop " ++ Remote.name remote) key afile next $ performRemote key numcopies remote -performLocal :: Key -> NumCopies -> Maybe Remote -> CommandPerform -performLocal key numcopies knownpresentremote = lockContent key $ do +performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform +performLocal key afile numcopies knownpresentremote = lockContent key $ do (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key let trusteduuids' = case knownpresentremote of Nothing -> trusteduuids Just r -> nub (Remote.uuid r:trusteduuids) untrusteduuids <- trustGet UnTrusted let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids) - stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do - removeAnnex key - next $ cleanupLocal key + ifM (canDropKey key numcopies trusteduuids' tocheck []) + ( do + removeAnnex key + notifyDrop afile True + next $ cleanupLocal key + , do + notifyDrop afile False + stop + ) performRemote :: Key -> NumCopies -> Remote -> CommandPerform performRemote key numcopies remote = lockContent key $ do diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 345d03032..5d1923d34 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -35,7 +35,7 @@ perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< dropremote r = do showAction $ "from " ++ Remote.name r Command.Drop.performRemote key numcopies r - droplocal = Command.Drop.performLocal key numcopies Nothing + droplocal = Command.Drop.performLocal key Nothing numcopies Nothing from = Annex.getField $ optionName Command.Drop.dropFromOption performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform diff --git a/debian/changelog b/debian/changelog index 51629cd93..7addf4ae7 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,7 +3,7 @@ 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 + file upload/download/drop completes (using the dbus Desktop Notifications Specification) * --notify-start switch will show desktop notifications when each file upload/download starts. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 894ac4329..a1005cbc8 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -1064,7 +1064,7 @@ subdirectories). * `--notify-start` Caused a desktop notification to be displayed when a file upload - or download has started. + or download has started, or when a file is dropped. * `-c name=value` |