let url claims optionally include a suggested filename
This commit is contained in:
parent
7c9149a44f
commit
85df9c30e9
11 changed files with 67 additions and 26 deletions
|
@ -21,6 +21,7 @@ import qualified Annex.Url as Url
|
|||
import qualified Backend.URL
|
||||
import qualified Remote
|
||||
import qualified Types.Remote as Remote
|
||||
import Annex.URLClaim
|
||||
import Annex.Content
|
||||
import Logs.Web
|
||||
import Types.Key
|
||||
|
@ -58,23 +59,23 @@ seek ps = do
|
|||
|
||||
start :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart
|
||||
start relaxed optfile pathdepth s = do
|
||||
r <- Remote.claimingUrl s
|
||||
(r, claim) <- urlClaim s
|
||||
if Remote.uuid r == webUUID
|
||||
then startWeb relaxed optfile pathdepth s
|
||||
else startRemote r relaxed optfile pathdepth s
|
||||
else startRemote r claim relaxed optfile pathdepth s
|
||||
|
||||
startRemote :: Remote -> Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart
|
||||
startRemote r relaxed optfile pathdepth s = do
|
||||
startRemote :: Remote -> URLClaim -> Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart
|
||||
startRemote r claim relaxed optfile pathdepth s = do
|
||||
url <- case Url.parseURIRelaxed s of
|
||||
Nothing -> error $ "bad uri " ++ s
|
||||
Just u -> pure u
|
||||
pathmax <- liftIO $ fileNameLengthLimit "."
|
||||
let file = choosefile $ url2file url pathdepth pathmax
|
||||
let file = flip fromMaybe optfile $ case claim of
|
||||
URLClaimedAs f -> f
|
||||
URLClaimed -> url2file url pathdepth pathmax
|
||||
showStart "addurl" file
|
||||
showNote $ "using " ++ Remote.name r
|
||||
next $ performRemote r relaxed s file
|
||||
where
|
||||
choosefile = flip fromMaybe optfile
|
||||
|
||||
performRemote :: Remote -> Bool -> URLString -> FilePath -> CommandPerform
|
||||
performRemote r relaxed uri file = ifAnnexed file adduri geturi
|
||||
|
|
|
@ -16,6 +16,7 @@ import qualified Command.Add
|
|||
import Logs.Web
|
||||
import Logs.Location
|
||||
import Utility.CopyFile
|
||||
import Annex.URLClaim
|
||||
import qualified Remote
|
||||
|
||||
cmd :: [Command]
|
||||
|
@ -63,7 +64,7 @@ cleanup file oldkey newkey = do
|
|||
-- the new key as well.
|
||||
urls <- getUrls oldkey
|
||||
forM_ urls $ \url -> do
|
||||
r <- Remote.claimingUrl url
|
||||
r <- fst <$> urlClaim url
|
||||
setUrlPresent (Remote.uuid r) newkey url
|
||||
|
||||
-- Update symlink to use the new key.
|
||||
|
|
|
@ -10,6 +10,7 @@ module Command.RmUrl where
|
|||
import Common.Annex
|
||||
import Command
|
||||
import Logs.Web
|
||||
import Annex.URLClaim
|
||||
import qualified Remote
|
||||
|
||||
cmd :: [Command]
|
||||
|
@ -27,7 +28,7 @@ start (file, url) = flip whenAnnexed file $ \_ key -> do
|
|||
|
||||
cleanup :: String -> Key -> CommandCleanup
|
||||
cleanup url key = do
|
||||
r <- Remote.claimingUrl url
|
||||
r <- fst <$> urlClaim url
|
||||
let url' = if Remote.uuid r == webUUID
|
||||
then url
|
||||
else setDownloader url OtherDownloader
|
||||
|
|
|
@ -14,6 +14,7 @@ import Command
|
|||
import Remote
|
||||
import Logs.Trust
|
||||
import Logs.Web
|
||||
import Annex.URLClaim
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [noCommit $ withOptions (jsonOption : keyOptions) $
|
||||
|
@ -71,4 +72,4 @@ performRemote key remote = do
|
|||
. filter (\(_, d) -> d == OtherDownloader)
|
||||
. map getDownloader
|
||||
<$> getUrls key
|
||||
filterM (\u -> (==) <$> pure remote <*> claimingUrl u) us
|
||||
filterM (\u -> (==) <$> pure remote <*> (fst <$> urlClaim u)) us
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue