{-# LANGUAGE Rank2Types #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.MPD -- Copyright : Daniel Schoepe -- License : BSD3-style (see LICENSE) -- -- Maintainer : Daniel Schoepe -- Stability : unstable -- Portability : unportable -- -- This module lets the user select songs and have MPD add/play them by -- filtering them by user-supplied criteria(E.g. ask for an artist, then for -- the album..) -- ----------------------------------------------------------------------------- module XMonad.Prompt.MPD (-- * Usage -- $usage findMatching, findMatchingWith, addMatching, addMatchingWith, addAndPlay, addAndPlayWith, loadPlaylist, loadPlaylistWith, addAndPlayAny, pickPlayListItem, RunMPD, findOrAdd ) where import Control.Monad import Data.Char import Data.List as L import qualified Data.Map as M import Data.Maybe import Data.String import Network.MPD import XMonad hiding ((=?)) import XMonad.Prompt import Data.List as L (find, isPrefixOf, nub) import qualified Data.ByteString.Char8 as C -- $usage -- -- To use this, import the following modules: -- -- > import XMonad.Prompt.MPD -- > import qualified Network.MPD as MPD -- -- You can then use this in a keybinding, to filter first by artist, then by -- album and add the matching songs: -- -- > addMatching MPD.withMPD defaultXPConfig [MPD.Artist, MPD.Album] >> return () -- -- That way you will first be asked for an artist name, then for an album by -- that artist etc.. -- -- If you need a password to connect to your MPD or need a different host/port, -- you can pass a partially applied withMPDEx to the function: -- -- > addMatching (MPD.withMPDEx "your.host" 4242 "very secret") .. -- -- | Allows the user to supply a custom way to connect to MPD (e.g. partially -- applied withMPDEx). type RunMPD = forall a . MPD a -> IO (Response a) -- | A new prompt type since Prompt.Input causes problems when completing -- strings with spaces in them data MPDPrompt = MPDPrompt String instance XPrompt MPDPrompt where showXPrompt (MPDPrompt s) = s ++ ": " nextCompletion = const getNextCompletion commandToComplete = const id -- | Extracts the given metadata attribute from a Song extractMetadata :: Metadata -> Song -> String extractMetadata meta = fromMaybe "Unknown" . join . fmap listToMaybe . M.lookup meta . M.map (map toString) . sgTags -- | Creates a case-insensitive completion function from a list. mkComplLst :: (String -> String -> Bool) -> [String] -> String -> IO [String] mkComplLst cmp lst s = return . filter matches $ lst where matches s' = map toLower s `cmp` map toLower s' -- | Helper function for 'findMatching' findMatching' :: (String -> String -> Bool) -> XPConfig -> [Song] -> Metadata -> X [Song] findMatching' _ _ [] _ = return [] findMatching' cmp xp songs meta = do answer <- mkXPromptWithReturn (MPDPrompt (show meta)) xp (mkComplLst cmp . nub . map (extractMetadata meta) $ songs) return case answer of Just input -> return $ filter ((==input) . extractMetadata meta) songs Nothing -> return [] extractSongs :: [LsResult] -> [Song] extractSongs = mapMaybe extractSong where extractSong (LsSong s) = Just s extractSong _ = Nothing -- | Lets the user filter out non-matching songs. For example, if given -- [Artist, Album] as third argument, this will prompt the user for an -- artist(with tab-completion), then for an album by that artist and then -- returns the songs from that album. -- -- @since 0.13.2 findMatchingWith :: (String -> String -> Bool) -> RunMPD -> XPConfig -> [Metadata] -> X [Song] findMatchingWith matchFun runMPD xp metas = do resp <- io . runMPD . fmap extractSongs . listAllInfo $ ("" :: Path) case resp of Left err -> trace ("XMonad.Prompt.MPD: MPD returned an error: " ++ show err) >> return [] Right songs -> foldM (findMatching' matchFun xp) songs metas -- | Lets the user filter out non-matching songs. For example, if given -- [Artist, Album] as third argument, this will prompt the user for an -- artist(with tab-completion), then for an album by that artist and then -- returns the songs from that album. findMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Song] findMatching = findMatchingWith isPrefixOf -- | Determine playlist position of the song and add it, if it isn't present. findOrAdd :: Song -> MPD Int findOrAdd s = playlistInfo Nothing >>= \pl -> case L.find ((== sgFilePath s) . sgFilePath) pl of Just (Song { sgIndex = Just i }) -> return i _ -> fmap unwrapId . flip addId Nothing . sgFilePath $ s where unwrapId (Id i) = i -- | Add all selected songs to the playlist if they are not in it. -- -- @since 0.13.2 addMatchingWith :: (String -> String -> Bool) -> RunMPD -> XPConfig -> [Metadata] -> X [Int] addMatchingWith matchFun runMPD xp metas = do matches <- findMatchingWith matchFun runMPD xp metas fmap (either (const []) id) . io . runMPD . mapM findOrAdd $ matches -- | Add all selected songs to the playlist if they are not in it. addMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Int] addMatching = addMatchingWith isPrefixOf -- | Add matching songs and play the first one. -- -- @since 0.13.2 addAndPlayWith :: (String -> String -> Bool) -> RunMPD -> XPConfig -> [Metadata] -> X () addAndPlayWith matchFun runMPD xp ms = do ids <- addMatchingWith matchFun runMPD xp ms whenJust (listToMaybe ids) ((>> return ()) . io . runMPD . playId . Id) -- | Add matching songs and play the first one. addAndPlay :: RunMPD -> XPConfig -> [Metadata] -> X () addAndPlay = addAndPlayWith isPrefixOf -- | Load an existing playlist and play it. -- -- @since 0.13.2 loadPlaylistWith :: (String -> String -> Bool) -> RunMPD -> XPConfig -> X () loadPlaylistWith matchFun runMPD xp = do playlists <- fmap (either (const []) id) . io . runMPD $ listPlaylists mkXPrompt (MPDPrompt "Playlist: ") xp (mkComplLst matchFun . nub . map toString $ playlists) (\s -> do io $ runMPD $ do clear load $ PlaylistName $ C.pack s play Nothing return ()) -- | Load an existing playlist and play it. loadPlaylist :: RunMPD -> XPConfig -> X () loadPlaylist = loadPlaylistWith isPrefixOf -- | Add songs which match all of the given words with regard to any -- of the metadata. -- -- @since 0.13.2 addAndPlayAny :: RunMPD -> XPConfig -> [Metadata] -> X () addAndPlayAny runMPD xp metas = do mkXPrompt (MPDPrompt "Search") xp (historyCompletionP (showXPrompt (MPDPrompt "Search: ") ==)) (\s -> do io $ runMPD $ do clear songlists <- mapM (\t -> do sl <- mapM (\m -> search (m =? fromString t)) metas return $ concat sl) $ words s let songs = foldl L.intersect (head songlists) songlists fmap (either (const []) id) . io . runMPD . mapM findOrAdd $ songs play Nothing return ()) -- | Pick a song from the current playlist. -- -- @since 0.13.2 pickPlayListItem :: RunMPD -> XPConfig -> X () pickPlayListItem runMPD xp = do mkXPrompt (MPDPrompt "Pick") xp (\s -> do pSongs <- io $ runMPD $ playlistSearch (Title =? fromString s) case pSongs of Left _ -> return [] Right songs -> return $ take 100 $ nub $ map toString $ concat $ catMaybes $ map (M.lookup Title . sgTags) songs) (\s -> do io $ runMPD $ do pSongs <- io $ runMPD $ playlistSearch (Title =? fromString s) case pSongs of Left _ -> return () Right songs -> case sgId $ head songs of Nothing -> return () Just theId -> playId theId return ())