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 (foldM, 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) <- takeEntries =<< getResponse (cmd ++ " " ++ show path)
 271     return (map Left dirs ++ map Right songs)
 272
 273 -- | Search the database for entries exactly matching a query.
 274 find :: Query -> MPD [Song]
 275 find query = getResponse ("find " ++ show query) >>= takeSongs
 276
 277 -- | Search the database using case insensitive matching.
 278 search :: Query -> MPD [Song]
 279 search query = getResponse ("search " ++ show query) >>= takeSongs
 280
 281 -- | Count the number of entries matching a query.
 282 count :: Query -> MPD Count
 283 count query = liftM (takeCountInfo . toAssoc)
 284                     (getResponse ("count " ++ show query))
 285     where takeCountInfo xs = Count { cSongs    = takeNum "songs" xs,
 286                                      cPlaytime = takeNum "playtime" xs }
 287
 288 --
 289 -- Playlist commands
 290 --
 291 -- $playlist
 292 -- Unless otherwise noted all playlist commands operate on the current
 293 -- playlist.
 294
 295 -- This might do better to throw an exception than silently return 0.
 296 -- | Like 'add', but returns a playlist id.
 297 addId :: Path -> MPD Integer
 298 addId = liftM (takeNum "Id" . toAssoc) . getResponse . ("addid " ++) . show
 299
 300 -- | Like 'add_' but returns a list of the files added.
 301 add :: PlaylistName -> Path -> MPD [Path]
 302 add plname x = add_ plname x >> listAll x
 303
 304 -- | Add a song (or a whole directory) to a playlist.
 305 -- Adds to current if no playlist is specified.
 306 -- Will create a new playlist if the one specified does not already exist.
 307 add_ :: PlaylistName -> Path -> MPD ()
 308 add_ ""     = getResponse_ . ("add " ++) . show
 309 add_ plname = getResponse_ .
 310     (("playlistadd " ++ show plname ++ " ") ++) . show
 311
 312 -- | Clear a playlist. Clears current playlist if no playlist is specified.
 313 -- If the specified playlist does not exist, it will be created.
 314 clear :: PlaylistName -> MPD ()
 315 clear = getResponse_ . cmd
 316     where cmd "" = "clear"
 317           cmd pl = "playlistclear " ++ show pl
 318
 319 -- | Remove a song from a playlist.
 320 -- If no playlist is specified, current playlist is used.
 321 -- Note that a playlist position ('Pos') is required when operating on
 322 -- playlists other than the current.
 323 delete :: PlaylistName -> PLIndex -> MPD ()
 324 delete "" (Pos x) = getResponse_ ("delete " ++ show x)
 325 delete "" (ID x)  = getResponse_ ("deleteid " ++ show x)
 326 delete plname (Pos x) =
 327     getResponse_ ("playlistdelete " ++ show plname ++ " " ++ show x)
 328 delete _ _ = fail "'delete' within a playlist doesn't accept a playlist ID"
 329
 330 -- | Load an existing playlist.
 331 load :: PlaylistName -> MPD ()
 332 load = getResponse_ . ("load " ++) . show
 333
 334 -- | Move a song to a given position.
 335 -- Note that a playlist position ('Pos') is required when operating on
 336 -- playlists other than the current.
 337 move :: PlaylistName -> PLIndex -> Integer -> MPD ()
 338 move "" (Pos from) to =
 339     getResponse_ ("move " ++ show from ++ " " ++ show to)
 340 move "" (ID from) to =
 341     getResponse_ ("moveid " ++ show from ++ " " ++ show to)
 342 move plname (Pos from) to =
 343     getResponse_ ("playlistmove " ++ show plname ++ " " ++ show from ++
 344                        " " ++ show to)
 345 move _ _ _ = fail "'move' within a playlist doesn't accept a playlist ID"
 346
 347 -- | Delete existing playlist.
 348 rm :: PlaylistName -> MPD ()
 349 rm = getResponse_ . ("rm " ++) . show
 350
 351 -- | Rename an existing playlist.
 352 rename :: PlaylistName -- ^ Original playlist
 353        -> PlaylistName -- ^ New playlist name
 354        -> MPD ()
 355 rename plname new =
 356     getResponse_ ("rename " ++ show plname ++ " " ++ show new)
 357
 358 -- | Save the current playlist.
 359 save :: PlaylistName -> MPD ()
 360 save = getResponse_ . ("save " ++) . show
 361
 362 -- | Swap the positions of two songs.
 363 -- Note that the positions must be of the same type, i.e. mixing 'Pos' and 'ID'
 364 -- will result in a no-op.
 365 swap :: PLIndex -> PLIndex -> MPD ()
 366 swap (Pos x) (Pos y) = getResponse_ ("swap "   ++ show x ++ " " ++ show y)
 367 swap (ID x)  (ID y)  = getResponse_ ("swapid " ++ show x ++ " " ++ show y)
 368 swap _ _ = fail "'swap' cannot mix position and ID arguments"
 369
 370 -- | Shuffle the playlist.
 371 shuffle :: MPD ()
 372 shuffle = getResponse_ "shuffle"
 373
 374 -- | Retrieve metadata for songs in the current playlist.
 375 playlistInfo :: Maybe PLIndex -> MPD [Song]
 376 playlistInfo x = getResponse cmd >>= takeSongs
 377     where cmd = case x of
 378                     Just (Pos x') -> "playlistinfo " ++ show x'
 379                     Just (ID x')  -> "playlistid " ++ show x'
 380                     Nothing       -> "playlistinfo"
 381
 382 -- | Retrieve metadata for files in a given playlist.
 383 listPlaylistInfo :: PlaylistName -> MPD [Song]
 384 listPlaylistInfo plname =
 385     takeSongs =<< (getResponse . ("listplaylistinfo " ++) $ show plname)
 386
 387 -- | Retrieve a list of files in a given playlist.
 388 listPlaylist :: PlaylistName -> MPD [Path]
 389 listPlaylist = liftM takeValues . getResponse . ("listplaylist " ++) . show
 390
 391 -- | Retrieve file paths and positions of songs in the current playlist.
 392 -- Note that this command is only included for completeness sake; it's
 393 -- deprecated and likely to disappear at any time, please use 'playlistInfo'
 394 -- instead.
 395 playlist :: MPD [(PLIndex, Path)]
 396 playlist = liftM (map f) (getResponse "playlist")
 397     where f s = let (pos, name) = break (== ':') s
 398                 in (Pos $ read pos, drop 1 name)
 399
 400 -- | Retrieve a list of changed songs currently in the playlist since
 401 -- a given playlist version.
 402 plChanges :: Integer -> MPD [Song]
 403 plChanges version =
 404     takeSongs =<< (getResponse . ("plchanges " ++) $ show version)
 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 q = takeSongs =<< (getResponse . ("playlistfind " ++) $ show q)
 416
 417 -- | Search case-insensitively with partial matches for songs in the
 418 -- current playlist.
 419 playlistSearch :: Query -> MPD [Song]
 420 playlistSearch q =
 421     takeSongs =<< (getResponse . ("playlistsearch " ++) $ show q)
 422
 423 -- | Get the currently playing song.
 424 currentSong :: MPD (Maybe Song)
 425 currentSong = do
 426     currStatus <- status
 427     if stState currStatus == Stopped
 428         then return Nothing
 429         else do ls <- liftM toAssoc (getResponse "currentsong")
 430                 if null ls then return Nothing
 431                            else liftM Just (takeSongInfo ls)
 432
 433 --
 434 -- Playback commands
 435 --
 436
 437 -- | Set crossfading between songs.
 438 crossfade :: Seconds -> MPD ()
 439 crossfade = getResponse_ . ("crossfade " ++) . show
 440
 441 -- | Begin\/continue playing.
 442 play :: Maybe PLIndex -> MPD ()
 443 play Nothing        = getResponse_ "play"
 444 play (Just (Pos x)) = getResponse_ ("play " ++ show x)
 445 play (Just (ID x))  = getResponse_ ("playid " ++ show x)
 446
 447 -- | Pause playing.
 448 pause :: Bool -> MPD ()
 449 pause = getResponse_ . ("pause " ++) . showBool
 450
 451 -- | Stop playing.
 452 stop :: MPD ()
 453 stop = getResponse_ "stop"
 454
 455 -- | Play the next song.
 456 next :: MPD ()
 457 next = getResponse_ "next"
 458
 459 -- | Play the previous song.
 460 previous :: MPD ()
 461 previous = getResponse_ "previous"
 462
 463 -- | Seek to some point in a song.
 464 -- Seeks in current song if no position is given.
 465 seek :: Maybe PLIndex -> Seconds -> MPD ()
 466 seek (Just (Pos x)) time =
 467     getResponse_ ("seek " ++ show x ++ " " ++ show time)
 468 seek (Just (ID x)) time =
 469     getResponse_ ("seekid " ++ show x ++ " " ++ show time)
 470 seek Nothing time = do
 471     st <- status
 472     unless (stState st == Stopped) (seek (stSongID st) time)
 473
 474 -- | Set random playing.
 475 random :: Bool -> MPD ()
 476 random = getResponse_ . ("random " ++) . showBool
 477
 478 -- | Set repeating.
 479 repeat :: Bool -> MPD ()
 480 repeat = getResponse_ . ("repeat " ++) . showBool
 481
 482 -- | Set the volume (0-100 percent).
 483 setVolume :: Int -> MPD ()
 484 setVolume = getResponse_ . ("setvol " ++) . show
 485
 486 -- | Increase or decrease volume by a given percent, e.g.
 487 -- 'volume 10' will increase the volume by 10 percent, while
 488 -- 'volume (-10)' will decrease it by the same amount.
 489 -- Note that this command is only included for completeness sake ; it's
 490 -- deprecated and may disappear at any time, please use 'setVolume' instead.
 491 volume :: Int -> MPD ()
 492 volume = getResponse_ . ("volume " ++) . show
 493
 494 --
 495 -- Miscellaneous commands
 496 --
 497
 498 -- | Clear the current error message in status.
 499 clearError :: MPD ()
 500 clearError = getResponse_ "clearerror"
 501
 502 -- | Retrieve a list of available commands.
 503 commands :: MPD [String]
 504 commands = liftM takeValues (getResponse "commands")
 505
 506 -- | Retrieve a list of unavailable (due to access restrictions) commands.
 507 notCommands :: MPD [String]
 508 notCommands = liftM takeValues (getResponse "notcommands")
 509
 510 -- | Retrieve a list of available song metadata.
 511 tagTypes :: MPD [String]
 512 tagTypes = liftM takeValues (getResponse "tagtypes")
 513
 514 -- | Retrieve a list of supported urlhandlers.
 515 urlHandlers :: MPD [String]
 516 urlHandlers = liftM takeValues (getResponse "urlhandlers")
 517
 518 -- XXX should the password be quoted?
 519 -- | Send password to server to authenticate session.
 520 -- Password is sent as plain text.
 521 password :: String -> MPD ()
 522 password = getResponse_ . ("password " ++)
 523
 524 -- | Check that the server is still responding.
 525 ping :: MPD ()
 526 ping = getResponse_ "ping"
 527
 528 -- | Get server statistics.
 529 stats :: MPD Stats
 530 stats = liftM (parseStats . toAssoc) (getResponse "stats")
 531     where parseStats xs =
 532                 Stats { stsArtists = takeNum "artists" xs,
 533                         stsAlbums = takeNum "albums" xs,
 534                         stsSongs = takeNum "songs" xs,
 535                         stsUptime = takeNum "uptime" xs,
 536                         stsPlaytime = takeNum "playtime" xs,
 537                         stsDbPlaytime = takeNum "db_playtime" xs,
 538                         stsDbUpdate = takeNum "db_update" xs }
 539
 540 -- | Get the server's status.
 541 status :: MPD Status
 542 status = liftM (parseStatus . toAssoc) (getResponse "status")
 543     where parseStatus xs =
 544               Status { stState = maybe Stopped parseState $ lookup "state" xs,
 545                        stVolume = takeNum "volume" xs,
 546                        stRepeat = takeBool "repeat" xs,
 547                        stRandom = takeBool "random" xs,
 548                        stPlaylistVersion = takeNum "playlist" xs,
 549                        stPlaylistLength = takeNum "playlistlength" xs,
 550                        stXFadeWidth = takeNum "xfade" xs,
 551                        stSongPos = takeIndex Pos "song" xs,
 552                        stSongID = takeIndex ID "songid" xs,
 553                        stTime = maybe (0,0) parseTime $ lookup "time" xs,
 554                        stBitrate = takeNum "bitrate" xs,
 555                        stAudio = maybe (0,0,0) parseAudio $ lookup "audio" xs,
 556                        stUpdatingDb = takeNum "updating_db" xs,
 557                        stError = takeString "error" xs }
 558           parseState x = case x of "play"  -> Playing
 559                                    "pause" -> Paused
 560                                    _       -> Stopped
 561           parseTime  x = let (y,_:z) = break (== ':') x in (read y, read z)
 562           parseAudio x =
 563               let (u,_:u') = break (== ':') x; (v,_:w) = break (== ':') u' in
 564                   (read u, read v, read w)
 565
 566 --
 567 -- Extensions\/shortcuts.
 568 --
 569
 570 -- | Like 'update', but returns the update job id.
 571 updateId :: [Path] -> MPD Integer
 572 updateId paths = liftM (read . head . takeValues) cmd
 573   where cmd = case paths of
 574                 []  -> getResponse "update"
 575                 [x] -> getResponse ("update " ++ x)
 576                 xs  -> getResponses (map ("update " ++) xs)
 577
 578 -- | Toggles play\/pause. Plays if stopped.
 579 toggle :: MPD ()
 580 toggle = status >>= \st -> case stState st of Playing -> pause True
 581                                               _       -> play Nothing
 582
 583 -- | Add a list of songs\/folders to a playlist.
 584 -- Should be more efficient than running 'add' many times.
 585 addMany :: PlaylistName -> [Path] -> MPD ()
 586 addMany _ [] = return ()
 587 addMany plname [x] = add_ plname x
 588 addMany plname xs = getResponses (map ((cmd ++) . show) xs) >> return ()
 589     where cmd = case plname of "" -> "add "
 590                                pl -> "playlistadd " ++ show pl ++ " "
 591
 592 -- | Delete a list of songs from a playlist.
 593 -- If there is a duplicate then no further songs will be deleted, so
 594 -- take care to avoid them (see 'prune' for this).
 595 deleteMany :: PlaylistName -> [PLIndex] -> MPD ()
 596 deleteMany _ [] = return ()
 597 deleteMany plname [x] = delete plname x
 598 deleteMany "" xs = getResponses (map cmd xs) >> return ()
 599     where cmd (Pos x) = "delete " ++ show x
 600           cmd (ID x)  = "deleteid " ++ show x
 601 deleteMany plname xs = getResponses (map cmd xs) >> return ()
 602     where cmd (Pos x) = "playlistdelete " ++ show plname ++ " " ++ show x
 603           cmd _       = ""
 604
 605 -- | Returns all songs and directories that match the given partial
 606 -- path name.
 607 complete :: String -> MPD [Either Path Song]
 608 complete path = do
 609     xs <- liftM matches . lsInfo $ dropFileName path
 610     case xs of
 611         [Left dir] -> complete $ dir ++ "/"
 612         _          -> return xs
 613     where
 614         matches = filter (isPrefixOf path . takePath)
 615         takePath = either id sgFilePath
 616
 617 -- | Crop playlist.
 618 -- The bounds are inclusive.
 619 -- If 'Nothing' or 'ID' is passed the cropping will leave your playlist alone
 620 -- on that side.
 621 crop :: Maybe PLIndex -> Maybe PLIndex -> MPD ()
 622 crop x y = do
 623     pl <- playlistInfo Nothing
 624     let x' = case x of Just (Pos p) -> fromInteger p
 625                        Just (ID i)  -> maybe 0 id (findByID i pl)
 626                        Nothing      -> 0
 627         -- ensure that no songs are deleted twice with 'max'.
 628         ys = case y of Just (Pos p) -> drop (max (fromInteger p) x') pl
 629                        Just (ID i)  -> maybe [] (flip drop pl . max x' . (+1))
 630                                       (findByID i pl)
 631                        Nothing      -> []
 632     deleteMany "" . mapMaybe sgIndex $ take x' pl ++ ys
 633     where findByID i = findIndex ((==) i . (\(ID j) -> j) . fromJust . sgIndex)
 634
 635 -- | Remove duplicate playlist entries.
 636 prune :: MPD ()
 637 prune = findDuplicates >>= deleteMany ""
 638
 639 -- Find duplicate playlist entries.
 640 findDuplicates :: MPD [PLIndex]
 641 findDuplicates =
 642     liftM (map ((\(ID x) -> ID x) . fromJust . sgIndex) . flip dups ([],[])) $
 643         playlistInfo Nothing
 644     where dups [] (_, dup) = dup
 645           dups (x:xs) (ys, dup)
 646               | x `elem` xs && x `notElem` ys = dups xs (ys, x:dup)
 647               | otherwise                     = dups xs (x:ys, dup)
 648
 649 -- | List directories non-recursively.
 650 lsDirs :: Path -> MPD [Path]
 651 lsDirs path = liftM (\(x,_,_) -> x) $
 652               takeEntries =<< getResponse ("lsinfo " ++ show path)
 653
 654 -- | List files non-recursively.
 655 lsFiles :: Path -> MPD [Path]
 656 lsFiles path = liftM (map sgFilePath . (\(_,_,x) -> x)) $
 657                takeEntries =<< getResponse ("lsinfo " ++ show path)
 658
 659 -- | List all playlists.
 660 lsPlaylists :: MPD [PlaylistName]
 661 lsPlaylists = liftM (\(_,x,_) -> x) $ takeEntries =<< getResponse "lsinfo"
 662
 663 -- | Search the database for songs relating to an artist.
 664 findArtist :: Artist -> MPD [Song]
 665 findArtist = find . Query Artist
 666
 667 -- | Search the database for songs relating to an album.
 668 findAlbum :: Album -> MPD [Song]
 669 findAlbum = find . Query Album
 670
 671 -- | Search the database for songs relating to a song title.
 672 findTitle :: Title -> MPD [Song]
 673 findTitle = find . Query Title
 674
 675 -- | List the artists in the database.
 676 listArtists :: MPD [Artist]
 677 listArtists = liftM takeValues (getResponse "list artist")
 678
 679 -- | List the albums in the database, optionally matching a given
 680 -- artist.
 681 listAlbums :: Maybe Artist -> MPD [Album]
 682 listAlbums artist = liftM takeValues (getResponse ("list album" ++
 683     maybe "" ((" artist " ++) . show) artist))
 684
 685 -- | List the songs in an album of some artist.
 686 listAlbum :: Artist -> Album -> MPD [Song]
 687 listAlbum artist album = find (MultiQuery [Query Artist artist
 688                                           ,Query Album album])
 689
 690 -- | Search the database for songs relating to an artist using 'search'.
 691 searchArtist :: Artist -> MPD [Song]
 692 searchArtist = search . Query Artist
 693
 694 -- | Search the database for songs relating to an album using 'search'.
 695 searchAlbum :: Album -> MPD [Song]
 696 searchAlbum = search . Query Album
 697
 698 -- | Search the database for songs relating to a song title.
 699 searchTitle :: Title -> MPD [Song]
 700 searchTitle = search . Query Title
 701
 702 -- | Retrieve the current playlist.
 703 -- Equivalent to @playlistinfo Nothing@.
 704 getPlaylist :: MPD [Song]
 705 getPlaylist = playlistInfo Nothing
 706
 707 --
 708 -- Miscellaneous functions.
 709 --
 710
 711 -- Run getResponse but discard the response.
 712 getResponse_ :: String -> MPD ()
 713 getResponse_ x = getResponse x >> return ()
 714
 715 -- Get the lines of the daemon's response to a list of commands.
 716 getResponses :: [String] -> MPD [String]
 717 getResponses cmds = getResponse . concat $ intersperse "\n" cmds'
 718     where cmds' = "command_list_begin" : cmds ++ ["command_list_end"]
 719
 720 -- Helper that throws unexpected error if input is empty.
 721 failOnEmpty :: [String] -> MPD [String]
 722 failOnEmpty [] = throwError $ Unexpected "Non-empty response expected."
 723 failOnEmpty xs = return xs
 724
 725 -- A wrapper for getResponse that fails on non-empty responses.
 726 getResponse1 :: String -> MPD [String]
 727 getResponse1 x = getResponse x >>= failOnEmpty
 728
 729 -- getResponse1 for multiple commands.
 730 getResponses1 :: [String] -> MPD [String]
 731 getResponses1 cmds = getResponses cmds >>= failOnEmpty
 732
 733 --
 734 -- Parsing.
 735 --
 736
 737 -- Run 'toAssoc' and return only the values.
 738 takeValues :: [String] -> [String]
 739 takeValues = snd . unzip . toAssoc
 740
 741 -- Separate the result of an lsinfo\/listallinfo call into directories,
 742 -- playlists, and songs.
 743 takeEntries :: [String] -> MPD ([String], [String], [Song])
 744 takeEntries s = do
 745     ss <- mapM takeSongInfo . splitGroups $ reverse filedata
 746     return (dirs, playlists, ss)
 747     where (dirs, playlists, filedata) = foldl split ([], [], []) $ toAssoc s
 748           split (ds, pls, ss) x@(k, v) | k == "directory" = (v:ds, pls, ss)
 749                                        | k == "playlist"  = (ds, v:pls, ss)
 750                                        | otherwise        = (ds, pls, x:ss)
 751
 752 -- Build a list of song instances from a response.
 753 takeSongs :: [String] -> MPD [Song]
 754 takeSongs = mapM takeSongInfo . splitGroups . toAssoc
 755
 756 -- Builds a song instance from an assoc. list.
 757 takeSongInfo :: [(String, String)] -> MPD Song
 758 takeSongInfo xs = foldM f song xs
 759     where f a ("Artist", x)    = return a { sgArtist = x }
 760           f a ("Album", x)     = return a { sgAlbum  = x }
 761           f a ("Title", x)     = return a { sgTitle = x }
 762           f a ("Genre", x)     = return a { sgGenre = x }
 763           f a ("Name", x)      = return a { sgName = x }
 764           f a ("Composer", x)  = return a { sgComposer = x }
 765           f a ("Performer", x) = return a { sgPerformer = x }
 766           f a ("Date", x)      = parse parseNum (\x' -> a { sgDate = x'}) x
 767           f a ("Track", x)     = parse parseTuple (\x' -> a { sgTrack = x'}) x
 768           f a ("Disc", x)      = parse parseTuple (\x' -> a { sgDisc = x'}) x
 769           f a ("file", x)      = return a { sgFilePath = x }
 770           f a ("Time", x)      = parse parseNum (\x' -> a { sgLength = x'}) x
 771           f a ("Id", x)        = parse parseNum
 772                                  (\x' -> a { sgIndex = Just (ID x') }) x
 773           -- We prefer Id.
 774           f a ("Pos", _)       = return a
 775           -- Catch unrecognised keys
 776           f _ x                = throwError (Unexpected (show x))
 777
 778           parseTuple s = let (x, y)     = break (== '/') s in
 779                          case (parseNum x, parseNum $ drop 1 y) of
 780                              (Just x', Just y') -> Just (x', y')
 781                              _                  -> Nothing
 782
 783           song = Song { sgArtist = "", sgAlbum = "", sgTitle = ""
 784                       , sgGenre = "", sgName = "", sgComposer = ""
 785                       , sgPerformer = "", sgDate = 0, sgTrack = (0,0)
 786                       , sgDisc = (0,0), sgFilePath = "", sgLength = 0
 787                       , sgIndex = Nothing }
 788
 789 -- A helper that runs a parser on a string and, depending, on the outcome,
 790 -- either returns the result of some command applied to the result, or throws
 791 -- an Unexpected error. Used when building structures.
 792 parse :: (String -> Maybe a) -> (a -> b) -> String -> MPD b
 793 parse p g x = maybe (throwError $ Unexpected x) (return . g) (p x)
 794
 795 -- Helpers for retrieving values from an assoc. list.
 796
 797 takeNum :: (Read a, Integral a) => String -> [(String, String)] -> a
 798 takeNum v = maybe 0 (fromMaybe 0 . parseNum) . lookup v
 799
 800 takeBool :: String -> [(String, String)] -> Bool
 801 takeBool v = maybe False parseBool . lookup v
 802
 803 takeString :: String -> [(String, String)] -> String
 804 takeString v = fromMaybe "" . lookup v
 805
 806 takeIndex :: (Integer -> PLIndex) -> String -> [(String, String)]
 807           -> Maybe PLIndex
 808 takeIndex c v = fmap (c . fromMaybe 0 . parseNum) . lookup v