summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-08-03 13:46:20 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-08-03 13:46:20 -0400
commit85cd2dd2a908d9cec848c9827f68f9941f3ff5b8 (patch)
tree987e62f90199de80e0e080235225e3aff74de806
parente38ae12506c878b98779465bef167446bff506f9 (diff)
remove TransferObserver
unused after last commit
-rw-r--r--Annex/Transfer.hs30
-rw-r--r--Command/AddUrl.hs4
-rw-r--r--Command/Get.hs3
-rw-r--r--Command/Move.hs4
-rw-r--r--Command/SendKey.hs2
-rw-r--r--Command/TransferKey.hs4
-rw-r--r--Command/TransferKeys.hs4
-rw-r--r--Remote/Git.hs4
8 files changed, 23 insertions, 32 deletions
diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs
index 90aaa59c9..a78d82ef3 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 -> 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
+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
-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 326bf782b..be29cc228 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 bd4891b92..3d2914673 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 bf2aa0a24..1ab566770 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 96fc1bb0d..68da10316 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 69559f4cf..42a6a9e0d 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 a385e5cda..2ac784589 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 e0534c2e6..1561d7596 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