make --raw avoid ever running youtube-dl

added DownloadOptions type to avoid needing two different Bool params
for some functions.

This commit was sponsored by Thom May on Patreon.

2 files changed, 118 insertions, 102 deletions

diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 22b4f80bb..0e937dc69 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -39,23 +39,23 @@ cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOption, jsonProgressOptio
 
 data AddUrlOptions = AddUrlOptions
 	{ addUrls :: CmdParams
-	, fileOption :: Maybe FilePath
 	, pathdepthOption :: Maybe Int
 	, prefixOption :: Maybe String
 	, suffixOption :: Maybe String
-	, relaxedOption :: Bool
-	, rawOption :: Bool
+	, downloadOptions :: DownloadOptions
 	, batchOption :: BatchMode
 	, batchFilesOption :: Bool
 	}
 
+data DownloadOptions = DownloadOptions
+	{ relaxedOption :: Bool
+	, rawOption :: Bool
+	, fileOption :: Maybe FilePath
+	}
+
 optParser :: CmdParamsDesc -> Parser AddUrlOptions
 optParser desc = AddUrlOptions
 	<$> cmdParams desc
-	<*> optional (strOption
-		( long "file" <> metavar paramFile
-		<> help "specify what file the url is added to"
-		))
 	<*> optional (option auto
 		( long "pathdepth" <> metavar paramNumber
 		<> help "number of url path components to use in filename"
@@ -68,25 +68,29 @@ optParser desc = AddUrlOptions
 		( long "suffix" <> metavar paramValue
 		<> help "add a suffix to the filename"
 		))
-	<*> parseRelaxedOption
-	<*> parseRawOption
+	<*> parseDownloadOptions True
 	<*> parseBatchOption
 	<*> switch
 		( long "with-files"
 		<> help "parse batch mode lines of the form \"$url $file\""
 		)
 
-parseRelaxedOption :: Parser Bool
-parseRelaxedOption = switch
-	( long "relaxed"
-	<> help "skip size check"
-	)
-
-parseRawOption :: Parser Bool
-parseRawOption = switch
-	( long "raw"
-	<> help "disable special handling for torrents, youtube-dl, etc"
-	)
+parseDownloadOptions :: Bool -> Parser DownloadOptions
+parseDownloadOptions withfileoption = DownloadOptions
+	<$> switch
+		( long "relaxed"
+		<> help "skip size check"
+		)
+	<*> switch
+		( long "raw"
+		<> help "disable special handling for torrents, youtube-dl, etc"
+		)
+	<*> if withfileoption
+		then optional (strOption
+			( long "file" <> metavar paramFile
+			<> help "specify what file the url is added to"
+			))
+		else pure Nothing
 
 seek :: AddUrlOptions -> CommandSeek
 seek o = allowConcurrentOutput $ do
@@ -97,7 +101,7 @@ seek o = allowConcurrentOutput $ do
   where
 	go (o', u) = do
 		r <- Remote.claimingUrl u
-		if Remote.uuid r == webUUID || rawOption o'
+		if Remote.uuid r == webUUID || rawOption (downloadOptions o')
 			then void $ commandAction $ startWeb o' u
 			else checkUrl r o' u
 
@@ -107,13 +111,13 @@ parseBatchInput o s
 		let (u, f) = separate (== ' ') s
 		in if null u || null f
 			then Left ("parsed empty url or filename in input: " ++ s)
-			else Right (o { fileOption = Just f }, u)
+			else Right (o { downloadOptions = (downloadOptions o) { fileOption = Just f } }, u)
 	| otherwise = Right (o, s)
 
 checkUrl :: Remote -> AddUrlOptions -> URLString -> Annex ()
 checkUrl r o u = do
 	pathmax <- liftIO $ fileNameLengthLimit "."
-	let deffile = fromMaybe (urlString2file u (pathdepthOption o) pathmax) (fileOption o)
+	let deffile = fromMaybe (urlString2file u (pathdepthOption o) pathmax) (fileOption (downloadOptions o))
 	go deffile =<< maybe
 		(error $ "unable to checkUrl of " ++ Remote.name r)
 		(tryNonAsync . flip id u)
@@ -125,45 +129,44 @@ checkUrl r o u = do
 		warning (show e)
 		next $ next $ return False
 	go deffile (Right (UrlContents sz mf)) = do
-		let f = adjustFile o (fromMaybe (maybe deffile fromSafeFilePath mf) (fileOption o))
-		void $ commandAction $
-			startRemote r (relaxedOption o) f u sz
+		let f = adjustFile o (fromMaybe (maybe deffile fromSafeFilePath mf) (fileOption (downloadOptions o)))
+		void $ commandAction $ startRemote r o f u sz
 	go deffile (Right (UrlMulti l))
-		| isNothing (fileOption o) =
+		| isNothing (fileOption (downloadOptions o)) =
 			forM_ l $ \(u', sz, f) -> do
 				let f' = adjustFile o (deffile </> fromSafeFilePath f)
 				void $ commandAction $
-					startRemote r (relaxedOption o) f' u' sz
+					startRemote r o f' u' sz
 		| otherwise = giveup $ unwords
 			[ "That url contains multiple files according to the"
 			, Remote.name r
 			, " remote; cannot add it to a single file."
 			]
 
-startRemote :: Remote -> Bool -> FilePath -> URLString -> Maybe Integer -> CommandStart
-startRemote r relaxed file uri sz = do
+startRemote :: Remote -> AddUrlOptions -> FilePath -> URLString -> Maybe Integer -> CommandStart
+startRemote r o file uri sz = do
 	pathmax <- liftIO $ fileNameLengthLimit "."
 	let file' = joinPath $ map (truncateFilePath pathmax) $ splitDirectories file
 	showStart' "addurl" (Just uri)
 	showNote $ "from " ++ Remote.name r 
 	showDestinationFile file'
-	next $ performRemote r relaxed uri file' sz
+	next $ performRemote r o uri file' sz
 
-performRemote :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> CommandPerform
-performRemote r relaxed uri file sz = ifAnnexed file adduri geturi
+performRemote :: Remote -> AddUrlOptions -> URLString -> FilePath -> Maybe Integer -> CommandPerform
+performRemote r o uri file sz = ifAnnexed file adduri geturi
   where
 	loguri = setDownloader uri OtherDownloader
-	adduri = addUrlChecked relaxed loguri file (Remote.uuid r) checkexistssize
+	adduri = addUrlChecked o loguri file (Remote.uuid r) checkexistssize
 	checkexistssize key = return $ case sz of
 		Nothing -> (True, True, uri)
 		Just n -> (True, n == fromMaybe n (keySize key), uri)
-	geturi = next $ isJust <$> downloadRemoteFile r relaxed uri file sz
+	geturi = next $ isJust <$> downloadRemoteFile r (downloadOptions o) uri file sz
 
-downloadRemoteFile :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)
-downloadRemoteFile r relaxed uri file sz = checkCanAdd file $ do
+downloadRemoteFile :: Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)
+downloadRemoteFile r o uri file sz = checkCanAdd file $ do
 	let urlkey = Backend.URL.fromUrl uri sz
 	liftIO $ createDirectoryIfMissing True (parentDir file)
-	ifM (Annex.getState Annex.fast <||> pure relaxed)
+	ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
 		( do
 			addWorkTree (Remote.uuid r) loguri file urlkey Nothing
 			return (Just urlkey)
@@ -190,10 +193,10 @@ startWeb o urlstring = go $ fromMaybe bad $ parseURI urlstring
 	go url = do
 		showStart' "addurl" (Just urlstring)
 		pathmax <- liftIO $ fileNameLengthLimit "."
-		urlinfo <- if relaxedOption o
+		urlinfo <- if relaxedOption (downloadOptions o)
 			then pure Url.assumeUrlExists
 			else Url.withUrlOptions (Url.getUrlInfo urlstring)
-		file <- adjustFile o <$> case fileOption o of
+		file <- adjustFile o <$> case fileOption (downloadOptions o) of
 			Just f -> pure f
 			Nothing -> case Url.urlSuggestedFile urlinfo of
 				Nothing -> pure $ url2file url (pathdepthOption o) pathmax
@@ -209,24 +212,24 @@ startWeb o urlstring = go $ fromMaybe bad $ parseURI urlstring
 performWeb :: AddUrlOptions -> URLString -> FilePath -> Url.UrlInfo -> CommandPerform
 performWeb o url file urlinfo = ifAnnexed file addurl geturl
   where
-	geturl = next $ isJust <$> addUrlFile (Just o) (relaxedOption o) url urlinfo file
-	addurl = addUrlChecked (relaxedOption o) url file webUUID $ \k -> 
-		ifM (youtubeDlSupported url)
+	geturl = next $ isJust <$> addUrlFile (downloadOptions o) url urlinfo file
+	addurl = addUrlChecked o url file webUUID $ \k -> 
+		ifM (pure (not (rawOption (downloadOptions o))) <&&> youtubeDlSupported url)
 			( return (True, True, setDownloader url YoutubeDownloader)
 			, return (Url.urlExists urlinfo, Url.urlSize urlinfo == keySize k, url)
 			)
 
 {- Check that the url exists, and has the same size as the key,
  - and add it as an url to the key. -}
-addUrlChecked :: Bool -> URLString -> FilePath -> UUID -> (Key -> Annex (Bool, Bool, URLString)) -> Key -> CommandPerform
-addUrlChecked relaxed url file u checkexistssize key =
+addUrlChecked :: AddUrlOptions -> URLString -> FilePath -> UUID -> (Key -> Annex (Bool, Bool, URLString)) -> Key -> CommandPerform
+addUrlChecked o url file u checkexistssize key =
 	ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key))
 		( do
 			showDestinationFile file
 			next $ return True
 		, do
 			(exists, samesize, url') <- checkexistssize key
-			if exists && (samesize || relaxed)
+			if exists && (samesize || relaxedOption (downloadOptions o))
 				then do
 					setUrlPresent u key url'
 					next $ return True
@@ -243,15 +246,15 @@ addUrlChecked relaxed url file u checkexistssize key =
  - different file, based on the title of the media. Unless the user
  - specified fileOption, which then forces using the FilePath.
  -}
-addUrlFile :: Maybe AddUrlOptions -> Bool -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
-addUrlFile mo relaxed url urlinfo file =
-	ifM (Annex.getState Annex.fast <||> pure relaxed)
-		( nodownloadWeb mo url urlinfo file
-		, downloadWeb mo url urlinfo file
+addUrlFile :: DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
+addUrlFile o url urlinfo file =
+	ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
+		( nodownloadWeb o url urlinfo file
+		, downloadWeb o url urlinfo file
 		)
 
-downloadWeb :: Maybe AddUrlOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
-downloadWeb mo url urlinfo file =
+downloadWeb :: DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
+downloadWeb o url urlinfo file =
 	go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just file))
   where
 	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing
@@ -261,7 +264,7 @@ downloadWeb mo url urlinfo file =
 	go Nothing = return Nothing
 	-- If we downloaded a html file, try to use youtube-dl to
 	-- extract embedded media.
-	go (Just tmp) = ifM (liftIO $ isHtml <$> readFile tmp)
+	go (Just tmp) = ifM (pure (not (rawOption o)) <&&> liftIO (isHtml <$> readFile tmp))
 		( tryyoutubedl tmp
 		, normalfinish tmp
 		)
@@ -276,7 +279,7 @@ downloadWeb mo url urlinfo file =
 				case dl of
 					Right (Just mediafile) -> do
 						pruneTmpWorkDirBefore tmp (liftIO . nukeFile)
-						let dest = if isJust (fileOption =<< mo)
+						let dest = if isJust (fileOption o)
 							then file
 							else takeFileName mediafile
 						checkCanAdd dest $ do
@@ -374,18 +377,21 @@ addWorkTree u url file key mtmp = case mtmp of
 			, maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . nukeFile)) mtmp
 			)
 
