avoid multiple download failed messages when learning
Also only display one progress meter for all download attempts, to avoid a bunch of blank lines.
This commit is contained in:
parent
00937c4813
commit
31e5785bf7
1 changed files with 13 additions and 9 deletions
|
@ -15,15 +15,16 @@ import Remote.Helper.Messages
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Annex.Content
|
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Config
|
import Config
|
||||||
import Logs.Web
|
import Logs.Web
|
||||||
import Creds
|
import Creds
|
||||||
|
import Messages.Progress
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import qualified Annex.Url as Url
|
import qualified Annex.Url as Url
|
||||||
import Annex.SpecialRemote.Config
|
import Annex.SpecialRemote.Config
|
||||||
|
|
||||||
|
import Data.Either
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.FilePath.Posix as P
|
import System.FilePath.Posix as P
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
@ -110,18 +111,21 @@ httpAlsoSetup _ (Just u) _ c gc = do
|
||||||
|
|
||||||
downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
|
downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
|
||||||
downloadKey baseurl ll key _af dest p = do
|
downloadKey baseurl ll key _af dest p = do
|
||||||
unlessM (keyUrlAction baseurl ll key (downloadKey' key dest p)) $
|
downloadAction dest p key (keyUrlAction baseurl ll key)
|
||||||
giveup "download failed"
|
|
||||||
return UnVerified
|
return UnVerified
|
||||||
|
|
||||||
downloadKey' :: Key -> FilePath -> MeterUpdate -> URLString -> Annex Bool
|
|
||||||
downloadKey' key dest p url =
|
|
||||||
Url.withUrlOptions $ downloadUrl key p [url] dest
|
|
||||||
|
|
||||||
retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
|
retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
|
||||||
retriveExportHttpAlso baseurl key loc dest p =
|
retriveExportHttpAlso baseurl key loc dest p =
|
||||||
unlessM (exportLocationUrlAction baseurl loc (downloadKey' key dest p)) $
|
downloadAction dest p key (exportLocationUrlAction baseurl loc)
|
||||||
giveup "download failed"
|
|
||||||
|
downloadAction :: FilePath -> MeterUpdate -> Key -> ((URLString -> Annex Bool) -> Annex Bool) -> Annex ()
|
||||||
|
downloadAction dest p key run =
|
||||||
|
meteredFile dest (Just p) key $
|
||||||
|
unlessM (run downloader) $
|
||||||
|
giveup "download failed"
|
||||||
|
where
|
||||||
|
downloader url = isRight
|
||||||
|
<$> Url.withUrlOptions (Url.download' p url dest)
|
||||||
|
|
||||||
checkKey :: Maybe URLString -> LearnedLayout -> Remote -> Key -> Annex Bool
|
checkKey :: Maybe URLString -> LearnedLayout -> Remote -> Key -> Annex Bool
|
||||||
checkKey baseurl ll r key = do
|
checkKey baseurl ll r key = do
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue