Browse Source

handle exceptions properly, use concurrency when getting the urls

master
wes 9 years ago
parent
commit
37f0d15e88
  1. 2
      Database.hs
  2. 18
      M3U.hs
  3. 2
      Main.hs
  4. 18
      Playlists.hs
  5. 2
      Search.hs

2
Database.hs

@ -62,7 +62,7 @@ addSingle :: SearchResult -> IO (Response [B.ByteString])
addSingle track = do addSingle track = do
let trackUrl = url track let trackUrl = url track
let trackDesc = title track let trackDesc = title track
fullUrl <- getUrl trackUrl (Just fullUrl) <- getUrl trackUrl
newId <- MP.withMPD $ MP.addId (toPath fullUrl) Nothing newId <- MP.withMPD $ MP.addId (toPath fullUrl) Nothing
--downUrl trackUrl --downUrl trackUrl
either (const $ changeTitle trackDesc newId) either (const $ changeTitle trackDesc newId)

18
M3U.hs

@ -3,6 +3,7 @@ module M3U where
import Types import Types
import qualified Data.Text as TIO import qualified Data.Text as TIO
import qualified Control.Monad as M (join)
import Data.Text.Encoding import Data.Text.Encoding
import Data.Maybe import Data.Maybe
import Control.Applicative import Control.Applicative
@ -12,6 +13,7 @@ import qualified Data.Attoparsec.Text as AT
import Utils import Utils
import Playlists import Playlists
import Search import Search
import Control.Concurrent.Async
m3uHeader = "#EXTM3U" m3uHeader = "#EXTM3U"
trackHeader = "#EXTINF" trackHeader = "#EXTINF"
@ -29,15 +31,23 @@ toExtinf track =
makeHeader (artist `mappend` " - " `mappend` title `mappend` "\n") makeHeader (artist `mappend` " - " `mappend` title `mappend` "\n")
Left trackname -> makeHeader $ TIO.pack (trackname `mappend` "\n") Left trackname -> makeHeader $ TIO.pack (trackname `mappend` "\n")
singleTrack :: SearchResult -> IO (Maybe TIO.Text)
singleTrack track = do singleTrack track = do
let extinf = toExtinf track let extinf = toExtinf track
trackUrl <- TIO.pack <$> (getUrl $ url track) maybeUrl <- getUrl $ url track
return $ extinf `mappend` trackUrl `mappend` "\n" case maybeUrl of
(Just trackUrl) -> (return $ (Just extinf) `mappend` (Just $ TIO.pack trackUrl) `mappend` (Just "\n"))
Nothing -> return Nothing
genm3u :: [SearchResult] -> IO M3U genm3u :: [SearchResult] -> IO M3U
genm3u srs = do genm3u srs = do
tracks <- mapM singleTrack srs tracks <- (mapConcurrently singleTrack srs)
return $ return $
M3U $ m3uHeader `mappend` M3U $ m3uHeader `mappend`
"\n" `mappend` "\n" `mappend`
(mconcat tracks) (mconcat $ catMaybes tracks)
searchM3U term = do
(M3U m3u) <- M.join (genm3u <$> search term)
return m3u

2
Main.hs

@ -6,7 +6,7 @@ import Types
import Database import Database
import Data.List import Data.List
import System.Environment (getArgs) import System.Environment (getArgs)
import qualified Data.Text.IO as TIO (putStrLn, putStr) import qualified Data.Text.IO as TIO (putStrLn, putStr, writeFile)
import qualified Control.Monad as M import qualified Control.Monad as M
import M3U import M3U

18
Playlists.hs

@ -2,18 +2,22 @@ module Playlists where
import qualified Data.Text as TIO import qualified Data.Text as TIO
import System.Process (readProcess) import System.Process (readProcess)
import Control.Concurrent.Async
import Control.Exception
import Utils import Utils
import Control.Monad
getUrl :: TIO.Text -> IO String getUrls = mapConcurrently getUrl
getUrl :: TIO.Text -> IO (Maybe String)
-- Gets a direct url using youtube-dl -- Gets a direct url using youtube-dl
-- (if it is installed, otherwise we might fallback to some shitty code) -- (if it is installed, otherwise we might fallback to some shitty code)
getUrl yourl = readProcess "youtube-dl" getUrl yourl =
["-g", let url = catch (Just <$> (readProcess "youtube-dl"
"-f", ["-g", "-f", "bestaudio", TIO.unpack yourl, "--no-cache-dir"] "")) ((\e -> return Nothing) :: SomeException -> IO (Maybe String))
"bestaudio", in url
TIO.unpack yourl,
"--no-cache-dir"] ""
downUrl yourl = readProcess "youtube-dl" downUrl yourl = readProcess "youtube-dl"
["-f", ["-f",
"bestaudio", "bestaudio",

2
Search.hs

@ -17,7 +17,7 @@ import Control.Exception
import Network.HTTP.Base (urlEncode, urlDecode) import Network.HTTP.Base (urlEncode, urlDecode)
import Types import Types
maxResults = 10 maxResults = 50
makeURL :: T.Text -> T.Text makeURL :: T.Text -> T.Text
makeURL vid = "https://youtube.com/watch?v=" `T.append` vid makeURL vid = "https://youtube.com/watch?v=" `T.append` vid