Browse Source

Make it add shit to MPD in a playlist

master
nisstyre56 9 years ago
parent
commit
a8c1d4949b
  1. 27
      Database.hs
  2. 9
      Main.hs
  3. 25
      Search.hs

27
Database.hs

@ -0,0 +1,27 @@
{-# LANGUAGE OverloadedStrings #-}
module Database where
import qualified Network.MPD as MP
import Types
import Search
import qualified Unsafe.Coerce as C
import qualified Data.Text as TIO
import Data.Text.Encoding
import System.Process
import qualified Data.ByteString.Char8 as B
import Data.String.Utils
toPath :: String -> MP.Path
{-
- unsafeCoerce is needed because the "Path"
- type is a newtype that represents a ByteString type.
- In the MPD library the Types module is a hidden
- module, so we can't use the constructor for it.
- Therefore we just coerce to that type, which
- is the exact same type anyway
-}
toPath = C.unsafeCoerce . B.pack . strip . head . split "\n"
addSingle url = do
fullUrl <- readProcess "youtube-dl" ["-g", "-f", "bestaudio", (TIO.unpack url)] ""
MP.withMPD $ MP.add $ toPath fullUrl

9
Main.hs

@ -2,9 +2,12 @@ module Main where
import Search import Search
import Types import Types
import Database
import Data.List
import System.Environment (getArgs)
import qualified Data.Text.IO as TIO (putStrLn) import qualified Data.Text.IO as TIO (putStrLn)
main = do main = do
term <- getContents term <- getArgs
results <- search term result <- firstResult $ intercalate " " term
TIO.putStrLn $ url $ head $ results addSingle result

25
Search.hs

@ -1,6 +1,7 @@
module Search where module Search where
import Control.Monad (unless) import Data.Function
import Control.Monad (liftM2, unless, join, (>=>), (<=<))
import System.Info (os) import System.Info (os)
import System.Process (system, rawSystem) import System.Process (system, rawSystem)
import System.Exit (ExitCode(..)) import System.Exit (ExitCode(..))
@ -43,20 +44,16 @@ searchRequest keyword accessTok =
"&type=video&access_token=" ++ "&type=video&access_token=" ++
accessTok accessTok
getNewTokens :: OAuth2Client -> IO OAuth2Tokens getNewTokens :: OAuth2Client -> IO ()
getNewTokens client = do getNewTokens client = do
tokens <- read <$> readFile file tokens <- read <$> readFile file
newTokens <- refreshTokens client tokens newTokens <- refreshTokens client tokens
writeFile file (show newTokens) writeFile file (show newTokens)
return newTokens
findTracks :: OAuth2Client -> String -> String -> IO [SearchResult]
findTracks client accessTok term = do findTracks client accessTok term = do
response <- (try $ simpleHttp $ searchRequest term accessTok) :: IO (Either HttpException BL.ByteString) response <- (try $ simpleHttp $ searchRequest term accessTok) :: IO (Either HttpException BL.ByteString)
case response of case response of
(Left _) -> do (Left _) -> getNewTokens client >> search (urlDecode term)
tokens <- getNewTokens client
findTracks client (accessToken tokens) term
(Right resp) -> return $ getItems resp (Right resp) -> return $ getItems resp
search :: String -> IO [SearchResult] search :: String -> IO [SearchResult]
@ -72,4 +69,16 @@ search term = do
putStrLn $ "Received access token: " ++ show (accessToken tokens) putStrLn $ "Received access token: " ++ show (accessToken tokens)
writeFile file (show tokens) writeFile file (show tokens)
accessTok <- fmap (accessToken . read) (readFile file) accessTok <- fmap (accessToken . read) (readFile file)
findTracks client accessTok (urlEncode term) findTracks client accessTok $ urlEncode term
firstResult = url . head $. search
allResults = map url $. search
withDescriptions = map ((T.drop 3) . liftM2 (T.append `on` (T.append " : ")) url description) $. search
withTitles = map ((T.drop 3) . liftM2 (T.append `on` (T.append " : ")) url title) $. search
withDescriptionsStr = T.intercalate "\n" $. withDescriptions
withTitlesStr = T.intercalate "\n" $. withTitles
infixr 8 $.
a $. b = \x -> do
y <- b x
return $ a y