remove TransferObserver
unused after last commit
This commit is contained in:
Joey Hess
parent
f461bcae4b
commit
10ddf2c3bd
8 changed files with 23 additions and 32 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue