rachel/viddl
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

used pipes to improve error messages

Browse Source
This commit is contained in:
Rachel Lambda Samuelsson 2021-07-12 17:14:21 +02:00
parent a6c32f4f32
commit 899e88fc7d
3 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Templates/Error.hs
View File

@ -5,6 +5,7 @@ module Templates.Error (errorPage) where
import qualified Data.Text.Lazy as TL
import Text.RawString.QQ
import Text.HTML.SanitizeXSS
errorPage :: TL.Text -> TL.Text
errorPage msg = [r|
@ -17,7 +18,7 @@ errorPage msg = [r|
<body>
<center>
<h1>viddl</h1>
<p>|] <> msg <> [r|</p>
<p>|] <> (TL.fromStrict (sanitize (TL.toStrict msg))) <> [r|</p>
<hr>
<p>viddl is free <a href="https://github.com/depsterr/viddl">open source</a> software and is powered by <a href="https://yt-dl.org/">youtube-dl</a>.</p>
</center>

16
src/YTDL.hs
View File

@ -9,6 +9,7 @@ import qualified Data.ByteString.Lazy.UTF8 as BCU
import System.Directory
import System.Exit
import System.Process
import System.IO
data Resolution
= P144
@ -61,9 +62,13 @@ ytdl url res = ReaderT $ \cfg -> do
print (resToArgs res <> ["-o", fileName, url])
ytdlProc <- createProcess (proc "youtube-dl" (resToArgs res <> ["-o", fileName, url] <> extraYtdlArgs))
{ std_out = CreatePipe
, std_err = CreatePipe }
case ytdlProc of
(_, _, _, ph) -> do
(_, Just hout, Just herr, ph) -> do
err <- hGetContents herr
out <- hGetContents hout
exitCode <- waitForProcess ph
case exitCode of
ExitSuccess -> do
@ -77,4 +82,11 @@ ytdl url res = ReaderT $ \cfg -> 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))
(ExitFailure status) -> pure (Left (concat ["execution failed with status '"
, show status
, "' <pre><code>"
, out, err
, "' </pre></code>"
]))
_ -> pure (Left "Unable to spawn process for downloading")

2
viddl.cabal
View File

@ -30,6 +30,7 @@ library
, pureMD5
, utf8-string
, transformers
, xss-sanitize
hs-source-dirs: src
default-language: Haskell2010
@ -52,5 +53,6 @@ executable viddl
, pureMD5
, utf8-string
, transformers
, xss-sanitize
hs-source-dirs: src
default-language: Haskell2010