module XMonad.Prompt.MPD (
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
type RunMPD = forall a . MPD a -> IO (Response a)
data MPDPrompt = MPDPrompt String
instance XPrompt MPDPrompt where
showXPrompt (MPDPrompt s) = s ++ ": "
nextCompletion = const getNextCompletion
commandToComplete = const id
extractMetadata :: Metadata -> Song -> String
extractMetadata meta = fromMaybe "Unknown" . join . fmap listToMaybe .
M.lookup meta . M.map (map toString) . sgTags
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'
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
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
findMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Song]
findMatching = findMatchingWith isPrefixOf
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
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
addMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Int]
addMatching = addMatchingWith isPrefixOf
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)
addAndPlay :: RunMPD -> XPConfig -> [Metadata] -> X ()
addAndPlay = addAndPlayWith isPrefixOf
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 ())
loadPlaylist :: RunMPD -> XPConfig -> X ()
loadPlaylist = loadPlaylistWith isPrefixOf
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 ())
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 ())