82 lines
2.6 KiB
Haskell
82 lines
2.6 KiB
Haskell
module YTDL (Resolution(..), ytdl) where
|
|
|
|
import Config
|
|
|
|
import Control.Monad.Trans.Reader
|
|
import Control.Monad.Trans.Class
|
|
import Control.Concurrent (forkIO, threadDelay)
|
|
import Data.Digest.Pure.MD5
|
|
import qualified Data.ByteString.Lazy.UTF8 as BCU
|
|
import System.Directory
|
|
import System.Exit
|
|
import System.Process
|
|
|
|
data Resolution
|
|
= P144
|
|
| P240
|
|
| P360
|
|
| P480
|
|
| P720
|
|
| P1080
|
|
| PMAX
|
|
| Audio
|
|
deriving (Eq, Show)
|
|
|
|
wrapResString :: String -> [String]
|
|
wrapResString str = ["-f", concat ["bestvideo[ext=mp4,height<=", str,
|
|
"]+bestaudio[ext=m4a]/mp4[height<=", str, "]"], "--merge-output-format", "mp4"]
|
|
|
|
resToArgs :: Resolution -> [String]
|
|
resToArgs (P144) = wrapResString "144"
|
|
resToArgs (P240) = wrapResString "240"
|
|
resToArgs (P360) = wrapResString "360"
|
|
resToArgs (P480) = wrapResString "480"
|
|
resToArgs (P720) = wrapResString "720"
|
|
resToArgs (P1080) = wrapResString "1080"
|
|
resToArgs (PMAX) = ["-f", "bestvideo[ext=mp4]+bestaudio[ext=m4a]/mp4", "--merge-output-format", "mp4"]
|
|
resToArgs (Audio) = ["-x", "--audio-format", "mp3"]
|
|
|
|
ytdl :: String -> Resolution -> ReaderT ViddlConfig IO (Either String FilePath)
|
|
ytdl url res = do
|
|
cfg <- ask
|
|
|
|
let ext = case res of { Audio -> ".mp3"; _ -> ".mp4" }
|
|
|
|
let ident = show . md5 . BCU.fromString $ url <> show res
|
|
|
|
let dir = concat [dlDir cfg, "/", ident]
|
|
let fileName = concat [dir, "/", ident, ext]
|
|
|
|
processed <- lift $ doesFileExist fileName
|
|
if processed
|
|
then do
|
|
lift $ putStrLn $ "Returning existing ident " <> ident
|
|
pure (Right fileName)
|
|
else do
|
|
lift $ putStrLn $ "Processing new ident " <> ident
|
|
|
|
lift $ createDirectoryIfMissing True dir
|
|
|
|
lift $ print (resToArgs res <> ["-o", fileName, url])
|
|
|
|
ytdlProc <- lift $ createProcess (proc "youtube-dl" (resToArgs res <> ["-o", fileName, url]))
|
|
|
|
case ytdlProc of
|
|
(_, _, _, ph) -> do
|
|
exitCode <- lift $ waitForProcess ph
|
|
case exitCode of
|
|
ExitSuccess -> do
|
|
exists <- lift $ doesFileExist fileName
|
|
if exists
|
|
then do
|
|
-- wait 5 minutes and then delete the directory
|
|
_ <- lift $ forkIO $ threadDelay 300000000 >> removeDirectoryRecursive dir
|
|
pure (Right fileName)
|
|
else do
|
|
-- removeDirectoryRecursive dir
|
|
pure (Left "An unknown error prevented the output file from being created")
|
|
|
|
(ExitFailure status) -> pure (Left ("execution failed with status " <> show status))
|
|
|
|
_ -> pure (Left "Unable to create ytdlProcess for downloading video")
|