Network/MPD/Commands.hs

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