-nodownloadWeb :: Maybe AddUrlOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
-nodownloadWeb mo url urlinfo file
-	| Url.urlExists urlinfo = go =<< youtubeDlFileName url
+nodownloadWeb :: DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
+nodownloadWeb o url urlinfo file
+	| Url.urlExists urlinfo = if rawOption o
+		then nomedia
+		else either (const nomedia) usemedia
+			=<< youtubeDlFileName url
 	| otherwise = do
 		warning $ "unable to access url: " ++ url
 		return Nothing
   where
-	go (Left _) = do
+	nomedia = do
 		let key = Backend.URL.fromUrl url (Url.urlSize urlinfo)
 		nodownloadWeb' url key file
-	go (Right mediafile) = do
-		let dest = if isJust (fileOption =<< mo)
+	usemedia mediafile = do
+		let dest = if isJust (fileOption o)
 			then file
 			else takeFileName mediafile
 		let mediaurl = setDownloader url YoutubeDownloader
diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs
index c003302b6..a02d11824 100644
--- a/Command/ImportFeed.hs
+++ b/Command/ImportFeed.hs
@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -32,7 +32,7 @@ import Types.UrlContents
 import Logs.Web
 import qualified Utility.Format
 import Utility.Tmp
-import Command.AddUrl (addUrlFile, downloadRemoteFile, parseRelaxedOption, parseRawOption)
+import Command.AddUrl (addUrlFile, downloadRemoteFile, parseDownloadOptions, DownloadOptions(..))
 import Annex.Perms
 import Annex.UUID
 import Backend.URL (fromUrl)
