let url claims optionally include a suggested filename

This commit is contained in:
Joey Hess 2014-12-11 12:47:57 -04:00
parent 7c9149a44f
commit 85df9c30e9
11 changed files with 67 additions and 26 deletions

View file

@ -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

View file

@ -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.

View file

@ -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

View file

@ -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