module XMonad.Prompt.MPD (
findMatching
,addMatching
,addAndPlay
,RunMPD
,findOrAdd
) where
import Control.Monad
import qualified Data.ByteString as B
import Data.Char
import qualified Data.Map as M
import Data.Maybe
import Network.MPD
import XMonad
import XMonad.Prompt
import Data.List as L (nub,isPrefixOf,find)
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 -> IO [String]
mkComplLst lst s = return . filter isPrefix' $ lst
where isPrefix' s' = map toLower s `isPrefixOf` map toLower s'
findMatching' :: XPConfig -> [Song] -> Metadata -> X [Song]
findMatching' _ [] _ = return []
findMatching' xp songs meta = do
answer <- mkXPromptWithReturn (MPDPrompt (show meta)) xp
(mkComplLst . 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
findMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Song]
findMatching runMPD xp metas = do
resp <- io . runMPD . fmap extractSongs . listAllInfo $ Path B.empty
case resp of
Left err -> trace ("XMonad.Prompt.MPD: MPD returned an error: " ++ show err)
>> return []
Right songs -> foldM (findMatching' xp) songs metas
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
addMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Int]
addMatching runMPD xp metas = do
matches <- findMatching runMPD xp metas
fmap (either (const []) id) . io . runMPD . mapM findOrAdd $ matches
addAndPlay :: RunMPD -> XPConfig -> [Metadata] -> X ()
addAndPlay runMPD xp ms = do
ids <- addMatching runMPD xp ms
whenJust (listToMaybe ids) ((>> return ()) . io . runMPD . playId . Id)