addurl now accepts --prefix and --suffix options to adjust the filenames used

Command/AddUrl.hs

@@ -46,6 +46,8 @@ data AddUrlOptions = AddUrlOptions
 	{ addUrls :: CmdParams
 	, fileOption :: Maybe FilePath
 	, pathdepthOption :: Maybe Int
+	, prefixOption :: Maybe String
+	, suffixOption :: Maybe String
 	, relaxedOption :: Bool
 	, rawOption :: Bool
 	}
@@ -59,7 +61,15 @@ optParser desc = AddUrlOptions
 		))
 	<*> optional (option auto
 		( long "pathdepth" <> metavar paramNumber
-		<> help "path components to use in filename"
+		<> help "number of url path components to use in filename"
+		))
+	<*> optional (strOption
+		( long "prefix" <> metavar paramValue
+		<> help "add a prefix to the filename"
+		))
+	<*> optional (strOption
+		( long "suffix" <> metavar paramValue
+		<> help "add a suffix to the filename"
 		))
 	<*> parseRelaxedOption
 	<*> parseRawOption
@@ -80,13 +90,13 @@ seek :: AddUrlOptions -> CommandSeek
 seek o = forM_ (addUrls o) $ \u -> do
 	r <- Remote.claimingUrl u
 	if Remote.uuid r == webUUID || rawOption o
-		then void $ commandAction $ startWeb (relaxedOption o) (fileOption o) (pathdepthOption o) u
+		then void $ commandAction $ startWeb o u
-		else checkUrl r u (fileOption o) (relaxedOption o) (pathdepthOption o)
+		else checkUrl r o u
 
-checkUrl :: Remote -> URLString -> Maybe FilePath -> Bool -> Maybe Int -> Annex ()
+checkUrl :: Remote -> AddUrlOptions -> URLString -> Annex ()
-checkUrl r u optfile relaxed pathdepth = do
+checkUrl r o u = do
 	pathmax <- liftIO $ fileNameLengthLimit "."
-	let deffile = fromMaybe (urlString2file u pathdepth pathmax) optfile
+	let deffile = fromMaybe (urlString2file u (pathdepthOption o) pathmax) (fileOption o)
 	go deffile =<< maybe
 		(error $ "unable to checkUrl of " ++ Remote.name r)
 		(tryNonAsync . flip id u)
@@ -98,14 +108,15 @@ checkUrl r u optfile relaxed pathdepth = do
 		warning (show e)
 		next $ next $ return False
 	go deffile (Right (UrlContents sz mf)) = do
-		let f = fromMaybe (maybe deffile fromSafeFilePath mf) optfile
+		let f = adjustFile o (fromMaybe (maybe deffile fromSafeFilePath mf) (fileOption o))
 		void $ commandAction $
-			startRemote r relaxed f u sz
+			startRemote r (relaxedOption o) f u sz
 	go deffile (Right (UrlMulti l))
