switched to having templates in the source code
parent
84897aea9c
commit
f4454e5612
75
src/Main.hs
75
src/Main.hs
|
|
@ -2,10 +2,15 @@
|
|||
|
||||
module Main where
|
||||
|
||||
import Templates.Index
|
||||
import Templates.Loading
|
||||
import Templates.Error
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
import qualified Database.Redis as R
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import Web.Scotty
|
||||
import System.Posix.Process (executeFile)
|
||||
import Network.URI (URI, parseURI)
|
||||
|
||||
data Resolution
|
||||
= P144
|
||||
|
|
@ -16,46 +21,76 @@ data Resolution
|
|||
| P1080
|
||||
| PMAX
|
||||
| PMIN
|
||||
| Audio
|
||||
deriving (Eq, Show)
|
||||
|
||||
getRes :: String -> Maybe Resolution
|
||||
getRes ("144p") = P144
|
||||
getRes ("240p") = P240
|
||||
getRes ("360p") = P360
|
||||
getRes ("480p") = P480
|
||||
getRes ("720p") = P720
|
||||
getRes ("1080p") = P1080
|
||||
getRes ("min") = PMAX
|
||||
getRes ("max") = PMIN
|
||||
getRes ("144p") = Just P144
|
||||
getRes ("240p") = Just P240
|
||||
getRes ("360p") = Just P360
|
||||
getRes ("480p") = Just P480
|
||||
getRes ("720p") = Just P720
|
||||
getRes ("1080p") = Just P1080
|
||||
getRes ("min") = Just PMAX
|
||||
getRes ("max") = Just PMIN
|
||||
getRes ("audio") = Just Audio
|
||||
getRes ("max") = Nothing
|
||||
|
||||
downloadVideo :: String -> Resolution -> IO Filepath
|
||||
isRes :: TL.Text -> Bool
|
||||
isRes res = case getRes (TL.unpack res) of
|
||||
(Just _) -> True
|
||||
_ -> False
|
||||
|
||||
isURL :: TL.Text -> Bool
|
||||
isURL uri = case parseURI (TL.unpack uri) of
|
||||
(Just _) -> True
|
||||
_ -> False
|
||||
|
||||
-- todo: config file
|
||||
maxClients :: Int
|
||||
maxClients = 100
|
||||
|
||||
getClients :: IO Int
|
||||
getClients = undefined
|
||||
|
||||
acceptingClients :: IO Bool
|
||||
acceptingClients = do
|
||||
clients <- getClients
|
||||
pure $ clients < maxClients
|
||||
|
||||
downloadVideo :: String -> Resolution -> IO FilePath
|
||||
downloadVideo url res = do
|
||||
undefined
|
||||
|
||||
downloadAudio :: String -> IO Filepath
|
||||
downloadAudio :: String -> IO FilePath
|
||||
downloadAudio url = do
|
||||
undefined
|
||||
|
||||
getIndex :: IO String
|
||||
getIndex = readFile "views/index.html"
|
||||
|
||||
app :: R.Connection -> ScottyM ()
|
||||
app rConn = do
|
||||
get "/" $ do
|
||||
setHeader "Content-Type" "text/html;charset=utf-8"
|
||||
file "views/index.html"
|
||||
html indexPage
|
||||
|
||||
post "/" $ do
|
||||
setHeader "Content-Type" "text/html;charset=utf-8"
|
||||
file "views/loading.html"
|
||||
url <- param "url"
|
||||
res <- param "resolution"
|
||||
-- set redis stuff and id here
|
||||
redirect '/':id
|
||||
if (isURL url) && (isRes res)
|
||||
then do
|
||||
queueOK <- liftIO acceptingClients
|
||||
if queueOK
|
||||
then do
|
||||
html loadingPage
|
||||
-- set redis stuff and id here
|
||||
-- redirect $ TL.pack $ '/':id
|
||||
else
|
||||
html $ errorPage "Too many clients right now. Try again later!"
|
||||
else
|
||||
html $ errorPage "Invalid input!"
|
||||
|
||||
get "/:id" $ do
|
||||
-- grab id and process video if not already done
|
||||
id <- param "id"
|
||||
html id
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
|
|||
|
|
@ -0,0 +1,25 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Templates.Error (errorPage) where
|
||||
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import Text.RawString.QQ
|
||||
|
||||
errorPage :: TL.Text -> TL.Text
|
||||
errorPage msg = [r|
|
||||
<!DOCTYPE html>
|
||||
<head>
|
||||
<meta cherset="UTF-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0">
|
||||
<title>viddl</title>
|
||||
</head>
|
||||
<body>
|
||||
<center>
|
||||
<h1>viddl</h1>
|
||||
<p>|] <> 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>
|
||||
</body>
|
||||
|]
|
||||
|
|
@ -1,3 +1,13 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Templates.Index (indexPage) where
|
||||
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import Text.RawString.QQ
|
||||
|
||||
indexPage :: TL.Text
|
||||
indexPage = [r|
|
||||
<!DOCTYPE html>
|
||||
<head>
|
||||
<meta cherset="UTF-8">
|
||||
|
|
@ -32,6 +42,7 @@
|
|||
<h2>Audio only download</h2>
|
||||
<form method="post" action="/">
|
||||
<input required name="url" type="text" placeholder="Enter url here"><br>
|
||||
<input type="hidden" name="resolution" value="audio">
|
||||
<input type="submit" value="Download">
|
||||
</form>
|
||||
</td>
|
||||
|
|
@ -41,3 +52,4 @@
|
|||
<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>
|
||||
</body>
|
||||
|]
|
||||
|
|
@ -1,3 +1,13 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Templates.Loading (loadingPage) where
|
||||
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import Text.RawString.QQ
|
||||
|
||||
loadingPage :: TL.Text
|
||||
loadingPage = [r|
|
||||
<!DOCTYPE html>
|
||||
<head>
|
||||
<meta cherset="UTF-8">
|
||||
|
|
@ -12,3 +22,4 @@
|
|||
<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>
|
||||
</body>
|
||||
|]
|
||||
|
|
@ -15,7 +15,9 @@ extra-source-files: CHANGELOG.md
|
|||
|
||||
executable viddl
|
||||
main-is: Main.hs
|
||||
-- other-modules:
|
||||
other-modules: Templates.Index
|
||||
, Templates.Loading
|
||||
, Templates.Error
|
||||
-- other-extensions:
|
||||
ghc-options: -Wall -O2
|
||||
build-depends: base ^>=4.14.1.0
|
||||
|
|
@ -24,5 +26,7 @@ executable viddl
|
|||
, transformers
|
||||
, text
|
||||
, unix
|
||||
, raw-strings-qq
|
||||
, network-uri
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
Loading…
Reference in New Issue