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