Network/MPD/Commands.hs

   1 {-
   2     libmpd for Haskell, an MPD client library.
   3     Copyright (C) 2005-2008  Ben Sinclair <bsinclai@turing.une.edu.au>
   4
   5     This library is free software; you can redistribute it and/or
   6     modify it under the terms of the GNU Lesser General Public
   7     License as published by the Free Software Foundation; either
   8     version 2.1 of the License, or (at your option) any later version.
   9
  10     This library is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13     Lesser General Public License for more details.
  14
  15     You should have received a copy of the GNU Lesser General Public
  16     License along with this library; if not, write to the Free Software
  17     Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18 -}
  19
  20 -- | Module    : Network.MPD.Commands
  21 -- Copyright   : (c) Ben Sinclair 2005-2008
  22 -- License     : LGPL
  23 -- Maintainer  : bsinclai@turing.une.edu.au
  24 -- Stability   : alpha
  25 -- Portability : Haskell 98
  26 --
  27 -- Interface to the user commands supported by MPD.
  28
  29 module Network.MPD.Commands (
  30     -- * Command related data types
  31     State(..), Status(..), Stats(..),
  32     Device(..),
  33     Query(..), Meta(..),
  34     Artist, Album, Title, Seconds, PlaylistName, Path,
  35     PLIndex(..), Song(..), Count(..),
  36
  37     -- * Admin commands
  38     disableOutput, enableOutput, kill, outputs, update,
  39
  40     -- * Database commands
  41     find, list, listAll, listAllInfo, lsInfo, search, count,
  42
  43     -- * Playlist commands
  44     -- $playlist
  45     add, add_, addId, clear, currentSong, delete, load, move,
  46     playlistInfo, listPlaylist, listPlaylistInfo, playlist, plChanges,
  47     plChangesPosId, playlistFind, playlistSearch, rm, rename, save, shuffle,
  48     swap,
  49
  50     -- * Playback commands
  51     crossfade, next, pause, play, previous, random, repeat, seek, setVolume,
  52     volume, stop,
  53
  54     -- * Miscellaneous commands
  55     clearError, close, commands, notCommands, password, ping, reconnect, stats,
  56     status, tagTypes, urlHandlers,
  57
  58     -- * Extensions\/shortcuts
  59     addMany, deleteMany, complete, crop, prune, lsDirs, lsFiles, lsPlaylists,
  60     findArtist, findAlbum, findTitle, listArtists, listAlbums, listAlbum,
  61     searchArtist, searchAlbum, searchTitle, getPlaylist, toggle, updateId
  62     ) where
  63
  64 import Network.MPD.Core
  65 import Network.MPD.Utils
  66
  67 import Control.Monad (liftM, unless)
  68 import Control.Monad.Error (throwError)
  69 import Prelude hiding (repeat)
  70 import Data.List (findIndex, intersperse, isPrefixOf)
  71 import Data.Maybe
  72 import System.FilePath (dropFileName)
  73
  74 --
  75 -- Data types
  76 --
  77
  78 type Artist       = String
  79 type Album        = String
  80 type Title        = String
  81 type Seconds      = Integer
  82
  83 -- | Used for commands which require a playlist name.
  84 -- If empty, the current playlist is used.
  85 type PlaylistName = String
  86
  87 -- | Used for commands which require a path within the database.
  88 -- If empty, the root path is used.
  89 type Path         = String
  90
  91 -- | Available metadata types\/scope modifiers, used for searching the
  92 -- database for entries with certain metadata values.
  93 data Meta = Artist | Album | Title | Track | Name | Genre | Date
  94     | Composer | Performer | Disc | Any | Filename
  95
  96 instance Show Meta where
  97     show Artist    = "Artist"
  98     show Album     = "Album"
  99     show Title     = "Title"
 100     show Track     = "Track"
 101     show Name      = "Name"
 102     show Genre     = "Genre"
 103     show Date      = "Date"
 104     show Composer  = "Composer"
 105     show Performer = "Performer"
 106     show Disc      = "Disc"
 107     show Any       = "Any"
 108     show Filename  = "Filename"
 109
 110 -- | A query is composed of a scope modifier and a query string.
 111 --
 112 -- To match entries where album equals \"Foo\", use:
 113 --
 114 -- > Query Album "Foo"
 115 --
 116 -- To match entries where album equals \"Foo\" and artist equals \"Bar\", use:
 117 --
 118 -- > MultiQuery [Query Album "Foo", Query Artist "Bar"]
 119 data Query = Query Meta String  -- ^ Simple query.
 120            | MultiQuery [Query] -- ^ Query with multiple conditions.
 121
 122 instance Show Query where
 123     show (Query meta query) = show meta ++ " " ++ show query
 124     show (MultiQuery xs)    = show xs
 125     showList xs _ = unwords $ map show xs
 126
 127 -- | Represents a song's playlist index.
 128 data PLIndex = Pos Integer -- ^ A playlist position index (starting from 0)
 129              | ID Integer  -- ^ A playlist ID number that more robustly
 130                            --   identifies a song.
 131     deriving Show
 132
 133 -- | Represents the different playback states.
 134 data State = Playing
 135            | Stopped
 136            | Paused
 137     deriving (Show, Eq)
 138
 139 -- | Container for MPD status.
 140 data Status =
 141     Status { stState :: State
 142              -- | A percentage (0-100)
 143            , stVolume          :: Int
 144            , stRepeat          :: Bool
 145            , stRandom          :: Bool
 146              -- | A value that is incremented by the server every time the
 147              --   playlist changes.
 148            , stPlaylistVersion :: Integer
 149              -- | The number of items in the current playlist.
 150            , stPlaylistLength  :: Integer
 151              -- | Current song's position in the playlist.
 152            , stSongPos         :: Maybe PLIndex
 153              -- | Current song's playlist ID.
 154            , stSongID          :: Maybe PLIndex
 155              -- | Time elapsed\/total time.
 156            , stTime            :: (Seconds, Seconds)
 157              -- | Bitrate (in kilobytes per second) of playing song (if any).
 158            , stBitrate         :: Int
 159              -- | Crossfade time.
 160            , stXFadeWidth      :: Seconds
 161              -- | Samplerate\/bits\/channels for the chosen output device
 162              --   (see mpd.conf).
 163            , stAudio           :: (Int, Int, Int)
 164              -- | Job ID of currently running update (if any).
 165            , stUpdatingDb      :: Integer
 166              -- | Last error message (if any).
 167            , stError           :: String }
 168     deriving Show
 169
 170 -- | Container for database statistics.
 171 data Stats =
 172     Stats { stsArtists    :: Integer -- ^ Number of artists.
 173           , stsAlbums     :: Integer -- ^ Number of albums.
 174           , stsSongs      :: Integer -- ^ Number of songs.
 175           , stsUptime     :: Seconds -- ^ Daemon uptime in seconds.
 176           , stsPlaytime   :: Seconds -- ^ Total playing time.
 177           , stsDbPlaytime :: Seconds -- ^ Total play time of all the songs in
 178                                      --   the database.
 179           , stsDbUpdate   :: Integer -- ^ Last database update in UNIX time.
 180           }
 181     deriving Show
 182
 183 -- | Represents a single song item.
 184 data Song =
 185     Song { sgArtist, sgAlbum, sgTitle, sgFilePath, sgGenre, sgName, sgComposer
 186          , sgPerformer :: String
 187          , sgLength    :: Seconds       -- ^ Length in seconds
 188          , sgDate      :: Int           -- ^ Year
 189          , sgTrack     :: (Int, Int)    -- ^ Track number\/total tracks
 190          , sgDisc      :: (Int, Int)    -- ^ Position in set\/total in set
 191          , sgIndex     :: Maybe PLIndex }
 192     deriving Show
 193
 194 -- Avoid the need for writing a proper 'elem' for use in 'prune'.
 195 instance Eq Song where
 196     (==) x y = sgFilePath x == sgFilePath y
 197
 198 -- | Represents the result of running 'count'.
 199 data Count =
 200     Count { cSongs    :: Integer -- ^ Number of songs matching the query
 201           , cPlaytime :: Seconds -- ^ Total play time of matching songs
 202           }
 203     deriving (Eq, Show)
 204
 205 -- | Represents an output device.
 206 data Device =
 207     Device { dOutputID      :: Int    -- ^ Output's ID number
 208            , dOutputName    :: String -- ^ Output's name as defined in the MPD
 209                                       --   configuration file
 210            , dOutputEnabled :: Bool }
 211     deriving (Eq, Show)
 212
 213 --
 214 -- Admin commands
 215 --
 216
 217 -- | Turn off an output device.
 218 disableOutput :: Int -> MPD ()
 219 disableOutput = getResponse_ . ("disableoutput " ++) . show
 220
 221 -- | Turn on an output device.
 222 enableOutput :: Int -> MPD ()
 223 enableOutput = getResponse_ . ("enableoutput " ++) . show
 224
 225 -- | Retrieve information for all output devices.
 226 outputs :: MPD [Device]
 227 outputs = liftM (map takeDevInfo . splitGroups . toAssoc)
 228     (getResponse "outputs")
 229     where
 230         takeDevInfo xs = Device {
 231             dOutputID      = takeNum "outputid" xs,
 232             dOutputName    = takeString "outputname" xs,
 233             dOutputEnabled = takeBool "outputenabled" xs
 234             }
 235
 236 -- | Update the server's database.
 237 -- If no paths are given, all paths will be scanned.
 238 -- Unreadable or non-existent paths are silently ignored.
 239 update :: [Path] -> MPD ()
 240 update  [] = getResponse_ "update"
 241 update [x] = getResponse_ ("update " ++ show x)
 242 update  xs = getResponses (map (("update " ++) . show) xs) >> return ()
 243
 244 --
 245 -- Database commands
 246 --
 247
 248 -- | List all metadata of metadata (sic).
 249 list :: Meta -- ^ Metadata to list
 250      -> Maybe Query -> MPD [String]
 251 list mtype query = liftM takeValues (getResponse cmd)
 252     where cmd = "list " ++ show mtype ++ maybe "" ((" "++) . show) query
 253
 254 -- | Non-recursively list the contents of a database directory.
 255 lsInfo :: Path -> MPD [Either Path Song]
 256 lsInfo = lsInfo' "lsinfo"
 257
 258 -- | List the songs (without metadata) in a database directory recursively.
 259 listAll :: Path -> MPD [Path]
 260 listAll path = liftM (map snd . filter ((== "file") . fst) . toAssoc)
 261                      (getResponse ("listall " ++ show path))
 262
 263 -- | Recursive 'lsInfo'.
 264 listAllInfo :: Path -> MPD [Either Path Song]
 265 listAllInfo = lsInfo' "listallinfo"
 266
 267 -- Helper for lsInfo and listAllInfo.
 268 lsInfo' :: String -> Path -> MPD [Either Path Song]
 269 lsInfo' cmd path = do
 270     (dirs,_,songs) <- liftM takeEntries
 271                             (getResponse (cmd ++ " " ++ show path))
 272     return (map Left dirs ++ map Right songs)
 273
 274 -- | Search the database for entries exactly matching a query.
 275 find :: Query -> MPD [Song]
 276 find query = liftM takeSongs (getResponse ("find " ++ show query))
 277
 278 -- | Search the database using case insensitive matching.
 279 search :: Query -> MPD [Song]
 280 search query = liftM takeSongs (getResponse ("search " ++ show query))
 281
 282 -- | Count the number of entries matching a query.
 283 count :: Query -> MPD Count
 284 count query = liftM (takeCountInfo . toAssoc)
 285                     (getResponse ("count " ++ show query))
 286     where takeCountInfo xs = Count { cSongs    = takeNum "songs" xs,
 287                                      cPlaytime = takeNum "playtime" xs }
 288
 289 --
 290 -- Playlist commands
 291 --
 292 -- $playlist
 293 -- Unless otherwise noted all playlist commands operate on the current
 294 -- playlist.
 295
 296 -- This might do better to throw an exception than silently return 0.
 297 -- | Like 'add', but returns a playlist id.
 298 addId :: Path -> MPD Integer
 299 addId = liftM (takeNum "Id" . toAssoc) . getResponse . ("addid " ++) . show
 300
 301 -- | Like 'add_' but returns a list of the files added.
 302 add :: PlaylistName -> Path -> MPD [Path]
 303 add plname x = add_ plname x >> listAll x
 304
 305 -- | Add a song (or a whole directory) to a playlist.
 306 -- Adds to current if no playlist is specified.
 307 -- Will create a new playlist if the one specified does not already exist.
 308 add_ :: PlaylistName -> Path -> MPD ()
 309 add_ ""     = getResponse_ . ("add " ++) . show
 310 add_ plname = getResponse_ .
 311     (("playlistadd " ++ show plname ++ " ") ++) . show
 312
 313 -- | Clear a playlist. Clears current playlist if no playlist is specified.
 314 -- If the specified playlist does not exist, it will be created.
 315 clear :: PlaylistName -> MPD ()
 316 clear = getResponse_ . cmd
 317     where cmd x = case x of "" -> "clear"
 318                             pl -> "playlistclear " ++ show pl
 319
 320 -- | Remove a song from a playlist.
 321 -- If no playlist is specified, current playlist is used.
 322 -- Note that a playlist position ('Pos') is required when operating on
 323 -- playlists other than the current.
 324 delete :: PlaylistName -> PLIndex -> MPD ()
 325 delete "" (Pos x) = getResponse_ ("delete " ++ show x)
 326 delete "" (ID x)  = getResponse_ ("deleteid " ++ show x)
 327 delete plname (Pos x) =
 328     getResponse_ ("playlistdelete " ++ show plname ++ " " ++ show x)
 329 delete _ _ = fail "'delete' within a playlist doesn't accept a playlist ID"
 330
 331 -- | Load an existing playlist.
 332 load :: PlaylistName -> MPD ()
 333 load = getResponse_ . ("load " ++) . show
 334
 335 -- | Move a song to a given position.
 336 -- Note that a playlist position ('Pos') is required when operating on
 337 -- playlists other than the current.
 338 move :: PlaylistName -> PLIndex -> Integer -> MPD ()
 339 move "" (Pos from) to =
 340     getResponse_ ("move " ++ show from ++ " " ++ show to)
 341 move "" (ID from) to =
 342     getResponse_ ("moveid " ++ show from ++ " " ++ show to)
 343 move plname (Pos from) to =
 344     getResponse_ ("playlistmove " ++ show plname ++ " " ++ show from ++
 345                        " " ++ show to)
 346 move _ _ _ = fail "'move' within a playlist doesn't accept a playlist ID"
 347
 348 -- | Delete existing playlist.
 349 rm :: PlaylistName -> MPD ()
 350 rm = getResponse_ . ("rm " ++) . show
 351
 352 -- | Rename an existing playlist.
 353 rename :: PlaylistName -- ^ Original playlist
 354        -> PlaylistName -- ^ New playlist name
 355        -> MPD ()
 356 rename plname new =
 357     getResponse_ ("rename " ++ show plname ++ " " ++ show new)
 358
 359 -- | Save the current playlist.
 360 save :: PlaylistName -> MPD ()
 361 save = getResponse_ . ("save " ++) . show
 362
 363 -- | Swap the positions of two songs.
 364 -- Note that the positions must be of the same type, i.e. mixing 'Pos' and 'ID'
 365 -- will result in a no-op.
 366 swap :: PLIndex -> PLIndex -> MPD ()
 367 swap (Pos x) (Pos y) = getResponse_ ("swap "   ++ show x ++ " " ++ show y)
 368 swap (ID x)  (ID y)  = getResponse_ ("swapid " ++ show x ++ " " ++ show y)
 369 swap _ _ = fail "'swap' cannot mix position and ID arguments"
 370
 371 -- | Shuffle the playlist.
 372 shuffle :: MPD ()
 373 shuffle = getResponse_ "shuffle"
 374
 375 -- | Retrieve metadata for songs in the current playlist.
 376 playlistInfo :: Maybe PLIndex -> MPD [Song]
 377 playlistInfo x = liftM takeSongs (getResponse cmd)
 378     where cmd = case x of
 379                     Just (Pos x') -> "playlistinfo " ++ show x'
 380                     Just (ID x')  -> "playlistid " ++ show x'
 381                     Nothing       -> "playlistinfo"
 382
 383 -- | Retrieve metadata for files in a given playlist.
 384 listPlaylistInfo :: PlaylistName -> MPD [Song]
 385 listPlaylistInfo = liftM takeSongs . getResponse .
 386     ("listplaylistinfo " ++) . show
 387
 388 -- | Retrieve a list of files in a given playlist.
 389 listPlaylist :: PlaylistName -> MPD [Path]
 390 listPlaylist = liftM takeValues . getResponse . ("listplaylist " ++) . show
 391
 392 -- | Retrieve file paths and positions of songs in the current playlist.
 393 -- Note that this command is only included for completeness sake; it's
 394 -- deprecated and likely to disappear at any time, please use 'playlistInfo'
 395 -- instead.
 396 playlist :: MPD [(PLIndex, Path)]
 397 playlist = liftM (map f) (getResponse "playlist")
 398     where f s = let (pos, name) = break (== ':') s
 399                 in (Pos $ read pos, drop 1 name)
 400
 401 -- | Retrieve a list of changed songs currently in the playlist since
 402 -- a given playlist version.
 403 plChanges :: Integer -> MPD [Song]
 404 plChanges = liftM takeSongs . getResponse . ("plchanges " ++) . show
 405
 406 -- | Like 'plChanges' but only returns positions and ids.
 407 plChangesPosId :: Integer -> MPD [(PLIndex, PLIndex)]
 408 plChangesPosId plver =
 409     liftM (map takePosid . splitGroups . toAssoc) (getResponse cmd)
 410     where cmd          = "plchangesposid " ++ show plver
 411           takePosid xs = (Pos $ takeNum "cpos" xs, ID $ takeNum "Id" xs)
 412
 413 -- | Search for songs in the current playlist with strict matching.
 414 playlistFind :: Query -> MPD [Song]
 415 playlistFind = liftM takeSongs . getResponse . ("playlistfind " ++) . show
 416
 417 -- | Search case-insensitively with partial matches for songs in the
 418 -- current playlist.
 419 playlistSearch :: Query -> MPD [Song]
 420 playlistSearch = liftM takeSongs . getResponse . ("playlistsearch " ++) . show
 421
 422 -- | Get the currently playing song.
 423 currentSong :: MPD (Maybe Song)
 424 currentSong = do
 425     currStatus <- status
 426     if stState currStatus == Stopped
 427         then return Nothing
 428         else do ls <- liftM toAssoc (getResponse "currentsong")
 429                 return $ if null ls then Nothing
 430                                     else Just (takeSongInfo ls)
 431
 432 --
 433 -- Playback commands
 434 --
 435
 436 -- | Set crossfading between songs.
 437 crossfade :: Seconds -> MPD ()
 438 crossfade = getResponse_ . ("crossfade " ++) . show
 439
 440 -- | Begin\/continue playing.
 441 play :: Maybe PLIndex -> MPD ()
 442 play Nothing        = getResponse_ "play"
 443 play (Just (Pos x)) = getResponse_ ("play " ++ show x)
 444 play (Just (ID x))  = getResponse_ ("playid " ++ show x)
 445
 446 -- | Pause playing.
 447 pause :: Bool -> MPD ()
 448 pause = getResponse_ . ("pause " ++) . showBool
 449
 450 -- | Stop playing.
 451 stop :: MPD ()
 452 stop = getResponse_ "stop"
 453
 454 -- | Play the next song.
 455 next :: MPD ()
 456 next = getResponse_ "next"
 457
 458 -- | Play the previous song.
 459 previous :: MPD ()
 460 previous = getResponse_ "previous"
 461
 462 -- | Seek to some point in a song.
 463 -- Seeks in current song if no position is given.
 464 seek :: Maybe PLIndex -> Seconds -> MPD ()
 465 seek (Just (Pos x)) time =
 466     getResponse_ ("seek " ++ show x ++ " " ++ show time)
 467 seek (Just (ID x)) time =
 468     getResponse_ ("seekid " ++ show x ++ " " ++ show time)
 469 seek Nothing time = do
 470     st <- status
 471     unless (stState st == Stopped) (seek (stSongID st) time)
 472
 473 -- | Set random playing.
 474 random :: Bool -> MPD ()
 475 random = getResponse_ . ("random " ++) . showBool
 476
 477 -- | Set repeating.
 478 repeat :: Bool -> MPD ()
 479 repeat = getResponse_ . ("repeat " ++) . showBool
 480
 481 -- | Set the volume (0-100 percent).
 482 setVolume :: Int -> MPD ()
 483 setVolume = getResponse_ . ("setvol " ++) . show
 484
 485 -- | Increase or decrease volume by a given percent, e.g.
 486 -- 'volume 10' will increase the volume by 10 percent, while
 487 -- 'volume (-10)' will decrease it by the same amount.
 488 -- Note that this command is only included for completeness sake ; it's
 489 -- deprecated and may disappear at any time, please use 'setVolume' instead.
 490 volume :: Int -> MPD ()
 491 volume = getResponse_ . ("volume " ++) . show
 492
 493 --
 494 -- Miscellaneous commands
 495 --
 496
 497 -- | Clear the current error message in status.
 498 clearError :: MPD ()
 499 clearError = getResponse_ "clearerror"
 500
 501 -- | Retrieve a list of available commands.
 502 commands :: MPD [String]
 503 commands = liftM takeValues (getResponse "commands")
 504
 505 -- | Retrieve a list of unavailable (due to access restrictions) commands.
 506 notCommands :: MPD [String]
 507 notCommands = liftM takeValues (getResponse "notcommands")
 508
 509 -- | Retrieve a list of available song metadata.
 510 tagTypes :: MPD [String]
 511 tagTypes = liftM takeValues (getResponse "tagtypes")
 512
 513 -- | Retrieve a list of supported urlhandlers.
 514 urlHandlers :: MPD [String]
 515 urlHandlers = liftM takeValues (getResponse "urlhandlers")
 516
 517 -- XXX should the password be quoted?
 518 -- | Send password to server to authenticate session.
 519 -- Password is sent as plain text.
 520 password :: String -> MPD ()
 521 password = getResponse_ . ("password " ++)
 522
 523 -- | Check that the server is still responding.
 524 ping :: MPD ()
 525 ping = getResponse_ "ping"
 526
 527 -- | Get server statistics.
 528 stats :: MPD Stats
 529 stats = liftM (parseStats . toAssoc) (getResponse "stats")
 530     where parseStats xs =
 531                 Stats { stsArtists = takeNum "artists" xs,
 532                         stsAlbums = takeNum "albums" xs,
 533                         stsSongs = takeNum "songs" xs,
 534                         stsUptime = takeNum "uptime" xs,
 535                         stsPlaytime = takeNum "playtime" xs,
 536                         stsDbPlaytime = takeNum "db_playtime" xs,
 537                         stsDbUpdate = takeNum "db_update" xs }
 538
 539 -- | Get the server's status.
 540 status :: MPD Status
 541 status = liftM (parseStatus . toAssoc) (getResponse "status")
 542     where parseStatus xs =
 543               Status { stState = maybe Stopped parseState $ lookup "state" xs,
 544                        stVolume = takeNum "volume" xs,
 545                        stRepeat = takeBool "repeat" xs,
 546                        stRandom = takeBool "random" xs,
 547                        stPlaylistVersion = takeNum "playlist" xs,
 548                        stPlaylistLength = takeNum "playlistlength" xs,
 549                        stXFadeWidth = takeNum "xfade" xs,
 550                        stSongPos = takeIndex Pos "song" xs,
 551                        stSongID = takeIndex ID "songid" xs,
 552                        stTime = maybe (0,0) parseTime $ lookup "time" xs,
 553                        stBitrate = takeNum "bitrate" xs,
 554                        stAudio = maybe (0,0,0) parseAudio $ lookup "audio" xs,
 555                        stUpdatingDb = takeNum "updating_db" xs,
 556                        stError = takeString "error" xs }
 557           parseState x = case x of "play"  -> Playing
 558                                    "pause" -> Paused
 559                                    _       -> Stopped
 560           parseTime  x = let (y,_:z) = break (== ':') x in (read y, read z)
 561           parseAudio x =
 562               let (u,_:u') = break (== ':') x; (v,_:w) = break (== ':') u' in
 563                   (read u, read v, read w)
 564
 565 --
 566 -- Extensions\/shortcuts.
 567 --
 568
 569 -- | Like 'update', but returns the update job id.
 570 updateId :: [Path] -> MPD Integer
 571 updateId paths = liftM (read . head . takeValues) cmd
 572   where cmd = case paths of
 573                 []  -> getResponse "update"
 574                 [x] -> getResponse ("update " ++ x)
 575                 xs  -> getResponses (map ("update " ++) xs)
 576
 577 -- | Toggles play\/pause. Plays if stopped.
 578 toggle :: MPD ()
 579 toggle = status >>= \st -> case stState st of Playing -> pause True
 580                                               _       -> play Nothing
 581
 582 -- | Add a list of songs\/folders to a playlist.
 583 -- Should be more efficient than running 'add' many times.
 584 addMany :: PlaylistName -> [Path] -> MPD ()
 585 addMany _ [] = return ()
 586 addMany plname [x] = add_ plname x
 587 addMany plname xs = getResponses (map ((cmd ++) . show) xs) >> return ()
 588     where cmd = case plname of "" -> "add "
 589                                pl -> "playlistadd " ++ show pl ++ " "
 590
 591 -- | Delete a list of songs from a playlist.
 592 -- If there is a duplicate then no further songs will be deleted, so
 593 -- take care to avoid them (see 'prune' for this).
 594 deleteMany :: PlaylistName -> [PLIndex] -> MPD ()
 595 deleteMany _ [] = return ()
 596 deleteMany plname [x] = delete plname x
 597 deleteMany "" xs = getResponses (map cmd xs) >> return ()
 598     where cmd (Pos x) = "delete " ++ show x
 599           cmd (ID x)  = "deleteid " ++ show x
 600 deleteMany plname xs = getResponses (map cmd xs) >> return ()
 601     where cmd (Pos x) = "playlistdelete " ++ show plname ++ " " ++ show x
 602           cmd _       = ""
 603
 604 -- | Returns all songs and directories that match the given partial
 605 -- path name.
 606 complete :: String -> MPD [Either Path Song]
 607 complete path = do
 608     xs <- liftM matches . lsInfo $ dropFileName path
 609     case xs of
 610         [Left dir] -> complete $ dir ++ "/"
 611         _          -> return xs
 612     where
 613         matches = filter (isPrefixOf path . takePath)
 614         takePath = either id sgFilePath
 615
 616 -- | Crop playlist.
 617 -- The bounds are inclusive.
 618 -- If 'Nothing' or 'ID' is passed the cropping will leave your playlist alone
 619 -- on that side.
 620 crop :: Maybe PLIndex -> Maybe PLIndex -> MPD ()
 621 crop x y = do
 622     pl <- playlistInfo Nothing
 623     let x' = case x of Just (Pos p) -> fromInteger p
 624                        Just (ID i)  -> maybe 0 id (findByID i pl)
 625                        Nothing      -> 0
 626         -- ensure that no songs are deleted twice with 'max'.
 627         ys = case y of Just (Pos p) -> drop (max (fromInteger p) x') pl
 628                        Just (ID i)  -> maybe [] (flip drop pl . max x' . (+1))
 629                                       (findByID i pl)
 630                        Nothing      -> []
 631     deleteMany "" . mapMaybe sgIndex $ take x' pl ++ ys
 632     where findByID i = findIndex ((==) i . (\(ID j) -> j) . fromJust . sgIndex)
 633
 634 -- | Remove duplicate playlist entries.
 635 prune :: MPD ()
 636 prune = findDuplicates >>= deleteMany ""
 637
 638 -- Find duplicate playlist entries.
 639 findDuplicates :: MPD [PLIndex]
 640 findDuplicates =
 641     liftM (map ((\(ID x) -> ID x) . fromJust . sgIndex) . flip dups ([],[])) $
 642         playlistInfo Nothing
 643     where dups [] (_, dup) = dup
 644           dups (x:xs) (ys, dup)
 645               | x `elem` xs && x `notElem` ys = dups xs (ys, x:dup)
 646               | otherwise                     = dups xs (x:ys, dup)
 647
 648 -- | List directories non-recursively.
 649 lsDirs :: Path -> MPD [Path]
 650 lsDirs path = liftM ((\(x,_,_) -> x) . takeEntries)
 651                     (getResponse ("lsinfo " ++ show path))
 652
 653 -- | List files non-recursively.
 654 lsFiles :: Path -> MPD [Path]
 655 lsFiles path = liftM (map sgFilePath . (\(_,_,x) -> x) . takeEntries)
 656                      (getResponse ("lsinfo " ++ show path))
 657
 658 -- | List all playlists.
 659 lsPlaylists :: MPD [PlaylistName]
 660 lsPlaylists = liftM ((\(_,x,_) -> x) . takeEntries) (getResponse "lsinfo")
 661
 662 -- | Search the database for songs relating to an artist.
 663 findArtist :: Artist -> MPD [Song]
 664 findArtist = find . Query Artist
 665
 666 -- | Search the database for songs relating to an album.
 667 findAlbum :: Album -> MPD [Song]
 668 findAlbum = find . Query Album
 669
 670 -- | Search the database for songs relating to a song title.
 671 findTitle :: Title -> MPD [Song]
 672 findTitle = find . Query Title
 673
 674 -- | List the artists in the database.
 675 listArtists :: MPD [Artist]
 676 listArtists = liftM takeValues (getResponse "list artist")
 677
 678 -- | List the albums in the database, optionally matching a given
 679 -- artist.
 680 listAlbums :: Maybe Artist -> MPD [Album]
 681 listAlbums artist = liftM takeValues (getResponse ("list album" ++
 682     maybe "" ((" artist " ++) . show) artist))
 683
 684 -- | List the songs in an album of some artist.
 685 listAlbum :: Artist -> Album -> MPD [Song]
 686 listAlbum artist album = find (MultiQuery [Query Artist artist
 687                                           ,Query Album album])
 688
 689 -- | Search the database for songs relating to an artist using 'search'.
 690 searchArtist :: Artist -> MPD [Song]
 691 searchArtist = search . Query Artist
 692
 693 -- | Search the database for songs relating to an album using 'search'.
 694 searchAlbum :: Album -> MPD [Song]
 695 searchAlbum = search . Query Album
 696
 697 -- | Search the database for songs relating to a song title.
 698 searchTitle :: Title -> MPD [Song]
 699 searchTitle = search . Query Title
 700
 701 -- | Retrieve the current playlist.
 702 -- Equivalent to @playlistinfo Nothing@.
 703 getPlaylist :: MPD [Song]
 704 getPlaylist = playlistInfo Nothing
 705
 706 --
 707 -- Miscellaneous functions.
 708 --
 709
 710 -- Run getResponse but discard the response.
 711 getResponse_ :: String -> MPD ()
 712 getResponse_ x = getResponse x >> return ()
 713
 714 -- Get the lines of the daemon's response to a list of commands.
 715 getResponses :: [String] -> MPD [String]
 716 getResponses cmds = getResponse . concat $ intersperse "\n" cmds'
 717     where cmds' = "command_list_begin" : cmds ++ ["command_list_end"]
 718
 719 -- Helper that throws unexpected error if input is empty.
 720 failOnEmpty :: [String] -> MPD [String]
 721 failOnEmpty [] = throwError $ Unexpected "Non-empty response expected."
 722 failOnEmpty xs = return xs
 723
 724 -- A wrapper for getResponse that fails on non-empty responses.
 725 getResponse1 :: String -> MPD [String]
 726 getResponse1 x = getResponse x >>= failOnEmpty
 727
 728 -- getResponse1 for multiple commands.
 729 getResponses1 :: [String] -> MPD [String]
 730 getResponses1 cmds = getResponses cmds >>= failOnEmpty
 731
 732 --
 733 -- Parsing.
 734 --
 735
 736 -- Run 'toAssoc' and return only the values.
 737 takeValues :: [String] -> [String]
 738 takeValues = snd . unzip . toAssoc
 739
 740 -- Separate the result of an lsinfo\/listallinfo call into directories,
 741 -- playlists, and songs.
 742 takeEntries :: [String] -> ([String], [String], [Song])
 743 takeEntries s =
 744     (dirs, playlists, map takeSongInfo . splitGroups $ reverse filedata)
 745     where (dirs, playlists, filedata) = foldl split ([], [], []) $ toAssoc s
 746           split (ds, pls, ss) x@(k, v) | k == "directory" = (v:ds, pls, ss)
 747                                        | k == "playlist"  = (ds, v:pls, ss)
 748                                        | otherwise        = (ds, pls, x:ss)
 749
 750 -- Build a list of song instances from a response.
 751 takeSongs :: [String] -> [Song]
 752 takeSongs = map takeSongInfo . splitGroups . toAssoc
 753
 754 -- Builds a song instance from an assoc. list.
 755 takeSongInfo :: [(String,String)] -> Song
 756 takeSongInfo xs =
 757     Song { sgArtist    = takeString "Artist" xs,
 758            sgAlbum     = takeString "Album" xs,
 759            sgTitle     = takeString "Title" xs,
 760            sgGenre     = takeString "Genre" xs,
 761            sgName      = takeString "Name" xs,
 762            sgComposer  = takeString "Composer" xs,
 763            sgPerformer = takeString "Performer" xs,
 764            sgDate      = takeNum "Date" xs,
 765            sgTrack     = maybe (0, 0) parseTrack $ lookup "Track" xs,
 766            sgDisc      = maybe (0, 0) parseTrack $ lookup "Disc" xs,
 767            sgFilePath  = takeString "file" xs,
 768            sgLength    = takeNum "Time" xs,
 769            sgIndex     = takeIndex ID "Id" xs }
 770     where parseTrack x = let (trck, tot) = break (== '/') x
 771                          in (read trck, parseNum (drop 1 tot))
 772
 773 -- Helpers for retrieving values from an assoc. list.
 774
 775 takeNum :: (Read a, Integral a) => String -> [(String, String)] -> a
 776 takeNum v = maybe 0 parseNum . lookup v
 777
 778 takeBool :: String -> [(String, String)] -> Bool
 779 takeBool v = maybe False parseBool . lookup v
 780
 781 takeString :: String -> [(String, String)] -> String
 782 takeString v = fromMaybe "" . lookup v
 783
 784 takeIndex :: (Integer -> PLIndex) -> String -> [(String, String)]
 785           -> Maybe PLIndex
 786 takeIndex c v = fmap (c . parseNum) . lookup v