From 10ddf2c3bd5fa9cd1c60550532dbfcf224c3d2fb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 3 Aug 2016 13:46:20 -0400 Subject: [PATCH] remove TransferObserver unused after last commit --- Annex/Transfer.hs | 30 +++++++++++------------------- Command/AddUrl.hs | 4 ++-- Command/Get.hs | 3 +-- Command/Move.hs | 4 ++-- Command/SendKey.hs | 2 +- Command/TransferKey.hs | 4 ++-- Command/TransferKeys.hs | 4 ++-- Remote/Git.hs | 4 ++-- 8 files changed, 23 insertions(+), 32 deletions(-) diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index 90aaa59c9f..a78d82ef37 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -9,7 +9,6 @@ module Annex.Transfer ( module X, - noObserver, upload, download, runTransfer, @@ -29,8 +28,6 @@ import Types.Remote (Verification(..)) import Control.Concurrent -type TransferObserver = Bool -> Transfer -> TransferInfo -> Annex () - class Observable a where observeBool :: a -> Bool observeFailure :: a @@ -43,16 +40,13 @@ instance Observable (Bool, Verification) where observeBool = fst observeFailure = (False, UnVerified) -noObserver :: TransferObserver -noObserver _ _ _ = noop +upload :: Observable v => UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v +upload u key f d a _witness = guardHaveUUID u $ + runTransfer (Transfer Upload u key) f d a -upload :: Observable v => UUID -> Key -> AssociatedFile -> RetryDecider -> TransferObserver -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v -upload u key f d o a _witness = guardHaveUUID u $ - runTransfer (Transfer Upload u key) f d o a - -download :: Observable v => UUID -> Key -> AssociatedFile -> RetryDecider -> TransferObserver -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v -download u key f d o a _witness = guardHaveUUID u $ - runTransfer (Transfer Download u key) f d o a +download :: Observable v => UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v +download u key f d a _witness = guardHaveUUID u $ + runTransfer (Transfer Download u key) f d a guardHaveUUID :: Observable v => UUID -> Annex v -> Annex v guardHaveUUID u a @@ -71,7 +65,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 -> TransferObserver -> (MeterUpdate -> Annex v) -> Annex v +runTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v runTransfer = runTransfer' False {- Like runTransfer, but ignores any existing transfer lock file for the @@ -79,11 +73,11 @@ 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 -> TransferObserver -> (MeterUpdate -> Annex v) -> Annex v +alwaysRunTransfer :: Observable v => Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v alwaysRunTransfer = runTransfer' True -runTransfer' :: Observable v => Bool -> Transfer -> Maybe FilePath -> RetryDecider -> TransferObserver -> (MeterUpdate -> Annex v) -> Annex v -runTransfer' ignorelock t file shouldretry transferobserver transferaction = do +runTransfer' :: Observable v => Bool -> Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v +runTransfer' ignorelock t file shouldretry transferaction = do info <- liftIO $ startTransferInfo file (meter, tfile, metervar) <- mkProgressUpdater t info mode <- annexFileMode @@ -94,12 +88,10 @@ runTransfer' ignorelock t file shouldretry transferobserver transferaction = do return observeFailure else do v <- retry info metervar $ transferaction meter - let ok = observeBool v liftIO $ cleanup tfile lck - if ok + if observeBool v then removeFailedTransfer t else recordFailedTransfer t info - transferobserver ok t info return v where #ifndef mingw32_HOST_OS diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 326bf782bd..be29cc2285 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -254,7 +254,7 @@ addUrlFileQuvi relaxed quviurl videourl file = stopUnless (doesNotExist file) $ tmp <- fromRepo $ gitAnnexTmpObjectLocation key showOutput ok <- Transfer.notifyTransfer Transfer.Download (Just file) $ - Transfer.download webUUID key (Just file) Transfer.forwardRetry Transfer.noObserver $ \p -> do + Transfer.download webUUID key (Just file) Transfer.forwardRetry $ \p -> do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloadUrl key p [videourl] tmp if ok @@ -335,7 +335,7 @@ downloadWith downloader dummykey u url file = ) where runtransfer tmp = Transfer.notifyTransfer Transfer.Download (Just file) $ - Transfer.download u dummykey (Just file) Transfer.forwardRetry Transfer.noObserver $ \p -> do + Transfer.download u dummykey (Just file) Transfer.forwardRetry $ \p -> do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloader tmp p diff --git a/Command/Get.hs b/Command/Get.hs index bd4891b92e..3d29146737 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -14,7 +14,6 @@ import Annex.Transfer import Annex.NumCopies import Annex.Wanted import qualified Command.Move -import Types.ActionItem cmd :: Command cmd = withGlobalOptions (jobsOption : jsonOption : annexedMatchingOptions) $ @@ -109,7 +108,7 @@ getKey' key afile = dispatch either (const False) id <$> Remote.hasKey r key | otherwise = return True docopy r witness = getViaTmp (RemoteVerify r) key $ \dest -> - download (Remote.uuid r) key afile noRetry noObserver + download (Remote.uuid r) key afile noRetry (\p -> do showAction $ "from " ++ Remote.name r Remote.retrieveKeyFile r key afile dest p diff --git a/Command/Move.hs b/Command/Move.hs index bf2aa0a24d..1ab5667707 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -114,7 +114,7 @@ toPerform dest move key afile fastcheck isthere = Right False -> do showAction $ "to " ++ Remote.name dest ok <- notifyTransfer Upload afile $ - upload (Remote.uuid dest) key afile noRetry noObserver $ + upload (Remote.uuid dest) key afile noRetry $ Remote.storeKey dest key afile if ok then finish $ @@ -177,7 +177,7 @@ fromPerform src move key afile = ifM (inAnnex key) ) where go = notifyTransfer Download afile $ - download (Remote.uuid src) key afile noRetry noObserver $ \p -> do + download (Remote.uuid src) key afile noRetry $ \p -> do showAction $ "from " ++ Remote.name src getViaTmp (RemoteVerify src) key $ \t -> Remote.retrieveKeyFile src key afile t p diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 96fc1bb0da..68da10316b 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -48,7 +48,7 @@ fieldTransfer direction key a = do liftIO $ debugM "fieldTransfer" "transfer start" afile <- Fields.getField Fields.associatedFile ok <- maybe (a $ const noop) - (\u -> runner (Transfer direction (toUUID u) key) afile noRetry noObserver a) + (\u -> runner (Transfer direction (toUUID u) key) afile noRetry a) =<< Fields.getField Fields.remoteUUID liftIO $ debugM "fieldTransfer" "transfer done" liftIO $ exitBool ok diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 69559f4cf6..42a6a9e0d8 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -51,7 +51,7 @@ start o key = case fromToOptions o of toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform toPerform key file remote = go Upload file $ - upload (uuid remote) key file forwardRetry noObserver $ \p -> do + upload (uuid remote) key file forwardRetry $ \p -> do ok <- Remote.storeKey remote key file p when ok $ Remote.logStatus remote key InfoPresent @@ -59,7 +59,7 @@ toPerform key file remote = go Upload file $ fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform fromPerform key file remote = go Upload file $ - download (uuid remote) key file forwardRetry noObserver $ \p -> + download (uuid remote) key file forwardRetry $ \p -> getViaTmp (RemoteVerify remote) key $ \t -> Remote.retrieveKeyFile remote key file t p diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index a385e5cdae..2ac7845890 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -35,13 +35,13 @@ start = do where runner (TransferRequest direction remote key file) | direction == Upload = notifyTransfer direction file $ - upload (Remote.uuid remote) key file forwardRetry noObserver $ \p -> do + upload (Remote.uuid remote) key file forwardRetry $ \p -> do ok <- Remote.storeKey remote key file p when ok $ Remote.logStatus remote key InfoPresent return ok | otherwise = notifyTransfer direction file $ - download (Remote.uuid remote) key file forwardRetry noObserver $ \p -> + download (Remote.uuid remote) key file forwardRetry $ \p -> getViaTmp (RemoteVerify remote) key $ \t -> do r <- Remote.retrieveKeyFile remote key file t p -- Make sure we get the current diff --git a/Remote/Git.hs b/Remote/Git.hs index e0534c2e60..1561d75969 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -439,7 +439,7 @@ copyFromRemote' r key file dest meterupdate Just (object, checksuccess) -> do copier <- mkCopier hardlink params runTransfer (Transfer Download u key) - file noRetry noObserver + file noRetry (\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess) | Git.repoIsSsh (repo r) = unVerified $ feedprogressback $ \p -> do Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p)) @@ -565,7 +565,7 @@ copyToRemote' r key file meterupdate ensureInitialized copier <- mkCopier hardlink params let verify = Annex.Content.RemoteVerify r - runTransfer (Transfer Download u key) file noRetry noObserver $ \p -> + runTransfer (Transfer Download u key) file noRetry $ \p -> let p' = combineMeterUpdate meterupdate p in Annex.Content.saveState True `after` Annex.Content.getViaTmp verify key