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