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 qualified Data.Text.Lazy as TL
import Text.RawString.QQ import Text.RawString.QQ
import Text.HTML.SanitizeXSS
errorPage :: TL.Text -> TL.Text errorPage :: TL.Text -> TL.Text
errorPage msg = [r| errorPage msg = [r|
@ -17,7 +18,7 @@ errorPage msg = [r|
<body> <body>
<center> <center>
<h1>viddl</h1> <h1>viddl</h1>
<p>|] <> msg <> [r|</p> <p>|] <> (TL.fromStrict (sanitize (TL.toStrict msg))) <> [r|</p>
<hr> <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> <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> </center>

16
src/YTDL.hs
View File

@ -9,6 +9,7 @@ import qualified Data.ByteString.Lazy.UTF8 as BCU
import System.Directory import System.Directory
import System.Exit import System.Exit
import System.Process import System.Process
import System.IO
data Resolution data Resolution
= P144 = P144
@ -61,9 +62,13 @@ ytdl url res = ReaderT $ \cfg -> do
print (resToArgs res <> ["-o", fileName, url]) print (resToArgs res <> ["-o", fileName, url])
ytdlProc <- createProcess (proc "youtube-dl" (resToArgs res <> ["-o", fileName, url] <> extraYtdlArgs)) ytdlProc <- createProcess (proc "youtube-dl" (resToArgs res <> ["-o", fileName, url] <> extraYtdlArgs))
{ std_out = CreatePipe
, std_err = CreatePipe }
case ytdlProc of case ytdlProc of
(_, _, _, ph) -> do (_, Just hout, Just herr, ph) -> do
err <- hGetContents herr
out <- hGetContents hout
exitCode <- waitForProcess ph exitCode <- waitForProcess ph
case exitCode of case exitCode of
ExitSuccess -> do ExitSuccess -> do
@ -77,4 +82,11 @@ ytdl url res = ReaderT $ \cfg -> do
removeDirectoryRecursive dir removeDirectoryRecursive dir
pure (Left "An unknown error prevented the output file from being created") 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 , pureMD5
, utf8-string , utf8-string
, transformers , transformers
, xss-sanitize
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
@ -52,5 +53,6 @@ executable viddl
, pureMD5 , pureMD5
, utf8-string , utf8-string
, transformers , transformers
, xss-sanitize
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010