@@ -51,8 +51,7 @@ cmd = notBareRepo $
 data ImportFeedOptions = ImportFeedOptions
 	{ feedUrls :: CmdParams
 	, templateOption :: Maybe String
-	, relaxedOption :: Bool
-	, rawOption :: Bool
+	, downloadOptions :: DownloadOptions
 	}
 
 optParser :: CmdParamsDesc -> Parser ImportFeedOptions
@@ -62,8 +61,7 @@ optParser desc = ImportFeedOptions
 		( long "template" <> metavar paramFormat
 		<> help "template for filenames"
 		))
-	<*> parseRelaxedOption
-	<*> parseRawOption
+	<*> parseDownloadOptions False
 
 seek :: ImportFeedOptions -> CommandSeek
 seek o = do
@@ -165,12 +163,19 @@ performDownload opts cache todownload = case location todownload of
 	Enclosure url -> checkknown url $
 		rundownload url (takeWhile (/= '?') $ takeExtension url) $ \f -> do
 			r <- Remote.claimingUrl url
-			if Remote.uuid r == webUUID || rawOption opts
+			if Remote.uuid r == webUUID || rawOption (downloadOptions opts)
 				then do
-					urlinfo <- if relaxedOption opts
+					urlinfo <- if relaxedOption (downloadOptions opts)
 						then pure Url.assumeUrlExists
 						else Url.withUrlOptions (Url.getUrlInfo url)
