summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2014-12-11 16:09:56 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2014-12-11 16:09:56 -0400
commit738233bdcfaf71432dba9f2857d0b3f69f14b8d5 (patch)
tree44f487071180b2c17cc7fa2c35ef7490d1dbb16f
parentf7ef9c36f57f69d4ba6145c77553cfeabeabcbc2 (diff)
use subdir for addurl when it creates multiple files
The --file parameter specifies the subdir in this mode.
-rw-r--r--Command/AddUrl.hs34
-rw-r--r--Remote/External.hs6
-rw-r--r--Types/UrlContents.hs7
3 files changed, 22 insertions, 25 deletions
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index aaa112803..a89b45477 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -60,14 +60,10 @@ seek us = do
if Remote.uuid r == webUUID
then void $ commandAction $ startWeb relaxed optfile pathdepth u
else do
- let handlecontents url c = case c of
- UrlContents sz mkf ->
- void $ commandAction $
- startRemote r relaxed optfile pathdepth url sz mkf
- UrlNested l -> forM_ l $
- uncurry handlecontents
+ pathmax <- liftIO $ fileNameLengthLimit "."
+ let deffile = fromMaybe (urlString2file u pathdepth pathmax) optfile
res <- tryNonAsync $ maybe
- (error "unable to checkUrl")
+ (error $ "unable to checkUrl of " ++ Remote.name r)
(flip id u)
(Remote.checkUrl r)
case res of
@@ -75,20 +71,19 @@ seek us = do
showStart "addurl" u
warning (show e)
next $ next $ return False
- Right c -> handlecontents u c
+ Right (UrlContents sz mf) -> do
+ void $ commandAction $
+ startRemote r relaxed (fromMaybe deffile mf) pathdepth u sz
+ Right (UrlMulti l) ->
+ forM_ l $ \(u', sz, f) ->
+ void $ commandAction $
+ startRemote r relaxed (deffile </> f) pathdepth u' sz
-startRemote :: Remote -> Bool -> Maybe FilePath -> Maybe Int -> String -> Maybe Integer -> (FilePath -> FilePath) -> CommandStart
-startRemote r relaxed optfile pathdepth s sz mkf = do
- url <- case Url.parseURIRelaxed s of
- Nothing -> error $ "bad uri " ++ s
- Just u -> pure u
- pathmax <- liftIO $ fileNameLengthLimit "."
- let file = mkf $ choosefile $ url2file url pathdepth pathmax
+startRemote :: Remote -> Bool -> FilePath -> Maybe Int -> String -> Maybe Integer -> CommandStart
+startRemote r relaxed file pathdepth s sz = do
showStart "addurl" file
showNote $ "using " ++ Remote.name r
next $ performRemote r relaxed s file sz
- where
- choosefile = flip fromMaybe optfile
performRemote :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> CommandPerform
performRemote r relaxed uri file sz = ifAnnexed file adduri geturi
@@ -324,3 +319,8 @@ url2file url pathdepth pathmax = case pathdepth of
frombits a = intercalate "/" $ a urlbits
urlbits = map (truncateFilePath pathmax . sanitizeFilePath) $
filter (not . null) $ split "/" fullurl
+
+urlString2file :: URLString -> Maybe Int -> Int -> FilePath
+urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of
+ Nothing -> error $ "bad uri " ++ s
+ Just u -> url2file u pathdepth pathmax
diff --git a/Remote/External.hs b/Remote/External.hs
index c5330f7ea..1a43a1ca7 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -434,10 +434,8 @@ checkurl :: External -> URLString -> Annex UrlContents
checkurl external url =
handleRequest external (CHECKURL url) Nothing $ \req -> case req of
CHECKURL_CONTENTS sz f -> Just $ return $ UrlContents sz
- (if null f then id else const f)
- CHECKURL_MULTI l -> Just $ return $ UrlNested $ map mknested l
+ (if null f then Nothing else Just f)
+ CHECKURL_MULTI l -> Just $ return $ UrlMulti l
CHECKURL_FAILURE errmsg -> Just $ error errmsg
UNSUPPORTED_REQUEST -> error "CHECKURL not implemented by external special remote"
_ -> Nothing
- where
- mknested (url', sz, f) = (url', UrlContents sz (const f))
diff --git a/Types/UrlContents.hs b/Types/UrlContents.hs
index 81b195fe3..ae50c6b40 100644
--- a/Types/UrlContents.hs
+++ b/Types/UrlContents.hs
@@ -11,9 +11,8 @@ import Utility.Url
data UrlContents
-- An URL contains a file, whose size may be known.
- -- A default filename will be provided, and can be overridded
- -- or built on.
- = UrlContents (Maybe Integer) (FilePath -> FilePath)
+ -- There might be a nicer filename to use.
+ = UrlContents (Maybe Integer) (Maybe FilePath)
-- Sometimes an URL points to multiple files, each accessible
-- by their own URL.
- | UrlNested [(URLString, UrlContents)]
+ | UrlMulti [(URLString, Maybe Integer, FilePath)]