module Network.MPD.Commands (
module Network.MPD.Commands.Types,
module Network.MPD.Commands.Query,
clearError, currentSong, idle, noidle, status, stats,
consume, crossfade, random, repeat, setVolume, single, replayGainMode,
replayGainStatus,
next, pause, play, playId, previous, seek, seekId, stop,
add, add_, addId, clear, delete, deleteId, move, moveId, playlist, playlistId,
playlistFind, playlistInfo, playlistSearch, plChanges, plChangesPosId, shuffle, swap,
swapId,
listPlaylist, listPlaylistInfo, listPlaylists, load, playlistAdd,
playlistAdd_, playlistClear, playlistDelete, playlistMove, rename, rm,
save,
count, find, findAdd, list, listAll, listAllInfo, lsInfo, search, update,
rescan,
stickerGet, stickerSet, stickerDelete, stickerList, stickerFind,
close, kill, password, ping,
disableOutput, enableOutput, outputs,
commands, notCommands, tagTypes, urlHandlers, decoders,
) where
import Network.MPD.Commands.Arg
import Network.MPD.Commands.Parse
import Network.MPD.Commands.Query
import Network.MPD.Commands.Types
import Network.MPD.Commands.Util
import Network.MPD.Core
import Network.MPD.Util
import Control.Monad (liftM)
import Control.Monad.Error (throwError)
import Prelude hiding (repeat)
import qualified Data.ByteString.UTF8 as UTF8
import Data.ByteString (ByteString)
clearError :: MonadMPD m => m ()
clearError = getResponse_ "clearerror"
currentSong :: (Functor m, MonadMPD m) => m (Maybe Song)
currentSong = getResponse "currentsong" >>= runParser parseMaybeSong . toAssocList
idle :: MonadMPD m => [Subsystem] -> m [Subsystem]
idle subsystems =
mapM f =<< toAssocList `liftM` getResponse ("idle" <$> foldr (<++>) (Args []) subsystems)
where
f ("changed", system) =
case system of
"database" -> return DatabaseS
"update" -> return UpdateS
"stored_playlist" -> return StoredPlaylistS
"playlist" -> return PlaylistS
"player" -> return PlayerS
"mixer" -> return MixerS
"output" -> return OutputS
"options" -> return OptionsS
k -> fail ("Unknown subsystem: " ++ UTF8.toString k)
f x = fail ("idle: Unexpected " ++ show x)
noidle :: MonadMPD m => m ()
noidle = getResponse_ "noidle"
stats :: MonadMPD m => m Stats
stats = getResponse "stats" >>= runParser parseStats
status :: MonadMPD m => m Status
status = getResponse "status" >>= runParser parseStatus
consume :: MonadMPD m => Bool -> m ()
consume = getResponse_ . ("consume" <$>)
crossfade :: MonadMPD m => Seconds -> m ()
crossfade secs = getResponse_ ("crossfade" <$> secs)
random :: MonadMPD m => Bool -> m ()
random = getResponse_ . ("random" <$>)
repeat :: MonadMPD m => Bool -> m ()
repeat = getResponse_ . ("repeat" <$>)
setVolume :: MonadMPD m => Int -> m ()
setVolume = getResponse_ . ("setvol" <$>)
single :: MonadMPD m => Bool -> m ()
single = getResponse_ . ("single" <$>)
replayGainMode :: MonadMPD m => ReplayGainMode -> m ()
replayGainMode = getResponse_ . ("replay_gain_mode" <$>)
replayGainStatus :: MonadMPD m => m [String]
replayGainStatus = map UTF8.toString `liftM` getResponse "replay_gain_status"
next :: MonadMPD m => m ()
next = getResponse_ "next"
pause :: MonadMPD m => Bool -> m ()
pause = getResponse_ . ("pause" <$>)
play :: MonadMPD m => Maybe Int -> m ()
play (Just pos) = getResponse_ ("play" <$> pos)
play _ = getResponse_ "play"
playId :: MonadMPD m => Id -> m ()
playId id' = getResponse_ ("playid" <$> id')
previous :: MonadMPD m => m ()
previous = getResponse_ "previous"
seek :: MonadMPD m => Int -> Seconds -> m ()
seek pos time = getResponse_ ("seek" <$> pos <++> time)
seekId :: MonadMPD m => Id -> Seconds -> m ()
seekId id' time = getResponse_ ("seekid" <$> id' <++> time)
stop :: MonadMPD m => m ()
stop = getResponse_ "stop"
addId :: MonadMPD m => Path -> Maybe Integer
-> m Id
addId p pos = liftM (parse parseNum Id (Id 0) . snd . head . toAssocList)
$ getResponse1 ("addid" <$> p <++> pos)
add :: MonadMPD m => Path -> m [Path]
add x = add_ x >> listAll x
add_ :: MonadMPD m => Path -> m ()
add_ path = getResponse_ ("add" <$> path)
clear :: MonadMPD m => m ()
clear = getResponse_ "clear"
delete :: MonadMPD m => Int -> m ()
delete pos = getResponse_ ("delete" <$> pos)
deleteId :: MonadMPD m => Id -> m ()
deleteId id' = getResponse_ ("deleteid" <$> id')
move :: MonadMPD m => Int -> Int -> m ()
move pos to = getResponse_ ("move" <$> pos <++> to)
moveId :: MonadMPD m => Id -> Int -> m ()
moveId id' to = getResponse_ ("moveid" <$> id' <++> to)
playlist :: MonadMPD m => m [(Int, Path)]
playlist = mapM f =<< getResponse "playlist"
where f s | (pos, name) <- breakChar ':' s
, Just pos' <- parseNum pos
= return (pos', Path name)
| otherwise = throwError . Unexpected $ show s
playlistFind :: MonadMPD m => Query -> m [Song]
playlistFind q = takeSongs =<< getResponse ("playlistfind" <$> q)
playlistInfo :: MonadMPD m => Maybe (Int, Int) -> m [Song]
playlistInfo range = takeSongs =<< getResponse ("playlistinfo" <$> range)
playlistId :: MonadMPD m => Maybe Id -> m [Song]
playlistId id' = takeSongs =<< getResponse ("playlistinfo" <$> id')
playlistSearch :: MonadMPD m => Query -> m [Song]
playlistSearch q = takeSongs =<< getResponse ("playlistsearch" <$> q)
plChanges :: MonadMPD m => Integer -> m [Song]
plChanges version = takeSongs =<< getResponse ("plchanges" <$> version)
plChangesPosId :: MonadMPD m => Integer -> m [(Int, Id)]
plChangesPosId plver =
getResponse ("plchangesposid" <$> plver) >>=
mapM f . splitGroups ["cpos"] . toAssocList
where f xs | [("cpos", x), ("Id", y)] <- xs
, Just (x', y') <- pair parseNum (x, y)
= return (x', Id y')
| otherwise = throwError . Unexpected $ show xs
shuffle :: MonadMPD m => Maybe (Int, Int)
-> m ()
shuffle range = getResponse_ ("shuffle" <$> range)
swap :: MonadMPD m => Int -> Int -> m ()
swap pos1 pos2 = getResponse_ ("swap" <$> pos1 <++> pos2)
swapId :: MonadMPD m => Id -> Id -> m ()
swapId id1 id2 = getResponse_ ("swapid" <$> id1 <++> id2)
listPlaylist :: MonadMPD m => PlaylistName -> m [Path]
listPlaylist plname =
(map Path . takeValues) `liftM` getResponse ("listplaylist" <$> plname)
listPlaylistInfo :: MonadMPD m => PlaylistName -> m [Song]
listPlaylistInfo plname =
takeSongs =<< getResponse ("listplaylistinfo" <$> plname)
listPlaylists :: MonadMPD m => m [PlaylistName]
listPlaylists = (map PlaylistName . go [] . toAssocList) `liftM` getResponse "listplaylists"
where
go acc [] = acc
go acc ((_, b):_:xs) = go (b : acc) xs
go _ _ = error "listPlaylists: bug"
load :: MonadMPD m => PlaylistName -> m ()
load plname = getResponse_ ("load" <$> plname)
playlistAdd :: MonadMPD m => PlaylistName -> Path -> m [Path]
playlistAdd plname path = playlistAdd_ plname path >> listAll path
playlistAdd_ :: MonadMPD m => PlaylistName -> Path -> m ()
playlistAdd_ plname path = getResponse_ ("playlistadd" <$> plname <++> path)
playlistClear :: MonadMPD m => PlaylistName -> m ()
playlistClear = getResponse_ . ("playlistclear" <$>)
playlistDelete :: MonadMPD m => PlaylistName
-> Integer
-> m ()
playlistDelete name pos = getResponse_ ("playlistdelete" <$> name <++> pos)
playlistMove :: MonadMPD m => PlaylistName -> Integer -> Integer -> m ()
playlistMove name from to =
getResponse_ ("playlistmove" <$> name <++> from <++> to)
rename :: MonadMPD m
=> PlaylistName
-> PlaylistName
-> m ()
rename plname new = getResponse_ ("rename" <$> plname <++> new)
rm :: MonadMPD m => PlaylistName -> m ()
rm plname = getResponse_ ("rm" <$> plname)
save :: MonadMPD m => PlaylistName -> m ()
save plname = getResponse_ ("save" <$> plname)
count :: MonadMPD m => Query -> m Count
count query = getResponse ("count" <$> query) >>= runParser parseCount
find :: MonadMPD m => Query -> m [Song]
find query = getResponse ("find" <$> query) >>= takeSongs
findAdd :: MonadMPD m => Query -> m ()
findAdd q = getResponse_ ("findadd" <$> q)
list :: MonadMPD m
=> Metadata
-> Query -> m [Value]
list mtype query = (map Value . takeValues) `liftM` getResponse ("list" <$> mtype <++> query)
listAll :: MonadMPD m => Path -> m [Path]
listAll path = liftM (map (Path . snd) . filter ((== "file") . fst) . toAssocList)
(getResponse $ "listall" <$> path)
lsInfo' :: MonadMPD m => Command -> Path -> m [LsResult]
lsInfo' cmd path = getResponse (cmd <$> path) >>= takeEntries
listAllInfo :: MonadMPD m => Path -> m [LsResult]
listAllInfo = lsInfo' "listallinfo"
lsInfo :: MonadMPD m => Path -> m [LsResult]
lsInfo = lsInfo' "lsinfo"
search :: MonadMPD m => Query -> m [Song]
search query = getResponse ("search" <$> query) >>= takeSongs
update :: MonadMPD m => [Path] -> m ()
update [] = getResponse_ "update"
update [x] = getResponse_ ("update" <$> x)
update xs = getResponses (map ("update" <$>) xs) >> return ()
rescan :: MonadMPD m => [Path] -> m ()
rescan [] = getResponse_ "rescan"
rescan [x] = getResponse_ ("rescan" <$> x)
rescan xs = getResponses (map ("rescan" <$>) xs) >> return ()
stickerGet :: MonadMPD m => ObjectType
-> String
-> String
-> m [String]
stickerGet typ uri name = (map UTF8.toString . takeValues) `liftM` getResponse ("sticker get" <$> typ <++> uri <++> name)
stickerSet :: MonadMPD m => ObjectType
-> String
-> String
-> String
-> m ()
stickerSet typ uri name value =
getResponse_ ("sticker set" <$> typ <++> uri <++> name <++> value)
stickerDelete :: MonadMPD m => ObjectType
-> String
-> String
-> m ()
stickerDelete typ uri name =
getResponse_ ("sticker delete" <$> typ <++> uri <++> name)
decodePair :: (ByteString, ByteString) -> (String, String)
decodePair (x, y) = (UTF8.toString x, UTF8.toString y)
stickerList :: MonadMPD m => ObjectType
-> String
-> m [(String, String)]
stickerList typ uri =
(map decodePair . toAssocList) `liftM` getResponse ("sticker list" <$> typ <++> uri)
stickerFind :: MonadMPD m => ObjectType
-> String
-> String
-> m [(String, String)]
stickerFind typ uri name =
(map decodePair . toAssocList) `liftM`
getResponse ("sticker find" <$> typ <++> uri <++> name)
password :: MonadMPD m => String -> m ()
password = getResponse_ . ("password " ++)
ping :: MonadMPD m => m ()
ping = getResponse_ "ping"
disableOutput :: MonadMPD m => Int -> m ()
disableOutput = getResponse_ . ("disableoutput" <$>)
enableOutput :: MonadMPD m => Int -> m ()
enableOutput = getResponse_ . ("enableoutput" <$>)
outputs :: MonadMPD m => m [Device]
outputs = getResponse "outputs" >>= runParser parseOutputs
commands :: MonadMPD m => m [String]
commands = (map UTF8.toString . takeValues) `liftM` getResponse "commands"
notCommands :: MonadMPD m => m [String]
notCommands = (map UTF8.toString . takeValues) `liftM` getResponse "notcommands"
tagTypes :: MonadMPD m => m [String]
tagTypes = (map UTF8.toString . takeValues) `liftM` (getResponse "tagtypes")
urlHandlers :: MonadMPD m => m [String]
urlHandlers = (map UTF8.toString . takeValues) `liftM` (getResponse "urlhandlers")
decoders :: MonadMPD m => m [(String, [(String, String)])]
decoders = (takeDecoders . toAssocList) `liftM` getResponse "decoders"
where
takeDecoders [] = []
takeDecoders ((_, p):xs) =
let (info, rest) = break ((==) "plugin" . fst) xs
in (UTF8.toString p, map decodePair info) : takeDecoders rest