Network/MPD/Commands.hs

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