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