diff options
Diffstat (limited to 'Annex')
-rw-r--r-- | Annex/Drop.hs | 12 | ||||
-rw-r--r-- | Annex/FileMatcher.hs | 4 | ||||
-rw-r--r-- | Annex/Notification.hs | 16 | ||||
-rw-r--r-- | Annex/Transfer.hs | 10 |
4 files changed, 22 insertions, 20 deletions
diff --git a/Annex/Drop.hs b/Annex/Drop.hs index cd0168a9f..1723bce0d 100644 --- a/Annex/Drop.hs +++ b/Annex/Drop.hs @@ -55,8 +55,8 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key ) let fs = case afile of - Just f -> nub (f : l) - Nothing -> l + AssociatedFile (Just f) -> nub (f : l) + AssociatedFile Nothing -> l n <- getcopies fs void $ if fromhere && checkcopies n Nothing then go fs rs n >>= dropl fs @@ -93,9 +93,9 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do checkdrop fs n u a | null fs = check $ -- no associated files; unused content - wantDrop True u (Just key) Nothing + wantDrop True u (Just key) (AssociatedFile Nothing) | otherwise = check $ - allM (wantDrop True u (Just key) . Just) fs + allM (wantDrop True u (Just key) . AssociatedFile . Just) fs where check c = ifM c ( dodrop n u a @@ -107,7 +107,9 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do ( do liftIO $ debugM "drop" $ unwords [ "dropped" - , fromMaybe (key2file key) afile + , case afile of + AssociatedFile Nothing -> key2file key + AssociatedFile (Just af) -> af , "(from " ++ maybe "here" show u ++ ")" , "(copies now " ++ show (fromNumCopies have - 1) ++ ")" , ": " ++ reason diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index 7a418cc48..1e07a9da2 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -44,13 +44,13 @@ type GetFileMatcher = FilePath -> Annex (FileMatcher Annex) checkFileMatcher :: GetFileMatcher -> FilePath -> Annex Bool checkFileMatcher getmatcher file = do matcher <- getmatcher file - checkMatcher matcher Nothing (Just file) S.empty True + checkMatcher matcher Nothing (AssociatedFile (Just file)) S.empty True checkMatcher :: FileMatcher Annex -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool checkMatcher matcher mkey afile notpresent d | isEmpty matcher = return d | otherwise = case (mkey, afile) of - (_, Just file) -> go =<< fileMatchInfo file + (_, AssociatedFile (Just file)) -> go =<< fileMatchInfo file (Just key, _) -> go (MatchingKey key) _ -> return d where diff --git a/Annex/Notification.hs b/Annex/Notification.hs index e61b362ad..0501c0db7 100644 --- a/Annex/Notification.hs +++ b/Annex/Notification.hs @@ -28,10 +28,10 @@ noNotification = 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 -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> Annex Bool +notifyTransfer _ (AssociatedFile Nothing) a = a NotifyWitness #ifdef WITH_DBUS_NOTIFICATIONS -notifyTransfer direction (Just f) a = do +notifyTransfer direction (AssociatedFile (Just f)) a = do wanted <- Annex.getState Annex.desktopnotify if (notifyStart wanted || notifyFinish wanted) then do @@ -47,19 +47,19 @@ notifyTransfer direction (Just f) a = do return ok else a NotifyWitness #else -notifyTransfer _ (Just _) a = a NotifyWitness +notifyTransfer _ (AssociatedFile (Just _)) a = a NotifyWitness #endif -notifyDrop :: Maybe FilePath -> Bool -> Annex () -notifyDrop Nothing _ = noop +notifyDrop :: AssociatedFile -> Bool -> Annex () +notifyDrop (AssociatedFile Nothing) _ = noop #ifdef WITH_DBUS_NOTIFICATIONS -notifyDrop (Just f) ok = do +notifyDrop (AssociatedFile (Just f)) ok = do wanted <- Annex.getState Annex.desktopnotify when (notifyFinish wanted) $ liftIO $ do client <- DBus.Client.connectSession void $ Notify.notify client (droppedNote ok f) #else -notifyDrop (Just _) _ = noop +notifyDrop (AssociatedFile (Just _)) _ = noop #endif #ifdef WITH_DBUS_NOTIFICATIONS diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index 0b794b379..87480b2f1 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -77,7 +77,7 @@ guardHaveUUID u a - An upload can be run from a read-only filesystem, and in this case - no transfer information or lock file is used. -} -runTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v +runTransfer :: Observable v => Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v runTransfer = runTransfer' False {- Like runTransfer, but ignores any existing transfer lock file for the @@ -85,12 +85,12 @@ runTransfer = runTransfer' False - - Note that this may result in confusing progress meter display in the - webapp, if multiple processes are writing to the transfer info file. -} -alwaysRunTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v +alwaysRunTransfer :: Observable v => Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v alwaysRunTransfer = runTransfer' True -runTransfer' :: Observable v => Bool -> Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v -runTransfer' ignorelock t file shouldretry transferaction = checkSecureHashes t $ do - info <- liftIO $ startTransferInfo file +runTransfer' :: Observable v => Bool -> Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v +runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t $ do + info <- liftIO $ startTransferInfo afile (meter, tfile, metervar) <- mkProgressUpdater t info mode <- annexFileMode (lck, inprogress) <- prep tfile mode info |