-					maybeToList <$> addUrlFile Nothing (relaxedOption opts) url urlinfo f
+					let dlopts = (downloadOptions opts)
+						-- force using the filename
+						-- chosen here
+						{ fileOption = Just f
+						-- don't use youtube-dl
+						, rawOption = True
+						}
+					maybeToList <$> addUrlFile dlopts url urlinfo f
 				else do
 					res <- tryNonAsync $ maybe
 						(error $ "unable to checkUrl of " ++ Remote.name r)
@@ -180,10 +185,10 @@ performDownload opts cache todownload = case location todownload of
 						Left _ -> return []
 						Right (UrlContents sz _) ->
 							maybeToList <$>
-								downloadRemoteFile r (relaxedOption opts) url f sz
+								downloadRemoteFile r (downloadOptions opts) url f sz
 						Right (UrlMulti l) -> do
 							kl <- forM l $ \(url', sz, subf) ->
-								downloadRemoteFile r (relaxedOption opts) url' (f </> fromSafeFilePath subf) sz
+								downloadRemoteFile r (downloadOptions opts) url' (f </> fromSafeFilePath subf) sz
 							return $ if all isJust kl
 								then catMaybes kl
 								else []
@@ -196,7 +201,7 @@ performDownload opts cache todownload = case location todownload of
 		-- to avoid adding it a second time.
 		let quviurl = setDownloader linkurl QuviDownloader
 		checkknown mediaurl $ checkknown quviurl $
-			ifM (Annex.getState Annex.fast <||> pure (relaxedOption opts)) 
+			ifM (Annex.getState Annex.fast <||> pure (relaxedOption (downloadOptions opts)))
 				( addmediafast linkurl mediaurl mediakey
 				, downloadmedia linkurl mediaurl mediakey
 				)
@@ -261,36 +266,41 @@ performDownload opts cache todownload = case location todownload of
 			, tryanother
 			)
 	