-		| isNothing optfile =
+		| isNothing (fileOption o) =
-			forM_ l $ \(u', sz, f) ->
+			forM_ l $ \(u', sz, f) -> do
+				let f' = adjustFile o (deffile </> fromSafeFilePath f)
 				void $ commandAction $
-					startRemote r relaxed (deffile </> fromSafeFilePath f) u' sz
+					startRemote r (relaxedOption o) f' u' sz
 		| otherwise = error $ unwords
 			[ "That url contains multiple files according to the"
 			, Remote.name r
@@ -151,8 +162,8 @@ downloadRemoteFile r relaxed uri file sz = do
   where
 	loguri = setDownloader uri OtherDownloader
 
-startWeb :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart
+startWeb :: AddUrlOptions -> String -> CommandStart
-startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring
+startWeb o s = go $ fromMaybe bad $ parseURI urlstring
   where
 	(urlstring, downloader) = getDownloader s
 	bad = fromMaybe (error $ "bad url " ++ urlstring) $
@@ -170,22 +181,22 @@ startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring
 #endif
 	regulardownload url = do
 		pathmax <- liftIO $ fileNameLengthLimit "."
-		urlinfo <- if relaxed
+		urlinfo <- if relaxedOption o
 			then pure $ Url.UrlInfo True Nothing Nothing
 			else Url.withUrlOptions (Url.getUrlInfo urlstring)
-		file <- case optfile of
+		file <- adjustFile o <$> case fileOption o of
 			Just f -> pure f
 			Nothing -> case Url.urlSuggestedFile urlinfo of
-				Nothing -> pure $ url2file url pathdepth pathmax
+				Nothing -> pure $ url2file url (pathdepthOption o) pathmax
 				Just sf -> do
 					let f = truncateFilePath pathmax $
 						sanitizeFilePath sf
 					ifM (liftIO $ doesFileExist f <||> doesDirectoryExist f)
-						( pure $ url2file url pathdepth pathmax
+						( pure $ url2file url (pathdepthOption o) pathmax
 						, pure f
 						)
 		showStart "addurl" file
-		next $ performWeb relaxed urlstring file urlinfo
+		next $ performWeb (relaxedOption o) urlstring file urlinfo
 #ifdef WITH_QUVI
 	badquvi = error $ "quvi does not know how to download url " ++ urlstring
 	usequvi = do
@@ -193,11 +204,11 @@ startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring
 			<$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] urlstring
 		let link = fromMaybe badquvi $ headMaybe $ Quvi.pageLinks page
 		pathmax <- liftIO $ fileNameLengthLimit "."
-		let file = flip fromMaybe optfile $
+		let file = adjustFile o $ flip fromMaybe (fileOption o) $
 			truncateFilePath pathmax $ sanitizeFilePath $
 				Quvi.pageTitle page ++ "." ++ fromMaybe "m" (Quvi.linkSuffix link)
 		showStart "addurl" file
-		next $ performQuvi relaxed urlstring (Quvi.linkUrl link) file
+		next $ performQuvi (relaxedOption o) urlstring (Quvi.linkUrl link) file
 #else
 	usequvi = error "not built with quvi support"
 #endif
@@ -367,3 +378,9 @@ 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
+
+adjustFile :: AddUrlOptions -> FilePath -> FilePath
+adjustFile o = addprefix . addsuffix
+  where
+	addprefix f = maybe f (++ f) (prefixOption o)
+	addsuffix f = maybe f (f ++) (suffixOption o)

debian/changelog

@@ -17,6 +17,8 @@ git-annex (5.20150714) UNRELEASED; urgency=medium
   * version --raw now works when run outside a git repository.
   * assistant --startdelay now works when run outside a git repository.
   * dead now accepts multiple --key options.
+  * addurl now accepts --prefix and --suffix options to adjust the
+    filenames used.
   * sync --content: Fix bug that caused files to be uploaded to eg,
     more archive remotes than wanted copies, only to later be dropped
     to satisfy the preferred content settings.

doc/git-annex-addurl.mdwn

@@ -48,13 +48,22 @@ be used to get better filenames.
 
 * `--pathdepth=N`
 
-  This causes a shorter filename to be used. For example,
+  Rather than basing the filename on the whole url, this causes a path to
-   `--pathdepth=1` will use "dir/subdir/bigfile",
+  be constructed, starting at the specified depth within the path of the
+  url.
+
+  For example, adding the url http://www.example.com/dir/subdir/bigfile
+  with `--pathdepth=1` will use "dir/subdir/bigfile",
   while `--pathdepth=3` will use "bigfile". 
 
   It can also be negative; `--pathdepth=-2` will use the last
   two parts of the url.
 
+* `--prefix=foo` `--suffix=bar`
+
+  Use to adjust the filenames that are created by addurl. For example,
+  `--suffix=.mp3` can be used to add an extension to the file.
+
 # SEE ALSO
 
 [[git-annex]](1)

doc/todo/Add___39__dir__39___option_to_addurl.mdwn

@@ -1 +1,4 @@
 Is it possible to add a '--dir' option to addurl (or some other mechanic) to make git annex create the symlinks in the specified directory?
+
+> --prefix makes sense, and might as well also add --suffix. [[done]]
+> --[[Joey]]