xmonad-extras-0.13.2: XMonad/Prompt/MPD.hs
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Prompt.MPD
-- Copyright : Daniel Schoepe <daniel.schoepe@googlemail.com>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Daniel Schoepe <daniel.schoepe@googlemail.com>
-- 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 ())