Network/MPD/Commands.hs

   1 {-# LANGUAGE PatternGuards, TypeSynonymInstances #-}
   2
   3 -- | Module    : Network.MPD.Commands
   4 -- Copyright   : (c) Ben Sinclair 2005-2008
   5 -- License     : LGPL (see LICENSE)
   6 -- Maintainer  : bsinclai@turing.une.edu.au
   7 -- Stability   : alpha
   8 -- Portability : unportable (uses PatternGuards and TypeSynonymInstances)
   9 --
  10 -- Interface to the user commands supported by MPD.
  11
  12 module Network.MPD.Commands (
  13     -- * Command related data types
  14     Artist, Album, Title, PlaylistName, Path,
  15     Meta(..), Match(..), Query,
  16     module Network.MPD.Types,
  17
  18     -- * Admin commands
  19     disableOutput, enableOutput, kill, outputs, update,
  20
  21     -- * Database commands
  22     find, list, listAll, listAllInfo, lsInfo, search, count,
  23
  24     -- * Playlist commands
  25     -- $playlist
  26     add, add_, addId, clear, currentSong, delete, load, move,
  27     playlistInfo, listPlaylist, listPlaylistInfo, playlist, plChanges,
  28     plChangesPosId, playlistFind, playlistSearch, rm, rename, save, shuffle,
  29     swap,
  30
  31     -- * Playback commands
  32     crossfade, next, pause, play, previous, random, repeat, seek, setVolume,
  33     volume, stop,
  34
  35     -- * Miscellaneous commands
  36     clearError, close, commands, notCommands, password, ping, reconnect, stats,
  37     status, tagTypes, urlHandlers,
  38
  39     -- * Extensions\/shortcuts
  40     addMany, deleteMany, complete, crop, prune, lsDirs, lsFiles, lsPlaylists,
  41     findArtist, findAlbum, findTitle, listArtists, listAlbums, listAlbum,
  42     searchArtist, searchAlbum, searchTitle, getPlaylist, toggle, updateId
  43     ) where
  44
  45 import Network.MPD.Core
  46 import Network.MPD.Utils
  47 import Network.MPD.Parse
  48 import Network.MPD.Types
  49
  50 import Control.Monad (liftM, unless)
  51 import Control.Monad.Error (throwError)
  52 import Prelude hiding (repeat)
  53 import Data.List (findIndex, intersperse, isPrefixOf)
  54 import Data.Maybe
  55 import System.FilePath (dropFileName)
  56
  57 --
  58 -- Data types
  59 --
  60
  61 -- Arguments for getResponse are accumulated as strings in values of
  62 -- this type after being converted from whatever type (an instance of
  63 -- MPDArg) they were to begin with.
  64 newtype Args = Args [String]
  65     deriving Show
  66
  67 -- A uniform interface for argument preparation
  68 -- The basic idea is that one should be able
  69 -- to magically prepare an argument for use with
  70 -- an MPD command, without necessarily knowing/\caring
  71 -- how it needs to be represented internally.
  72 class Show a => MPDArg a where
  73     prep :: a -> Args
  74     -- Note that because of this, we almost
  75     -- never have to actually provide
  76     -- an implementation of 'prep'
  77     prep = Args . return . show
  78
  79 -- | Groups together arguments to getResponse.
  80 infixl 3 <++>
  81 (<++>) :: (MPDArg a, MPDArg b) => a -> b -> Args
  82 x <++> y = Args $ xs ++ ys
  83     where Args xs = prep x
  84           Args ys = prep y
  85
  86 -- | Converts a command name and a string of arguments into the string
  87 -- to hand to getResponse.
  88 infix 2 <$>
  89 (<$>) :: (MPDArg a) => String -> a -> String
  90 x <$> y = x ++ " " ++ unwords (filter (not . null) y')
  91     where Args y' = prep y
  92
  93 instance MPDArg Args where prep = id
  94
  95 instance MPDArg String where
  96     -- We do this to avoid mangling
  97     -- non-ascii characters with 'show'
  98     prep x = Args ['"' : x ++ "\""]
  99
 100 instance (MPDArg a) => MPDArg (Maybe a) where
 101     prep Nothing = Args []
 102     prep (Just x) = prep x
 103
 104 instance MPDArg Int
 105 instance MPDArg Integer
 106 instance MPDArg Bool where prep = Args . return . showBool
 107
 108 type Artist       = String
 109 type Album        = String
 110 type Title        = String
 111
 112 -- | Used for commands which require a playlist name.
 113 -- If empty, the current playlist is used.
 114 type PlaylistName = String
 115
 116 -- | Used for commands which require a path within the database.
 117 -- If empty, the root path is used.
 118 type Path         = String
 119
 120 -- | Available metadata types\/scope modifiers, used for searching the
 121 -- database for entries with certain metadata values.
 122 data Meta = Artist | Album | Title | Track | Name | Genre | Date
 123     | Composer | Performer | Disc | Any | Filename
 124       deriving Show
 125
 126 instance MPDArg Meta
 127
 128 -- | When searching for specific items in a collection
 129 -- of songs, we need a reliable way to build predicates. Match is
 130 -- one way of achieving this.
 131 -- Each Match is a clause, and by putting matches together in lists, we can
 132 -- compose queries.
 133 --
 134 -- For example, to match any song where the value of artist is \"Foo\", we use:
 135 --
 136 -- > Match Artist "Foo"
 137 --
 138 -- In composite matches (queries), all clauses must be satisfied, which means
 139 -- that each additional clause narrows the search. For example, to match
 140 -- any song where the value of artist is \"Foo\" AND the value of album is
 141 -- \"Bar\", we use:
 142 --
 143 -- > [Match Artist "Foo", Match Album "Bar"]
 144 --
 145 -- By adding additional clauses we can narrow the search even more, but this
 146 -- is usually not necessary.
 147 data Match = Match Meta String
 148
 149 instance Show Match where
 150     show (Match meta query) = show meta ++ " \"" ++ query ++ "\""
 151     showList xs _ = unwords $ map show xs
 152
 153 -- | A query comprises a list of Match predicates
 154 type Query = [Match]
 155
 156 instance MPDArg Query where
 157     prep = foldl (<++>) (Args []) . f
 158         where f = map (\(Match m q) -> Args [show m] <++> q)
 159
 160 --
 161 -- Admin commands
 162 --
 163
 164 -- | Turn off an output device.
 165 disableOutput :: Int -> MPD ()
 166 disableOutput = getResponse_ . ("disableoutput" <$>)
 167
 168 -- | Turn on an output device.
 169 enableOutput :: Int -> MPD ()
 170 enableOutput = getResponse_ . ("enableoutput" <$>)
 171
 172 -- | Retrieve information for all output devices.
 173 outputs :: MPD [Device]
 174 outputs = getResponse "outputs" >>= runParser parseOutputs
 175
 176 -- | Update the server's database.
 177 -- If no paths are given, all paths will be scanned.
 178 -- Unreadable or non-existent paths are silently ignored.
 179 update :: [Path] -> MPD ()
 180 update  [] = getResponse_ "update"
 181 update [x] = getResponse_ ("update" <$> x)
 182 update xs  = getResponses (map ("update" <$>) xs) >> return ()
 183
 184 --
 185 -- Database commands
 186 --
 187
 188 -- | List all metadata of metadata (sic).
 189 list :: Meta -- ^ Metadata to list
 190      -> Query -> MPD [String]
 191 list mtype query = liftM takeValues $ getResponse ("list" <$> mtype <++> query)
 192
 193 -- | Non-recursively list the contents of a database directory.
 194 lsInfo :: Path -> MPD [Either Path Song]
 195 lsInfo = lsInfo' "lsinfo"
 196
 197 -- | List the songs (without metadata) in a database directory recursively.
 198 listAll :: Path -> MPD [Path]
 199 listAll path = liftM (map snd . filter ((== "file") . fst) . toAssoc)
 200                      (getResponse $ "listall" <$> path)
 201
 202 -- | Recursive 'lsInfo'.
 203 listAllInfo :: Path -> MPD [Either Path Song]
 204 listAllInfo = lsInfo' "listallinfo"
 205
 206 -- Helper for lsInfo and listAllInfo.
 207 lsInfo' :: String -> Path -> MPD [Either Path Song]
 208 lsInfo' cmd path = do
 209     liftM (extractEntries (Just . Right, const Nothing, Just . Left)) $
 210          takeEntries =<< getResponse (cmd <$> path)
 211
 212 -- | Search the database for entries exactly matching a query.
 213 find :: Query -> MPD [Song]
 214 find query = getResponse ("find" <$> query) >>= takeSongs
 215
 216 -- | Search the database using case insensitive matching.
 217 search :: Query -> MPD [Song]
 218 search query = getResponse ("search" <$> query) >>= takeSongs
 219
 220 -- | Count the number of entries matching a query.
 221 count :: Query -> MPD Count
 222 count query = getResponse ("count" <$>  query) >>= runParser parseCount
 223
 224 --
 225 -- Playlist commands
 226 --
 227 -- $playlist
 228 -- Unless otherwise noted all playlist commands operate on the current
 229 -- playlist.
 230
 231 -- This might do better to throw an exception than silently return 0.
 232 -- | Like 'add', but returns a playlist id.
 233 addId :: Path -> MPD Integer
 234 addId p = getResponse1 ("addid" <$> p) >>=
 235           parse parseNum id . snd . head . toAssoc
 236
 237 -- | Like 'add_' but returns a list of the files added.
 238 add :: PlaylistName -> Path -> MPD [Path]
 239 add plname x = add_ plname x >> listAll x
 240
 241 -- | Add a song (or a whole directory) to a playlist.
 242 -- Adds to current if no playlist is specified.
 243 -- Will create a new playlist if the one specified does not already exist.
 244 add_ :: PlaylistName -> Path -> MPD ()
 245 add_ "" path     = getResponse_ ("add" <$> path)
 246 add_ plname path = getResponse_ ("playlistadd" <$> plname <++> path)
 247
 248 -- | Clear a playlist. Clears current playlist if no playlist is specified.
 249 -- If the specified playlist does not exist, it will be created.
 250 clear :: PlaylistName -> MPD ()
 251 clear "" = getResponse_ "clear"
 252 clear pl = getResponse_ ("playlistclear" <$> pl)
 253
 254 -- | Remove a song from a playlist.
 255 -- If no playlist is specified, current playlist is used.
 256 -- Note that a playlist position ('Pos') is required when operating on
 257 -- playlists other than the current.
 258 delete :: PlaylistName -> PLIndex -> MPD ()
 259 delete "" (Pos x) = getResponse_ ("delete" <$> x)
 260 delete "" (ID x)  = getResponse_ ("deleteid" <$> x)
 261 delete plname (Pos x) = getResponse_ ("playlistdelete" <$> plname <++> x)
 262 delete _ _ = fail "'delete' within a playlist doesn't accept a playlist ID"
 263
 264 -- | Load an existing playlist.
 265 load :: PlaylistName -> MPD ()
 266 load plname = getResponse_ ("load" <$> plname)
 267
 268 -- | Move a song to a given position.
 269 -- Note that a playlist position ('Pos') is required when operating on
 270 -- playlists other than the current.
 271 move :: PlaylistName -> PLIndex -> Integer -> MPD ()
 272 move "" (Pos from) to = getResponse_ ("move" <$> from <++> to)
 273 move "" (ID from) to = getResponse_ ("moveid" <$> from <++> to)
 274 move plname (Pos from) to =
 275     getResponse_ ("playlistmove" <$> plname <++> from <++> to)
 276 move _ _ _ = fail "'move' within a playlist doesn't accept a playlist ID"
 277
 278 -- | Delete existing playlist.
 279 rm :: PlaylistName -> MPD ()
 280 rm plname = getResponse_ ("rm" <$> plname)
 281
 282 -- | Rename an existing playlist.
 283 rename :: PlaylistName -- ^ Original playlist
 284        -> PlaylistName -- ^ New playlist name
 285        -> MPD ()
 286 rename plname new = getResponse_ ("rename" <$> plname <++> new)
 287
 288 -- | Save the current playlist.
 289 save :: PlaylistName -> MPD ()
 290 save plname = getResponse_ ("save" <$> plname)
 291
 292 -- | Swap the positions of two songs.
 293 -- Note that the positions must be of the same type, i.e. mixing 'Pos' and 'ID'
 294 -- will result in a no-op.
 295 swap :: PLIndex -> PLIndex -> MPD ()
 296 swap (Pos x) (Pos y) = getResponse_ ("swap" <$> x <++> y)
 297 swap (ID x)  (ID y)  = getResponse_ ("swapid" <$> x <++> y)
 298 swap _ _ = fail "'swap' cannot mix position and ID arguments"
 299
 300 -- | Shuffle the playlist.
 301 shuffle :: MPD ()
 302 shuffle = getResponse_ "shuffle"
 303
 304 -- | Retrieve metadata for songs in the current playlist.
 305 playlistInfo :: Maybe PLIndex -> MPD [Song]
 306 playlistInfo x = getResponse cmd >>= takeSongs
 307     where cmd = case x of
 308                     Just (Pos x') -> "playlistinfo" <$> x'
 309                     Just (ID x')  -> "playlistid"   <$> x'
 310                     Nothing       -> "playlistinfo"
 311
 312 -- | Retrieve metadata for files in a given playlist.
 313 listPlaylistInfo :: PlaylistName -> MPD [Song]
 314 listPlaylistInfo plname =
 315     takeSongs =<< getResponse ("listplaylistinfo" <$> plname)
 316
 317 -- | Retrieve a list of files in a given playlist.
 318 listPlaylist :: PlaylistName -> MPD [Path]
 319 listPlaylist plname =
 320     liftM takeValues $ getResponse ("listplaylist" <$> plname)
 321
 322 -- | Retrieve file paths and positions of songs in the current playlist.
 323 -- Note that this command is only included for completeness sake; it's
 324 -- deprecated and likely to disappear at any time, please use 'playlistInfo'
 325 -- instead.
 326 playlist :: MPD [(PLIndex, Path)]
 327 playlist = mapM f =<< getResponse "playlist"
 328     where f s | (pos, name) <- breakChar ':' s
 329               , Just pos'   <- parseNum pos
 330               = return (Pos pos', name)
 331               | otherwise = throwError . Unexpected $ show s
 332
 333 -- | Retrieve a list of changed songs currently in the playlist since
 334 -- a given playlist version.
 335 plChanges :: Integer -> MPD [Song]
 336 plChanges version = takeSongs =<< getResponse ("plchanges" <$> version)
 337
 338 -- | Like 'plChanges' but only returns positions and ids.
 339 plChangesPosId :: Integer -> MPD [(PLIndex, PLIndex)]
 340 plChangesPosId plver =
 341     getResponse ("plchangesposid" <$> plver) >>=
 342     mapM f . splitGroups [("cpos",id)] . toAssoc
 343     where f xs | [("cpos", x), ("Id", y)] <- xs
 344                , Just (x', y') <- pair parseNum (x, y)
 345                = return (Pos x', ID y')
 346                | otherwise = throwError . Unexpected $ show xs
 347
 348 -- | Search for songs in the current playlist with strict matching.
 349 playlistFind :: Query -> MPD [Song]
 350 playlistFind q = takeSongs =<< getResponse ("playlistfind" <$> q)
 351
 352 -- | Search case-insensitively with partial matches for songs in the
 353 -- current playlist.
 354 playlistSearch :: Query -> MPD [Song]
 355 playlistSearch q = takeSongs =<< getResponse ("playlistsearch" <$> q)
 356
 357 -- | Get the currently playing song.
 358 currentSong :: MPD (Maybe Song)
 359 currentSong = do
 360     cs <- status
 361     if stState cs == Stopped
 362        then return Nothing
 363        else getResponse1 "currentsong" >>=
 364             fmap Just . runParser parseSong . toAssoc
 365
 366 --
 367 -- Playback commands
 368 --
 369
 370 -- | Set crossfading between songs.
 371 crossfade :: Seconds -> MPD ()
 372 crossfade secs = getResponse_ ("crossfade" <$> secs)
 373
 374 -- | Begin\/continue playing.
 375 play :: Maybe PLIndex -> MPD ()
 376 play Nothing        = getResponse_  "play"
 377 play (Just (Pos x)) = getResponse_ ("play"   <$> x)
 378 play (Just (ID x))  = getResponse_ ("playid" <$> x)
 379
 380 -- | Pause playing.
 381 pause :: Bool -> MPD ()
 382 pause = getResponse_ . ("pause" <$>)
 383
 384 -- | Stop playing.
 385 stop :: MPD ()
 386 stop = getResponse_ "stop"
 387
 388 -- | Play the next song.
 389 next :: MPD ()
 390 next = getResponse_ "next"
 391
 392 -- | Play the previous song.
 393 previous :: MPD ()
 394 previous = getResponse_ "previous"
 395
 396 -- | Seek to some point in a song.
 397 -- Seeks in current song if no position is given.
 398 seek :: Maybe PLIndex -> Seconds -> MPD ()
 399 seek (Just (Pos x)) time = getResponse_ ("seek" <$> x <++> time)
 400 seek (Just (ID x)) time = getResponse_ ("seekid" <$> x <++> time)
 401 seek Nothing time = do
 402     st <- status
 403     unless (stState st == Stopped) (seek (stSongID st) time)
 404
 405 -- | Set random playing.
 406 random :: Bool -> MPD ()
 407 random = getResponse_ . ("random" <$>)
 408
 409 -- | Set repeating.
 410 repeat :: Bool -> MPD ()
 411 repeat = getResponse_ . ("repeat" <$>)
 412
 413 -- | Set the volume (0-100 percent).
 414 setVolume :: Int -> MPD ()
 415 setVolume = getResponse_ . ("setvol" <$>)
 416
 417 -- | Increase or decrease volume by a given percent, e.g.
 418 -- 'volume 10' will increase the volume by 10 percent, while
 419 -- 'volume (-10)' will decrease it by the same amount.
 420 -- Note that this command is only included for completeness sake ; it's
 421 -- deprecated and may disappear at any time, please use 'setVolume' instead.
 422 volume :: Int -> MPD ()
 423 volume = getResponse_ . ("volume" <$>)
 424
 425 --
 426 -- Miscellaneous commands
 427 --
 428
 429 -- | Clear the current error message in status.
 430 clearError :: MPD ()
 431 clearError = getResponse_ "clearerror"
 432
 433 -- | Retrieve a list of available commands.
 434 commands :: MPD [String]
 435 commands = liftM takeValues (getResponse "commands")
 436
 437 -- | Retrieve a list of unavailable (due to access restrictions) commands.
 438 notCommands :: MPD [String]
 439 notCommands = liftM takeValues (getResponse "notcommands")
 440
 441 -- | Retrieve a list of available song metadata.
 442 tagTypes :: MPD [String]
 443 tagTypes = liftM takeValues (getResponse "tagtypes")
 444
 445 -- | Retrieve a list of supported urlhandlers.
 446 urlHandlers :: MPD [String]
 447 urlHandlers = liftM takeValues (getResponse "urlhandlers")
 448
 449 -- XXX should the password be quoted? Change "++" to "<$>" if so.
 450 -- | Send password to server to authenticate session.
 451 -- Password is sent as plain text.
 452 password :: String -> MPD ()
 453 password = getResponse_ . ("password " ++)
 454
 455 -- | Check that the server is still responding.
 456 ping :: MPD ()
 457 ping = getResponse_ "ping"
 458
 459 -- | Get server statistics.
 460 stats :: MPD Stats
 461 stats = getResponse "stats" >>= runParser parseStats
 462
 463 -- | Get the server's status.
 464 status :: MPD Status
 465 status = getResponse "status" >>= runParser parseStatus
 466
 467 --
 468 -- Extensions\/shortcuts.
 469 --
 470
 471 -- | Like 'update', but returns the update job id.
 472 updateId :: [Path] -> MPD Integer
 473 updateId paths = liftM (read . head . takeValues) cmd
 474   where cmd = case paths of
 475                 []  -> getResponse  "update"
 476                 [x] -> getResponse ("update" <$> x)
 477                 xs  -> getResponses $ map ("update" <$>) xs
 478
 479 -- | Toggles play\/pause. Plays if stopped.
 480 toggle :: MPD ()
 481 toggle = status >>= \st -> case stState st of Playing -> pause True
 482                                               _       -> play Nothing
 483
 484 -- | Add a list of songs\/folders to a playlist.
 485 -- Should be more efficient than running 'add' many times.
 486 addMany :: PlaylistName -> [Path] -> MPD ()
 487 addMany _ [] = return ()
 488 addMany plname [x] = add_ plname x
 489 addMany plname xs = getResponses (map cmd xs) >> return ()
 490     where cmd x = case plname of
 491                       "" -> "add" <$> x
 492                       pl -> "playlistadd" <$> pl <++> x
 493
 494 -- | Delete a list of songs from a playlist.
 495 -- If there is a duplicate then no further songs will be deleted, so
 496 -- take care to avoid them (see 'prune' for this).
 497 deleteMany :: PlaylistName -> [PLIndex] -> MPD ()
 498 deleteMany _ [] = return ()
 499 deleteMany plname [x] = delete plname x
 500 deleteMany "" xs = getResponses (map cmd xs) >> return ()
 501     where cmd (Pos x) = "delete"   <$> x
 502           cmd (ID x)  = "deleteid" <$> x
 503 deleteMany plname xs = getResponses (map cmd xs) >> return ()
 504     where cmd (Pos x) = "playlistdelete" <$> plname <++> x
 505           cmd _       = ""
 506
 507 -- | Returns all songs and directories that match the given partial
 508 -- path name.
 509 complete :: String -> MPD [Either Path Song]
 510 complete path = do
 511     xs <- liftM matches . lsInfo $ dropFileName path
 512     case xs of
 513         [Left dir] -> complete $ dir ++ "/"
 514         _          -> return xs
 515     where
 516         matches = filter (isPrefixOf path . takePath)
 517         takePath = either id sgFilePath
 518
 519 -- | Crop playlist.
 520 -- The bounds are inclusive.
 521 -- If 'Nothing' or 'ID' is passed the cropping will leave your playlist alone
 522 -- on that side.
 523 crop :: Maybe PLIndex -> Maybe PLIndex -> MPD ()
 524 crop x y = do
 525     pl <- playlistInfo Nothing
 526     let x' = case x of Just (Pos p) -> fromInteger p
 527                        Just (ID i)  -> fromMaybe 0 (findByID i pl)
 528                        Nothing      -> 0
 529         -- ensure that no songs are deleted twice with 'max'.
 530         ys = case y of Just (Pos p) -> drop (max (fromInteger p) x') pl
 531                        Just (ID i)  -> maybe [] (flip drop pl . max x' . (+1))
 532                                       (findByID i pl)
 533                        Nothing      -> []
 534     deleteMany "" . mapMaybe sgIndex $ take x' pl ++ ys
 535     where findByID i = findIndex ((==) i . (\(ID j) -> j) . fromJust . sgIndex)
 536
 537 -- | Remove duplicate playlist entries.
 538 prune :: MPD ()
 539 prune = findDuplicates >>= deleteMany ""
 540
 541 -- Find duplicate playlist entries.
 542 findDuplicates :: MPD [PLIndex]
 543 findDuplicates =
 544     liftM (map ((\(ID x) -> ID x) . fromJust . sgIndex) . flip dups ([],[])) $
 545         playlistInfo Nothing
 546     where dups [] (_, dup) = dup
 547           dups (x:xs) (ys, dup)
 548               | x `mSong` xs && not (x `mSong` ys) = dups xs (ys, x:dup)
 549               | otherwise                          = dups xs (x:ys, dup)
 550           mSong x = let m = sgFilePath x in any ((==) m . sgFilePath)
 551
 552 -- | List directories non-recursively.
 553 lsDirs :: Path -> MPD [Path]
 554 lsDirs path =
 555     liftM (extractEntries (const Nothing,const Nothing, Just)) $
 556         takeEntries =<< getResponse ("lsinfo" <$> path)
 557
 558 -- | List files non-recursively.
 559 lsFiles :: Path -> MPD [Path]
 560 lsFiles path =
 561     liftM (extractEntries (Just . sgFilePath, const Nothing, const Nothing)) $
 562         takeEntries =<< getResponse ("lsinfo" <$> path)
 563
 564 -- | List all playlists.
 565 lsPlaylists :: MPD [PlaylistName]
 566 lsPlaylists = liftM (extractEntries (const Nothing, Just, const Nothing)) $
 567                     takeEntries =<< getResponse "lsinfo"
 568
 569 -- | Search the database for songs relating to an artist.
 570 findArtist :: Artist -> MPD [Song]
 571 findArtist x = find [Match Artist x]
 572
 573 -- | Search the database for songs relating to an album.
 574 findAlbum :: Album -> MPD [Song]
 575 findAlbum  x = find [Match Album x]
 576
 577 -- | Search the database for songs relating to a song title.
 578 findTitle :: Title -> MPD [Song]
 579 findTitle x = find [Match Title x]
 580
 581 -- | List the artists in the database.
 582 listArtists :: MPD [Artist]
 583 listArtists = liftM takeValues (getResponse "list artist")
 584
 585 -- | List the albums in the database, optionally matching a given
 586 -- artist.
 587 listAlbums :: Maybe Artist -> MPD [Album]
 588 listAlbums artist = liftM takeValues $
 589                     getResponse ("list album" <$> fmap ("artist" <++>) artist)
 590
 591 -- | List the songs in an album of some artist.
 592 listAlbum :: Artist -> Album -> MPD [Song]
 593 listAlbum artist album = find [Match Artist artist, Match Album album]
 594
 595 -- | Search the database for songs relating to an artist using 'search'.
 596 searchArtist :: Artist -> MPD [Song]
 597 searchArtist x = search [Match Artist x]
 598
 599 -- | Search the database for songs relating to an album using 'search'.
 600 searchAlbum :: Album -> MPD [Song]
 601 searchAlbum x = search [Match Album x]
 602
 603 -- | Search the database for songs relating to a song title.
 604 searchTitle :: Title -> MPD [Song]
 605 searchTitle x = search [Match Title x]
 606
 607 -- | Retrieve the current playlist.
 608 -- Equivalent to @playlistinfo Nothing@.
 609 getPlaylist :: MPD [Song]
 610 getPlaylist = playlistInfo Nothing
 611
 612 --
 613 -- Miscellaneous functions.
 614 --
 615
 616 -- Run getResponse but discard the response.
 617 getResponse_ :: String -> MPD ()
 618 getResponse_ x = getResponse x >> return ()
 619
 620 -- Get the lines of the daemon's response to a list of commands.
 621 getResponses :: [String] -> MPD [String]
 622 getResponses cmds = getResponse . concat $ intersperse "\n" cmds'
 623     where cmds' = "command_list_begin" : cmds ++ ["command_list_end"]
 624
 625 -- Helper that throws unexpected error if input is empty.
 626 failOnEmpty :: [String] -> MPD [String]
 627 failOnEmpty [] = throwError $ Unexpected "Non-empty response expected."
 628 failOnEmpty xs = return xs
 629
 630 -- A wrapper for getResponse that fails on non-empty responses.
 631 getResponse1 :: String -> MPD [String]
 632 getResponse1 x = getResponse x >>= failOnEmpty
 633
 634 --
 635 -- Parsing.
 636 --
 637
 638 -- Run 'toAssoc' and return only the values.
 639 takeValues :: [String] -> [String]
 640 takeValues = snd . unzip . toAssoc
 641
 642 data EntryType
 643     = SongEntry Song
 644     | PLEntry   String
 645     | DirEntry  String
 646       deriving Show
 647
 648 -- Separate the result of an lsinfo\/listallinfo call into directories,
 649 -- playlists, and songs.
 650 takeEntries :: [String] -> MPD [EntryType]
 651 takeEntries = mapM toEntry . splitGroups wrappers . toAssoc . reverse
 652     where
 653         toEntry xs@(("file",_):_)   = liftM SongEntry $ runParser parseSong xs
 654         toEntry (("directory",d):_) = return $ DirEntry d
 655         toEntry (("playlist",pl):_) = return $ PLEntry  pl
 656         toEntry _ = error "takeEntries: splitGroups is broken"
 657         wrappers = [("file",id), ("directory",id), ("playlist",id)]
 658
 659 -- Extract a subset of songs, directories, and playlists.
 660 extractEntries :: (Song -> Maybe a, String -> Maybe a, String -> Maybe a)
 661                -> [EntryType] -> [a]
 662 extractEntries (fSong,fPlayList,fDir) = catMaybes . map f
 663     where
 664         f (SongEntry s) = fSong s
 665         f (PLEntry pl)  = fPlayList pl
 666         f (DirEntry d)  = fDir d
 667
 668 -- Build a list of song instances from a response.
 669 takeSongs :: [String] -> MPD [Song]
 670 takeSongs = mapM (runParser parseSong) . splitGroups [("file",id)] . toAssoc