From f34803b6fba5e8d55aee28bb0e5e52b868beec82 Mon Sep 17 00:00:00 2001 From: nisstyre56 Date: Sat, 4 Jul 2015 19:32:30 -0400 Subject: [PATCH] add track metadata --- Database.hs | 32 ++++++++++++++--- Internal.hs | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++++ Main.hs | 1 + Search.hs | 3 +- 4 files changed, 129 insertions(+), 7 deletions(-) create mode 100644 Internal.hs diff --git a/Database.hs b/Database.hs index 0815b41..30834ee 100644 --- a/Database.hs +++ b/Database.hs @@ -8,10 +8,12 @@ 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 qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString as B import Data.String.Utils +import Data.Maybe +import Control.Applicative -toPath :: String -> MP.Path {- - unsafeCoerce is needed because the "Path" - type is a newtype that represents a ByteString type. @@ -20,8 +22,28 @@ toPath :: String -> MP.Path - Therefore we just coerce to that type, which - is the exact same type anyway -} -toPath = C.unsafeCoerce . B.pack . strip . head . split "\n" +toPath :: String -> MP.Path +toPath = C.unsafeCoerce . BC.pack . strip . head . split "\n" + +toValue :: B.ByteString -> MP.Value +toValue = C.unsafeCoerce + +changeTitle :: TIO.Text -> Maybe MP.Song -> IO (MP.Response ()) +changeTitle _ Nothing = error "empty playlist" + +changeTitle title' (Just song) = do + let title = encodeUtf8 title' + case (MP.sgId song) of + Nothing -> error "tried to modify a non-existent track" + (Just sid) -> do + MP.withMPD $ + MP.addTagId sid MP.Title (toValue title) -addSingle url = do - fullUrl <- readProcess "youtube-dl" ["-g", "-f", "bestaudio", (TIO.unpack url)] "" +addSingle :: SearchResult -> IO (MP.Response ()) +addSingle track = do + let trackUrl = url track + let trackTitle = title track + fullUrl <- readProcess "youtube-dl" ["-g", "-f", "bestaudio", (TIO.unpack trackUrl)] "" MP.withMPD $ MP.add $ toPath fullUrl + (Right pl) <- (MP.withMPD $ MP.playlistInfo Nothing) + changeTitle trackTitle (listToMaybe $ reverse pl) diff --git a/Internal.hs b/Internal.hs new file mode 100644 index 0000000..36804ee --- /dev/null +++ b/Internal.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +{- | +Module : Network.MPD.Applicative.Internal +Copyright : (c) Simon Hengel 2012 +License : MIT + +Maintainer : joachifm@fastmail.fm +Stability : stable +Portability : unportable + +Applicative MPD command interface. + +This allows us to combine commands into command lists, as in + +> (,,) <$> currentSong <*> stats <*> status + +where the requests are automatically combined into a command list and +the result of each command passed to the consumer. +-} + +module Internal + ( Parser(..) + , liftParser + , getResponse + , emptyResponse + , unexpected + , Command(..) + , runCommand + ) where + +import Control.Applicative +import Control.Monad +import Data.ByteString.Char8 (ByteString) + +import Network.MPD.Core hiding (getResponse) +import qualified Network.MPD.Core as Core +import Control.Monad.Error + +-- | A line-oriented parser that returns a value along with any remaining input. +newtype Parser a + = Parser { runParser :: [ByteString] -> Either String (a, [ByteString]) } + deriving Functor + +instance Monad Parser where + fail = Parser . const . Left + return a = Parser $ \input -> Right (a, input) + p1 >>= p2 = Parser $ \input -> runParser p1 input >>= uncurry (runParser . p2) + +instance Applicative Parser where + pure = return + (<*>) = ap + +-- | Convert a regular parser. +liftParser :: ([ByteString] -> Either String a) -> Parser a +liftParser p = Parser $ \input -> case break (== "list_OK") input of + (xs, ys) -> fmap (, drop 1 ys) (p xs) + +-- | Return everything until the next "list_OK". +getResponse :: Parser [ByteString] +getResponse = Parser $ \input -> case break (== "list_OK") input of + (xs, ys) -> Right (xs, drop 1 ys) + +-- | For commands returning an empty response. +emptyResponse :: Parser () +emptyResponse = do + r <- getResponse + unless (null r) $ + unexpected r + +-- | Fail with unexpected response. +unexpected :: [ByteString] -> Parser a +unexpected = fail . ("unexpected Response: " ++) . show + +-- | A compound command, comprising a parser for the responses and a +-- combined request of an arbitrary number of commands. +data Command a = Command { + commandParser :: Parser a + , commandRequest :: [String] + } deriving Functor + +instance Applicative Command where + pure a = Command (pure a) [] + (Command p1 c1) <*> (Command p2 c2) = Command (p1 <*> p2) (c1 ++ c2) + +-- | Execute a 'Command'. +runCommand :: MonadMPD m => Command a -> m a +runCommand (Command p c) = do + r <- Core.getResponse command + case runParser p r of + Left err -> throwError (Unexpected err) + Right (a, []) -> return a + Right (_, xs) -> throwError (Unexpected $ "superfluous input: " ++ show xs) + where + command = case c of + [x] -> x + xs -> unlines ("command_list_ok_begin" : xs) + ++ "command_list_end" diff --git a/Main.hs b/Main.hs index d6698f0..928ee3b 100644 --- a/Main.hs +++ b/Main.hs @@ -1,6 +1,7 @@ module Main where import Search +import Network.MPD.Applicative.CurrentPlaylist import Types import Database import Data.List diff --git a/Search.hs b/Search.hs index 63c523a..194b040 100644 --- a/Search.hs +++ b/Search.hs @@ -71,8 +71,7 @@ search term = do accessTok <- fmap (accessToken . read) (readFile file) findTracks client accessTok $ urlEncode term -firstResult = url . head $. search -allResults = map url $. search +firstResult = head $. 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