diff options
| -rw-r--r-- | Annex/YoutubeDl.hs | 7 | ||||
| -rw-r--r-- | Command/ImportFeed.hs | 19 | ||||
| -rw-r--r-- | Remote/Web.hs | 2 |
3 files changed, 13 insertions, 15 deletions
diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs index 18e363eb5..1eafa4173 100644 --- a/Annex/YoutubeDl.hs +++ b/Annex/YoutubeDl.hs @@ -80,9 +80,12 @@ youtubeDlTo key url dest = do return False Right r -> return r +youtubeDlSupported :: URLString -> Annex Bool +youtubeDlSupported url = either (const False) id <$> youtubeDlCheck url + -- Check if youtube-dl can still find media in an url. -youtubeDlSupported :: URLString -> Annex (Either String Bool) -youtubeDlSupported url = catchMsgIO $ do +youtubeDlCheck :: URLString -> Annex (Either String Bool) +youtubeDlCheck url = catchMsgIO $ do opts <- map Param . annexYoutubeDlOptions <$> Annex.getGitConfig let opts' = opts ++ [ Param url, Param "--simulate" ] liftIO $ snd <$> processTranscript "youtube-dl" (toCommand opts') Nothing diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index c860f637f..1720060bd 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -286,18 +286,13 @@ performDownload opts cache todownload = case location todownload of return False Right b -> return b - addmediafast linkurl mediaurl mediakey = - youtubeDlSupported linkurl >>= \case - Right True -> - rundownload linkurl ".m" $ \f -> do - addWorkTree webUUID mediaurl f mediakey Nothing - return [mediakey] - Right False -> - performDownload opts cache todownload - { location = Enclosure linkurl } - Left msg -> do - warning msg - return False + addmediafast linkurl mediaurl mediakey = ifM (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}" diff --git a/Remote/Web.hs b/Remote/Web.hs index 5ad66cb15..5aa1edd3e 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -106,7 +106,7 @@ checkKey' key us = firsthit us (Right False) $ \u -> do let (u', downloader) = getDownloader u showChecking u' case downloader of - YoutubeDownloader -> youtubeDlSupported u' + YoutubeDownloader -> youtubeDlCheck u' _ -> do Url.withUrlOptions $ catchMsgIO . Url.checkBoth u' (keySize key) |