-	downloadmedia linkurl mediaurl mediakey = do
-		r <- withTmpWorkDir mediakey $ \workdir -> do
-			dl <- youtubeDl linkurl workdir
-			case dl of
-				Right (Just mediafile) -> do
-					let ext = case takeExtension mediafile of
-						[] -> ".m"
-						s -> s
-					ok <- rundownload linkurl ext $ \f -> do
-						addWorkTree webUUID mediaurl f mediakey (Just mediafile)
-						return [mediakey]
-					return (Just ok)
-				-- youtude-dl didn't support it, so
-				-- download it as if the link were
-				-- an enclosure.
-				Right Nothing -> Just <$> 
-					performDownload opts cache todownload
-						{ location = Enclosure linkurl }
-				Left msg -> do
-					warning msg
-					return Nothing
-		return (fromMaybe False r)
-
-	addmediafast linkurl mediaurl mediakey = ifM (youtubeDlSupported linkurl)
-		( rundownload linkurl ".m" $ \f -> do
-			addWorkTree webUUID mediaurl f mediakey Nothing
-			return [mediakey]
-		, performDownload opts cache todownload
+	downloadmedia linkurl mediaurl mediakey
+		| rawOption (downloadOptions opts) = downloadlink
+		| otherwise = do
+			r <- withTmpWorkDir mediakey $ \workdir -> do
+				dl <- youtubeDl linkurl workdir
+				case dl of
+					Right (Just mediafile) -> do
+						let ext = case takeExtension mediafile of
+							[] -> ".m"
+							s -> s
+						ok <- rundownload linkurl ext $ \f -> do
+							addWorkTree webUUID mediaurl f mediakey (Just mediafile)
+							return [mediakey]
+						return (Just ok)
+					-- youtude-dl didn't support it, so
+					-- download it as if the link were
+					-- an enclosure.
+					Right Nothing -> Just <$> downloadlink
+					Left msg -> do
+						warning msg
+						return Nothing
+			return (fromMaybe False r)
+	  where
+		downloadlink = performDownload opts cache todownload
 			{ location = Enclosure linkurl }
-		)
+
+	addmediafast linkurl mediaurl mediakey =
+		ifM (pure (not (rawOption (downloadOptions opts)))
+		     <&&> youtubeDlSupported linkurl)
+			( rundownload linkurl ".m" $ \f -> do
+				addWorkTree webUUID mediaurl f mediakey Nothing
+				return [mediakey]
+			, performDownload opts cache todownload
+				{ location = Enclosure linkurl }
+			)
 
 defaultTemplate :: String
 defaultTemplate = "${feedtitle}/${itemtitle}${extension}"