{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
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 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 -> String
showXPrompt (MPDPrompt String
s) = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
nextCompletion :: MPDPrompt -> String -> [String] -> String
nextCompletion = (String -> [String] -> String)
-> MPDPrompt -> String -> [String] -> String
forall a b. a -> b -> a
const String -> [String] -> String
getNextCompletion
commandToComplete :: MPDPrompt -> String -> String
commandToComplete = (String -> String) -> MPDPrompt -> String -> String
forall a b. a -> b -> a
const String -> String
forall a. a -> a
id
extractMetadata :: Metadata -> Song -> String
Metadata
meta = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"Unknown" (Maybe String -> String)
-> (Song -> Maybe String) -> Song -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe String) -> Maybe String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe String) -> Maybe String)
-> (Song -> Maybe (Maybe String)) -> Song -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Maybe String)
-> Maybe [String] -> Maybe (Maybe String)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe (Maybe [String] -> Maybe (Maybe String))
-> (Song -> Maybe [String]) -> Song -> Maybe (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Metadata -> Map Metadata [String] -> Maybe [String]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Metadata
meta (Map Metadata [String] -> Maybe [String])
-> (Song -> Map Metadata [String]) -> Song -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Value] -> [String])
-> Map Metadata [Value] -> Map Metadata [String]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Value -> String) -> [Value] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Value -> String
forall a. ToString a => a -> String
toString) (Map Metadata [Value] -> Map Metadata [String])
-> (Song -> Map Metadata [Value]) -> Song -> Map Metadata [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Song -> Map Metadata [Value]
sgTags
mkComplLst :: (String -> String -> Bool) -> [String] -> String -> IO [String]
mkComplLst :: (String -> String -> Bool) -> [String] -> ComplFunction
mkComplLst String -> String -> Bool
cmp [String]
lst String
s = [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
matches ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
lst
where matches :: String -> Bool
matches String
s' = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s String -> String -> Bool
`cmp` (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s'
findMatching' :: (String -> String -> Bool) -> XPConfig -> [Song] -> Metadata
-> X [Song]
findMatching' :: (String -> String -> Bool)
-> XPConfig -> [Song] -> Metadata -> X [Song]
findMatching' String -> String -> Bool
_ XPConfig
_ [] Metadata
_ = [Song] -> X [Song]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return []
findMatching' String -> String -> Bool
cmp XPConfig
xp [Song]
songs Metadata
meta = do
Maybe String
answer <- MPDPrompt
-> XPConfig
-> ComplFunction
-> (String -> X String)
-> X (Maybe String)
forall p a.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a)
mkXPromptWithReturn (String -> MPDPrompt
MPDPrompt (Metadata -> String
forall a. Show a => a -> String
show Metadata
meta)) XPConfig
xp
((String -> String -> Bool) -> [String] -> ComplFunction
mkComplLst String -> String -> Bool
cmp ([String] -> ComplFunction)
-> ([Song] -> [String]) -> [Song] -> ComplFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([Song] -> [String]) -> [Song] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Song -> String) -> [Song] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Metadata -> Song -> String
extractMetadata Metadata
meta) ([Song] -> ComplFunction) -> [Song] -> ComplFunction
forall a b. (a -> b) -> a -> b
$ [Song]
songs)
String -> X String
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return
case Maybe String
answer of
Just String
input -> [Song] -> X [Song]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Song] -> X [Song]) -> [Song] -> X [Song]
forall a b. (a -> b) -> a -> b
$ (Song -> Bool) -> [Song] -> [Song]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
input) (String -> Bool) -> (Song -> String) -> Song -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Song -> String
extractMetadata Metadata
meta) [Song]
songs
Maybe String
Nothing -> [Song] -> X [Song]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return []
extractSongs :: [LsResult] -> [Song]
= (LsResult -> Maybe Song) -> [LsResult] -> [Song]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LsResult -> Maybe Song
extractSong
where extractSong :: LsResult -> Maybe Song
extractSong (LsSong Song
s) = Song -> Maybe Song
forall a. a -> Maybe a
Just Song
s
extractSong LsResult
_ = Maybe Song
forall a. Maybe a
Nothing
findMatchingWith :: (String -> String -> Bool) -> RunMPD -> XPConfig
-> [Metadata] -> X [Song]
findMatchingWith :: (String -> String -> Bool)
-> RunMPD -> XPConfig -> [Metadata] -> X [Song]
findMatchingWith String -> String -> Bool
matchFun RunMPD
runMPD XPConfig
xp [Metadata]
metas = do
Response [Song]
resp <- IO (Response [Song]) -> X (Response [Song])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Response [Song]) -> X (Response [Song]))
-> (Path -> IO (Response [Song])) -> Path -> X (Response [Song])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPD [Song] -> IO (Response [Song])
RunMPD
runMPD (MPD [Song] -> IO (Response [Song]))
-> (Path -> MPD [Song]) -> Path -> IO (Response [Song])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LsResult] -> [Song]) -> MPD [LsResult] -> MPD [Song]
forall a b. (a -> b) -> MPD a -> MPD b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [LsResult] -> [Song]
extractSongs (MPD [LsResult] -> MPD [Song])
-> (Path -> MPD [LsResult]) -> Path -> MPD [Song]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> MPD [LsResult]
forall (m :: * -> *). MonadMPD m => Path -> m [LsResult]
listAllInfo (Path -> X (Response [Song])) -> Path -> X (Response [Song])
forall a b. (a -> b) -> a -> b
$ (Path
"" :: Path)
case Response [Song]
resp of
Left MPDError
err -> String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace (String
"XMonad.Prompt.MPD: MPD returned an error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MPDError -> String
forall a. Show a => a -> String
show MPDError
err)
X () -> X [Song] -> X [Song]
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Song] -> X [Song]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Right [Song]
songs -> ([Song] -> Metadata -> X [Song])
-> [Song] -> [Metadata] -> X [Song]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((String -> String -> Bool)
-> XPConfig -> [Song] -> Metadata -> X [Song]
findMatching' String -> String -> Bool
matchFun XPConfig
xp) [Song]
songs [Metadata]
metas
findMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Song]
findMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Song]
findMatching = (String -> String -> Bool)
-> RunMPD -> XPConfig -> [Metadata] -> X [Song]
findMatchingWith String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf
findOrAdd :: Song -> MPD Int
findOrAdd :: Song -> MPD Int
findOrAdd Song
s = Maybe Int -> MPD [Song]
forall (m :: * -> *). MonadMPD m => Maybe Int -> m [Song]
playlistInfo Maybe Int
forall a. Maybe a
Nothing MPD [Song] -> ([Song] -> MPD Int) -> MPD Int
forall a b. MPD a -> (a -> MPD b) -> MPD b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Song]
pl ->
case (Song -> Bool) -> [Song] -> Maybe Song
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Song -> Path
sgFilePath Song
s) (Path -> Bool) -> (Song -> Path) -> Song -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Song -> Path
sgFilePath) [Song]
pl of
Just (Song { sgIndex :: Song -> Maybe Int
sgIndex = Just Int
i }) -> Int -> MPD Int
forall a. a -> MPD a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
Maybe Song
_ -> (Id -> Int) -> MPD Id -> MPD Int
forall a b. (a -> b) -> MPD a -> MPD b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> Int
unwrapId (MPD Id -> MPD Int) -> (Song -> MPD Id) -> Song -> MPD Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Maybe Int -> MPD Id) -> Maybe Int -> Path -> MPD Id
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path -> Maybe Int -> MPD Id
forall (m :: * -> *). MonadMPD m => Path -> Maybe Int -> m Id
addId Maybe Int
forall a. Maybe a
Nothing (Path -> MPD Id) -> (Song -> Path) -> Song -> MPD Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Song -> Path
sgFilePath (Song -> MPD Int) -> Song -> MPD Int
forall a b. (a -> b) -> a -> b
$ Song
s
where unwrapId :: Id -> Int
unwrapId (Id Int
i) = Int
i
addMatchingWith :: (String -> String -> Bool) -> RunMPD -> XPConfig
-> [Metadata] -> X [Int]
addMatchingWith :: (String -> String -> Bool)
-> RunMPD -> XPConfig -> [Metadata] -> X [Int]
addMatchingWith String -> String -> Bool
matchFun RunMPD
runMPD XPConfig
xp [Metadata]
metas = do
[Song]
matches <- (String -> String -> Bool)
-> RunMPD -> XPConfig -> [Metadata] -> X [Song]
findMatchingWith String -> String -> Bool
matchFun MPD a -> IO (Response a)
RunMPD
runMPD XPConfig
xp [Metadata]
metas
(Either MPDError [Int] -> [Int])
-> X (Either MPDError [Int]) -> X [Int]
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MPDError -> [Int])
-> ([Int] -> [Int]) -> Either MPDError [Int] -> [Int]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Int] -> MPDError -> [Int]
forall a b. a -> b -> a
const []) [Int] -> [Int]
forall a. a -> a
id) (X (Either MPDError [Int]) -> X [Int])
-> ([Song] -> X (Either MPDError [Int])) -> [Song] -> X [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either MPDError [Int]) -> X (Either MPDError [Int])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Either MPDError [Int]) -> X (Either MPDError [Int]))
-> ([Song] -> IO (Either MPDError [Int]))
-> [Song]
-> X (Either MPDError [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPD [Int] -> IO (Either MPDError [Int])
RunMPD
runMPD (MPD [Int] -> IO (Either MPDError [Int]))
-> ([Song] -> MPD [Int]) -> [Song] -> IO (Either MPDError [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Song -> MPD Int) -> [Song] -> MPD [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Song -> MPD Int
findOrAdd ([Song] -> X [Int]) -> [Song] -> X [Int]
forall a b. (a -> b) -> a -> b
$ [Song]
matches
addMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Int]
addMatching :: RunMPD -> XPConfig -> [Metadata] -> X [Int]
addMatching = (String -> String -> Bool)
-> RunMPD -> XPConfig -> [Metadata] -> X [Int]
addMatchingWith String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf
addAndPlayWith :: (String -> String -> Bool) -> RunMPD -> XPConfig
-> [Metadata] -> X ()
addAndPlayWith :: (String -> String -> Bool)
-> RunMPD -> XPConfig -> [Metadata] -> X ()
addAndPlayWith String -> String -> Bool
matchFun RunMPD
runMPD XPConfig
xp [Metadata]
ms = do
[Int]
ids <- (String -> String -> Bool)
-> RunMPD -> XPConfig -> [Metadata] -> X [Int]
addMatchingWith String -> String -> Bool
matchFun MPD a -> IO (Response a)
RunMPD
runMPD XPConfig
xp [Metadata]
ms
Maybe Int -> (Int -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ([Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int]
ids) ((X (Response ()) -> X () -> X ()
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (X (Response ()) -> X ())
-> (Int -> X (Response ())) -> Int -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ()) -> X (Response ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Response ()) -> X (Response ()))
-> (Int -> IO (Response ())) -> Int -> X (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPD () -> IO (Response ())
RunMPD
runMPD (MPD () -> IO (Response ()))
-> (Int -> MPD ()) -> Int -> IO (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> MPD ()
forall (m :: * -> *). MonadMPD m => Id -> m ()
playId (Id -> MPD ()) -> (Int -> Id) -> Int -> MPD ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Id
Id)
addAndPlay :: RunMPD -> XPConfig -> [Metadata] -> X ()
addAndPlay :: RunMPD -> XPConfig -> [Metadata] -> X ()
addAndPlay = (String -> String -> Bool)
-> RunMPD -> XPConfig -> [Metadata] -> X ()
addAndPlayWith String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf
loadPlaylistWith :: (String -> String -> Bool) -> RunMPD -> XPConfig -> X ()
loadPlaylistWith :: (String -> String -> Bool) -> RunMPD -> XPConfig -> X ()
loadPlaylistWith String -> String -> Bool
matchFun RunMPD
runMPD XPConfig
xp = do
[PlaylistName]
playlists <- (Either MPDError [PlaylistName] -> [PlaylistName])
-> X (Either MPDError [PlaylistName]) -> X [PlaylistName]
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MPDError -> [PlaylistName])
-> ([PlaylistName] -> [PlaylistName])
-> Either MPDError [PlaylistName]
-> [PlaylistName]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([PlaylistName] -> MPDError -> [PlaylistName]
forall a b. a -> b -> a
const []) [PlaylistName] -> [PlaylistName]
forall a. a -> a
id) (X (Either MPDError [PlaylistName]) -> X [PlaylistName])
-> (MPD [PlaylistName] -> X (Either MPDError [PlaylistName]))
-> MPD [PlaylistName]
-> X [PlaylistName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either MPDError [PlaylistName])
-> X (Either MPDError [PlaylistName])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Either MPDError [PlaylistName])
-> X (Either MPDError [PlaylistName]))
-> (MPD [PlaylistName] -> IO (Either MPDError [PlaylistName]))
-> MPD [PlaylistName]
-> X (Either MPDError [PlaylistName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPD [PlaylistName] -> IO (Either MPDError [PlaylistName])
RunMPD
runMPD (MPD [PlaylistName] -> X [PlaylistName])
-> MPD [PlaylistName] -> X [PlaylistName]
forall a b. (a -> b) -> a -> b
$ MPD [PlaylistName]
forall (m :: * -> *). MonadMPD m => m [PlaylistName]
listPlaylists
MPDPrompt -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> MPDPrompt
MPDPrompt String
"Playlist: ") XPConfig
xp
((String -> String -> Bool) -> [String] -> ComplFunction
mkComplLst String -> String -> Bool
matchFun ([String] -> ComplFunction)
-> ([PlaylistName] -> [String]) -> [PlaylistName] -> ComplFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([PlaylistName] -> [String]) -> [PlaylistName] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlaylistName -> String) -> [PlaylistName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PlaylistName -> String
forall a. ToString a => a -> String
toString ([PlaylistName] -> ComplFunction)
-> [PlaylistName] -> ComplFunction
forall a b. (a -> b) -> a -> b
$ [PlaylistName]
playlists)
(\String
s -> do IO (Response ()) -> X (Response ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Response ()) -> X (Response ()))
-> IO (Response ()) -> X (Response ())
forall a b. (a -> b) -> a -> b
$ MPD () -> IO (Response ())
RunMPD
runMPD (MPD () -> IO (Response ())) -> MPD () -> IO (Response ())
forall a b. (a -> b) -> a -> b
$ do MPD ()
forall (m :: * -> *). MonadMPD m => m ()
clear
PlaylistName -> MPD ()
forall (m :: * -> *). MonadMPD m => PlaylistName -> m ()
load (PlaylistName -> MPD ()) -> PlaylistName -> MPD ()
forall a b. (a -> b) -> a -> b
$ ByteString -> PlaylistName
PlaylistName (ByteString -> PlaylistName) -> ByteString -> PlaylistName
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C.pack String
s
Maybe Int -> MPD ()
forall (m :: * -> *). MonadMPD m => Maybe Int -> m ()
play Maybe Int
forall a. Maybe a
Nothing
() -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
loadPlaylist :: RunMPD -> XPConfig -> X ()
loadPlaylist :: RunMPD -> XPConfig -> X ()
loadPlaylist = (String -> String -> Bool) -> RunMPD -> XPConfig -> X ()
loadPlaylistWith String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf
addAndPlayAny :: RunMPD -> XPConfig -> [Metadata] -> X ()
addAndPlayAny :: RunMPD -> XPConfig -> [Metadata] -> X ()
addAndPlayAny RunMPD
runMPD XPConfig
xp [Metadata]
metas = do
#if MIN_VERSION_xmonad_contrib(0,16,9)
ComplFunction
hist <- (String -> Bool) -> X ComplFunction
historyCompletionP (MPDPrompt -> String
forall t. XPrompt t => t -> String
showXPrompt (String -> MPDPrompt
MPDPrompt String
"Search: ") String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==)
#else
let hist = historyCompletionP (showXPrompt (MPDPrompt "Search: ") ==)
#endif
MPDPrompt -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> MPDPrompt
MPDPrompt String
"Search") XPConfig
xp
ComplFunction
hist
(\String
s -> do IO (Response ()) -> X (Response ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Response ()) -> X (Response ()))
-> IO (Response ()) -> X (Response ())
forall a b. (a -> b) -> a -> b
$ MPD () -> IO (Response ())
RunMPD
runMPD (MPD () -> IO (Response ())) -> MPD () -> IO (Response ())
forall a b. (a -> b) -> a -> b
$ do
MPD ()
forall (m :: * -> *). MonadMPD m => m ()
clear
[[Song]]
songlists <- (String -> MPD [Song]) -> [String] -> MPD [[Song]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\String
t -> do
[[Song]]
sl <- (Metadata -> MPD [Song]) -> [Metadata] -> MPD [[Song]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Metadata
m -> Query -> MPD [Song]
forall (m :: * -> *). MonadMPD m => Query -> m [Song]
search
(Metadata
m Metadata -> Value -> Query
=? String -> Value
forall a. IsString a => String -> a
fromString String
t))
[Metadata]
metas
[Song] -> MPD [Song]
forall a. a -> MPD a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Song] -> MPD [Song]) -> [Song] -> MPD [Song]
forall a b. (a -> b) -> a -> b
$ [[Song]] -> [Song]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Song]]
sl) ([String] -> MPD [[Song]]) -> [String] -> MPD [[Song]]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
s
let songs :: [Song]
songs = ([Song] -> [Song] -> [Song]) -> [Song] -> [[Song]] -> [Song]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Song] -> [Song] -> [Song]
forall a. Eq a => [a] -> [a] -> [a]
L.intersect ([[Song]] -> [Song]
forall a. HasCallStack => [a] -> a
head [[Song]]
songlists) [[Song]]
songlists
(Either MPDError [Int] -> [Int])
-> MPD (Either MPDError [Int]) -> MPD [Int]
forall a b. (a -> b) -> MPD a -> MPD b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MPDError -> [Int])
-> ([Int] -> [Int]) -> Either MPDError [Int] -> [Int]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Int] -> MPDError -> [Int]
forall a b. a -> b -> a
const []) [Int] -> [Int]
forall a. a -> a
id) (MPD (Either MPDError [Int]) -> MPD [Int])
-> ([Song] -> MPD (Either MPDError [Int])) -> [Song] -> MPD [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either MPDError [Int]) -> MPD (Either MPDError [Int])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Either MPDError [Int]) -> MPD (Either MPDError [Int]))
-> ([Song] -> IO (Either MPDError [Int]))
-> [Song]
-> MPD (Either MPDError [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPD [Int] -> IO (Either MPDError [Int])
RunMPD
runMPD (MPD [Int] -> IO (Either MPDError [Int]))
-> ([Song] -> MPD [Int]) -> [Song] -> IO (Either MPDError [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Song -> MPD Int) -> [Song] -> MPD [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Song -> MPD Int
findOrAdd ([Song] -> MPD [Int]) -> [Song] -> MPD [Int]
forall a b. (a -> b) -> a -> b
$
[Song]
songs
Maybe Int -> MPD ()
forall (m :: * -> *). MonadMPD m => Maybe Int -> m ()
play Maybe Int
forall a. Maybe a
Nothing
() -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
pickPlayListItem :: RunMPD -> XPConfig -> X ()
pickPlayListItem :: RunMPD -> XPConfig -> X ()
pickPlayListItem RunMPD
runMPD XPConfig
xp = do
MPDPrompt -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> MPDPrompt
MPDPrompt String
"Pick") XPConfig
xp
(\String
s -> do Response [Song]
pSongs <- IO (Response [Song]) -> IO (Response [Song])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Response [Song]) -> IO (Response [Song]))
-> IO (Response [Song]) -> IO (Response [Song])
forall a b. (a -> b) -> a -> b
$ MPD [Song] -> IO (Response [Song])
RunMPD
runMPD (MPD [Song] -> IO (Response [Song]))
-> MPD [Song] -> IO (Response [Song])
forall a b. (a -> b) -> a -> b
$ Query -> MPD [Song]
forall (m :: * -> *). MonadMPD m => Query -> m [Song]
playlistSearch (Metadata
Title Metadata -> Value -> Query
=? String -> Value
forall a. IsString a => String -> a
fromString String
s)
case Response [Song]
pSongs of
Left MPDError
_ -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Right [Song]
songs -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
100 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Value -> String) -> [Value] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Value -> String
forall a. ToString a => a -> String
toString
([Value] -> [String]) -> [Value] -> [String]
forall a b. (a -> b) -> a -> b
$ [[Value]] -> [Value]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Value]] -> [Value]) -> [[Value]] -> [Value]
forall a b. (a -> b) -> a -> b
$ [Maybe [Value]] -> [[Value]]
forall a. [Maybe a] -> [a]
catMaybes
([Maybe [Value]] -> [[Value]]) -> [Maybe [Value]] -> [[Value]]
forall a b. (a -> b) -> a -> b
$ (Song -> Maybe [Value]) -> [Song] -> [Maybe [Value]]
forall a b. (a -> b) -> [a] -> [b]
map (Metadata -> Map Metadata [Value] -> Maybe [Value]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Metadata
Title (Map Metadata [Value] -> Maybe [Value])
-> (Song -> Map Metadata [Value]) -> Song -> Maybe [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Song -> Map Metadata [Value]
sgTags) [Song]
songs)
(\String
s -> do IO (Response ()) -> X (Response ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Response ()) -> X (Response ()))
-> IO (Response ()) -> X (Response ())
forall a b. (a -> b) -> a -> b
$ MPD () -> IO (Response ())
RunMPD
runMPD (MPD () -> IO (Response ())) -> MPD () -> IO (Response ())
forall a b. (a -> b) -> a -> b
$ do
Response [Song]
pSongs <- IO (Response [Song]) -> MPD (Response [Song])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Response [Song]) -> MPD (Response [Song]))
-> IO (Response [Song]) -> MPD (Response [Song])
forall a b. (a -> b) -> a -> b
$ MPD [Song] -> IO (Response [Song])
RunMPD
runMPD (MPD [Song] -> IO (Response [Song]))
-> MPD [Song] -> IO (Response [Song])
forall a b. (a -> b) -> a -> b
$ Query -> MPD [Song]
forall (m :: * -> *). MonadMPD m => Query -> m [Song]
playlistSearch (Metadata
Title Metadata -> Value -> Query
=? String -> Value
forall a. IsString a => String -> a
fromString String
s)
case Response [Song]
pSongs of
Left MPDError
_ -> () -> MPD ()
forall a. a -> MPD a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Right [Song]
songs -> case Song -> Maybe Id
sgId (Song -> Maybe Id) -> Song -> Maybe Id
forall a b. (a -> b) -> a -> b
$ [Song] -> Song
forall a. HasCallStack => [a] -> a
head [Song]
songs of
Maybe Id
Nothing -> () -> MPD ()
forall a. a -> MPD a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Id
theId -> Id -> MPD ()
forall (m :: * -> *). MonadMPD m => Id -> m ()
playId Id
theId
() -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ())