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 import Network.MPD.Parse
  68
  69 import Control.Monad (foldM, liftM, unless)
  70 import Control.Monad.Error (throwError)
  71 import Prelude hiding (repeat)
  72 import Data.List (findIndex, intercalate, isPrefixOf)
  73 import Data.Maybe
  74 import System.FilePath (dropFileName)
  75
  76 --
  77 -- Data types
  78 --
  79
  80 type Artist       = String
  81 type Album        = String
  82 type Title        = String
  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 (Eq, 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 an output device.
 187 data Device =
 188     Device { dOutputID      :: Int    -- ^ Output's ID number
 189            , dOutputName    :: String -- ^ Output's name as defined in the MPD
 190                                       --   configuration file
 191            , dOutputEnabled :: Bool }
 192     deriving (Eq, Show)
 193
 194 --
 195 -- Admin commands
 196 --
 197
 198 -- | Turn off an output device.
 199 disableOutput :: Int -> MPD ()
 200 disableOutput = getResponse_ . ("disableoutput " ++) . show
 201
 202 -- | Turn on an output device.
 203 enableOutput :: Int -> MPD ()
 204 enableOutput = getResponse_ . ("enableoutput " ++) . show
 205
 206 -- | Retrieve information for all output devices.
 207 outputs :: MPD [Device]
 208 outputs = getResponse "outputs" >>=
 209            mapM (foldM f empty) . splitGroups [("outputid",id)] . toAssoc
 210     where f a ("outputid", x)      = parse parseNum (\x' -> a { dOutputID = x' }) x
 211           f a ("outputname", x)    = return a { dOutputName = x }
 212           f a ("outputenabled", x) = parse parseBool
 213                                      (\x' -> a { dOutputEnabled = x'}) x
 214           f _ x                    = throwError . Unexpected $ show x
 215
 216           empty = Device 0 "" False
 217
 218 -- | Update the server's database.
 219 -- If no paths are given, all paths will be scanned.
 220 -- Unreadable or non-existent paths are silently ignored.
 221 update :: [Path] -> MPD ()
 222 update  [] = getResponse_ "update"
 223 update [x] = getResponse_ ("update " ++ show x)
 224 update  xs = getResponses (map (("update " ++) . show) xs) >> return ()
 225
 226 --
 227 -- Database commands
 228 --
 229
 230 -- | List all metadata of metadata (sic).
 231 list :: Meta -- ^ Metadata to list
 232      -> Maybe Query -> MPD [String]
 233 list mtype query = liftM takeValues (getResponse cmd)
 234     where cmd = "list " ++ show mtype ++ maybe "" ((" "++) . show) query
 235
 236 -- | Non-recursively list the contents of a database directory.
 237 lsInfo :: Path -> MPD [Either Path Song]
 238 lsInfo = lsInfo' "lsinfo"
 239
 240 -- | List the songs (without metadata) in a database directory recursively.
 241 listAll :: Path -> MPD [Path]
 242 listAll path = liftM (map snd . filter ((== "file") . fst) . toAssoc)
 243                      (getResponse ("listall " ++ show path))
 244
 245 -- | Recursive 'lsInfo'.
 246 listAllInfo :: Path -> MPD [Either Path Song]
 247 listAllInfo = lsInfo' "listallinfo"
 248
 249 -- Helper for lsInfo and listAllInfo.
 250 lsInfo' :: String -> Path -> MPD [Either Path Song]
 251 lsInfo' cmd path = do
 252     liftM (extractEntries (Just . Right, const Nothing, Just . Left)) $
 253          takeEntries =<< getResponse (cmd ++ " " ++ show path)
 254
 255 -- | Search the database for entries exactly matching a query.
 256 find :: Query -> MPD [Song]
 257 find query = getResponse ("find " ++ show query) >>= takeSongs
 258
 259 -- | Search the database using case insensitive matching.
 260 search :: Query -> MPD [Song]
 261 search query = getResponse ("search " ++ show query) >>= takeSongs
 262
 263 -- | Count the number of entries matching a query.
 264 count :: Query -> MPD Count
 265 count query = getResponse ("count " ++ show query) >>= psrProc parseCount
 266     where psrProc f = either (throwError . Unexpected) return . f
 267
 268 --
 269 -- Playlist commands
 270 --
 271 -- $playlist
 272 -- Unless otherwise noted all playlist commands operate on the current
 273 -- playlist.
 274
 275 -- This might do better to throw an exception than silently return 0.
 276 -- | Like 'add', but returns a playlist id.
 277 addId :: Path -> MPD Integer
 278 addId p = getResponse1 ("addid " ++ show p) >>=
 279           parse parseNum id . snd . head . toAssoc
 280
 281 -- | Like 'add_' but returns a list of the files added.
 282 add :: PlaylistName -> Path -> MPD [Path]
 283 add plname x = add_ plname x >> listAll 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_ :: PlaylistName -> Path -> MPD ()
 289 add_ ""     = getResponse_ . ("add " ++) . show
 290 add_ plname = getResponse_ .
 291     (("playlistadd " ++ show plname ++ " ") ++) . show
 292
 293 -- | Clear a playlist. Clears current playlist if no playlist is specified.
 294 -- If the specified playlist does not exist, it will be created.
 295 clear :: PlaylistName -> MPD ()
 296 clear = getResponse_ . cmd
 297     where cmd "" = "clear"
 298           cmd pl = "playlistclear " ++ show pl
 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 :: PlaylistName -> PLIndex -> MPD ()
 305 delete "" (Pos x) = getResponse_ ("delete " ++ show x)
 306 delete "" (ID x)  = getResponse_ ("deleteid " ++ show x)
 307 delete plname (Pos x) =
 308     getResponse_ ("playlistdelete " ++ show plname ++ " " ++ show x)
 309 delete _ _ = fail "'delete' within a playlist doesn't accept a playlist ID"
 310
 311 -- | Load an existing playlist.
 312 load :: PlaylistName -> MPD ()
 313 load = getResponse_ . ("load " ++) . show
 314
 315 -- | Move a song to a given position.
 316 -- Note that a playlist position ('Pos') is required when operating on
 317 -- playlists other than the current.
 318 move :: PlaylistName -> PLIndex -> Integer -> MPD ()
 319 move "" (Pos from) to =
 320     getResponse_ ("move " ++ show from ++ " " ++ show to)
 321 move "" (ID from) to =
 322     getResponse_ ("moveid " ++ show from ++ " " ++ show to)
 323 move plname (Pos from) to =
 324     getResponse_ ("playlistmove " ++ show plname ++ " " ++ show from ++
 325                        " " ++ show to)
 326 move _ _ _ = fail "'move' within a playlist doesn't accept a playlist ID"
 327
 328 -- | Delete existing playlist.
 329 rm :: PlaylistName -> MPD ()
 330 rm = getResponse_ . ("rm " ++) . show
 331
 332 -- | Rename an existing playlist.
 333 rename :: PlaylistName -- ^ Original playlist
 334        -> PlaylistName -- ^ New playlist name
 335        -> MPD ()
 336 rename plname new =
 337     getResponse_ ("rename " ++ show plname ++ " " ++ show new)
 338
 339 -- | Save the current playlist.
 340 save :: PlaylistName -> MPD ()
 341 save = getResponse_ . ("save " ++) . show
 342
 343 -- | Swap the positions of two songs.
 344 -- Note that the positions must be of the same type, i.e. mixing 'Pos' and 'ID'
 345 -- will result in a no-op.
 346 swap :: PLIndex -> PLIndex -> MPD ()
 347 swap (Pos x) (Pos y) = getResponse_ ("swap "   ++ show x ++ " " ++ show y)
 348 swap (ID x)  (ID y)  = getResponse_ ("swapid " ++ show x ++ " " ++ show y)
 349 swap _ _ = fail "'swap' cannot mix position and ID arguments"
 350
 351 -- | Shuffle the playlist.
 352 shuffle :: MPD ()
 353 shuffle = getResponse_ "shuffle"
 354
 355 -- | Retrieve metadata for songs in the current playlist.
 356 playlistInfo :: Maybe PLIndex -> MPD [Song]
 357 playlistInfo x = getResponse cmd >>= takeSongs
 358     where cmd = case x of
 359                     Just (Pos x') -> "playlistinfo " ++ show x'
 360                     Just (ID x')  -> "playlistid " ++ show x'
 361                     Nothing       -> "playlistinfo"
 362
 363 -- | Retrieve metadata for files in a given playlist.
 364 listPlaylistInfo :: PlaylistName -> MPD [Song]
 365 listPlaylistInfo plname =
 366     takeSongs =<< (getResponse . ("listplaylistinfo " ++) $ show plname)
 367
 368 -- | Retrieve a list of files in a given playlist.
 369 listPlaylist :: PlaylistName -> MPD [Path]
 370 listPlaylist = liftM takeValues . getResponse . ("listplaylist " ++) . show
 371
 372 -- | Retrieve file paths and positions of songs in the current playlist.
 373 -- Note that this command is only included for completeness sake; it's
 374 -- deprecated and likely to disappear at any time, please use 'playlistInfo'
 375 -- instead.
 376 playlist :: MPD [(PLIndex, Path)]
 377 playlist = mapM f =<< getResponse "playlist"
 378     where f s | (pos, name) <- breakChar ':' s
 379               , Just pos'   <- parseNum pos
 380               = return (Pos pos', name)
 381               | otherwise = throwError . Unexpected $ show s
 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 version =
 387     takeSongs =<< (getResponse . ("plchanges " ++) $ show version)
 388
 389 -- | Like 'plChanges' but only returns positions and ids.
 390 plChangesPosId :: Integer -> MPD [(PLIndex, PLIndex)]
 391 plChangesPosId plver =
 392     getResponse ("plchangesposid " ++ show plver) >>=
 393     mapM f . splitGroups [("cpos",id)] . toAssoc
 394     where f xs | [("cpos", x), ("Id", y)] <- xs
 395                , Just (x', y') <- pair parseNum (x, y)
 396                = return (Pos x', ID y')
 397                | otherwise = throwError . Unexpected $ show xs
 398
 399 -- | Search for songs in the current playlist with strict matching.
 400 playlistFind :: Query -> MPD [Song]
 401 playlistFind q = takeSongs =<< (getResponse . ("playlistfind " ++) $ show q)
 402
 403 -- | Search case-insensitively with partial matches for songs in the
 404 -- current playlist.
 405 playlistSearch :: Query -> MPD [Song]
 406 playlistSearch q =
 407     takeSongs =<< (getResponse . ("playlistsearch " ++) $ show q)
 408
 409 -- | Get the currently playing song.
 410 currentSong :: MPD (Maybe Song)
 411 currentSong = do
 412     cs <- status
 413     if stState cs == Stopped
 414        then return Nothing
 415        else getResponse1 "currentsong" >>= fmap Just . takeSongInfo . toAssoc
 416
 417 --
 418 -- Playback commands
 419 --
 420
 421 -- | Set crossfading between songs.
 422 crossfade :: Seconds -> MPD ()
 423 crossfade = getResponse_ . ("crossfade " ++) . show
 424
 425 -- | Begin\/continue playing.
 426 play :: Maybe PLIndex -> MPD ()
 427 play Nothing        = getResponse_ "play"
 428 play (Just (Pos x)) = getResponse_ ("play " ++ show x)
 429 play (Just (ID x))  = getResponse_ ("playid " ++ show x)
 430
 431 -- | Pause playing.
 432 pause :: Bool -> MPD ()
 433 pause = getResponse_ . ("pause " ++) . showBool
 434
 435 -- | Stop playing.
 436 stop :: MPD ()
 437 stop = getResponse_ "stop"
 438
 439 -- | Play the next song.
 440 next :: MPD ()
 441 next = getResponse_ "next"
 442
 443 -- | Play the previous song.
 444 previous :: MPD ()
 445 previous = getResponse_ "previous"
 446
 447 -- | Seek to some point in a song.
 448 -- Seeks in current song if no position is given.
 449 seek :: Maybe PLIndex -> Seconds -> MPD ()
 450 seek (Just (Pos x)) time =
 451     getResponse_ ("seek " ++ show x ++ " " ++ show time)
 452 seek (Just (ID x)) time =
 453     getResponse_ ("seekid " ++ show x ++ " " ++ show time)
 454 seek Nothing time = do
 455     st <- status
 456     unless (stState st == Stopped) (seek (stSongID st) time)
 457
 458 -- | Set random playing.
 459 random :: Bool -> MPD ()
 460 random = getResponse_ . ("random " ++) . showBool
 461
 462 -- | Set repeating.
 463 repeat :: Bool -> MPD ()
 464 repeat = getResponse_ . ("repeat " ++) . showBool
 465
 466 -- | Set the volume (0-100 percent).
 467 setVolume :: Int -> MPD ()
 468 setVolume = getResponse_ . ("setvol " ++) . show
 469
 470 -- | Increase or decrease volume by a given percent, e.g.
 471 -- 'volume 10' will increase the volume by 10 percent, while
 472 -- 'volume (-10)' will decrease it by the same amount.
 473 -- Note that this command is only included for completeness sake ; it's
 474 -- deprecated and may disappear at any time, please use 'setVolume' instead.
 475 volume :: Int -> MPD ()
 476 volume = getResponse_ . ("volume " ++) . show
 477
 478 --
 479 -- Miscellaneous commands
 480 --
 481
 482 -- | Clear the current error message in status.
 483 clearError :: MPD ()
 484 clearError = getResponse_ "clearerror"
 485
 486 -- | Retrieve a list of available commands.
 487 commands :: MPD [String]
 488 commands = liftM takeValues (getResponse "commands")
 489
 490 -- | Retrieve a list of unavailable (due to access restrictions) commands.
 491 notCommands :: MPD [String]
 492 notCommands = liftM takeValues (getResponse "notcommands")
 493
 494 -- | Retrieve a list of available song metadata.
 495 tagTypes :: MPD [String]
 496 tagTypes = liftM takeValues (getResponse "tagtypes")
 497
 498 -- | Retrieve a list of supported urlhandlers.
 499 urlHandlers :: MPD [String]
 500 urlHandlers = liftM takeValues (getResponse "urlhandlers")
 501
 502 -- XXX should the password be quoted?
 503 -- | Send password to server to authenticate session.
 504 -- Password is sent as plain text.
 505 password :: String -> MPD ()
 506 password = getResponse_ . ("password " ++)
 507
 508 -- | Check that the server is still responding.
 509 ping :: MPD ()
 510 ping = getResponse_ "ping"
 511
 512 -- | Get server statistics.
 513 stats :: MPD Stats
 514 stats = getResponse "stats" >>= foldM f defaultStats . toAssoc
 515     where
 516         f a ("artists", x)  = parse parseNum (\x' -> a { stsArtists  = x' }) x
 517         f a ("albums", x)   = parse parseNum (\x' -> a { stsAlbums   = x' }) x
 518         f a ("songs", x)    = parse parseNum (\x' -> a { stsSongs    = x' }) x
 519         f a ("uptime", x)   = parse parseNum (\x' -> a { stsUptime   = x' }) x
 520         f a ("playtime", x) = parse parseNum (\x' -> a { stsPlaytime = x' }) x
 521         f a ("db_playtime", x) = parse parseNum
 522                                  (\x' -> a { stsDbPlaytime = x' }) x
 523         f a ("db_update", x) = parse parseNum (\x' -> a { stsDbUpdate = x' }) x
 524         f _ x = throwError . Unexpected $ show x
 525         defaultStats =
 526             Stats { stsArtists = 0, stsAlbums = 0, stsSongs = 0, stsUptime = 0
 527                   , stsPlaytime = 0, stsDbPlaytime = 0, stsDbUpdate = 0 }
 528
 529 -- | Get the server's status.
 530 status :: MPD Status
 531 status = getResponse "status" >>= foldM f empty . toAssoc
 532     where f a ("state", x)          = parse state (\x' -> a { stState = x'}) x
 533           f a ("volume", x)         = parse parseNum (\x' -> a { stVolume = x'}) x
 534           f a ("repeat", x)         = parse parseBool
 535                                       (\x' -> a { stRepeat = x' }) x
 536           f a ("random", x)         = parse parseBool
 537                                       (\x' -> a { stRandom = x' }) x
 538           f a ("playlist", x)       = parse parseNum
 539                                       (\x' -> a { stPlaylistVersion = x'}) x
 540           f a ("playlistlength", x) = parse parseNum
 541                                       (\x' -> a { stPlaylistLength = x'}) x
 542           f a ("xfade", x)          = parse parseNum
 543                                       (\x' -> a { stXFadeWidth = x'}) x
 544           f a ("song", x)           = parse parseNum
 545                                       (\x' -> a { stSongPos = Just (Pos x') }) x
 546           f a ("songid", x)         = parse parseNum
 547                                       (\x' -> a { stSongID = Just (ID x') }) x
 548           f a ("time", x)           = parse time (\x' -> a { stTime = x' }) x
 549           f a ("bitrate", x)        = parse parseNum
 550                                       (\x' -> a { stBitrate = x'}) x
 551           f a ("audio", x)          = parse audio (\x' -> a { stAudio = x' }) x
 552           f a ("updating_db", x)    = parse parseNum
 553                                       (\x' -> a { stUpdatingDb = x' }) x
 554           f a ("error", x)          = return a { stError = x }
 555           f _ x                     = throwError . Unexpected $ show x
 556
 557           state "play"  = Just Playing
 558           state "pause" = Just Paused
 559           state "stop"  = Just Stopped
 560           state _       = Nothing
 561
 562           time s = pair parseNum $ breakChar ':' s
 563
 564           audio s = let (u, u') = breakChar ':' s
 565                         (v, w)  = breakChar ':' u' in
 566                     case (parseNum u, parseNum v, parseNum w) of
 567                         (Just a, Just b, Just c) -> Just (a, b, c)
 568                         _                        -> Nothing
 569
 570           empty = Status Stopped 0 False False 0 0 Nothing Nothing (0,0) 0 0
 571                   (0,0,0) 0 ""
 572
 573 --
 574 -- Extensions\/shortcuts.
 575 --
 576
 577 -- | Like 'update', but returns the update job id.
 578 updateId :: [Path] -> MPD Integer
 579 updateId paths = liftM (read . head . takeValues) cmd
 580   where cmd = case map show paths of
 581                 []  -> getResponse "update"
 582                 [x] -> getResponse ("update " ++ x)
 583                 xs  -> getResponses (map ("update " ++) xs)
 584
 585 -- | Toggles play\/pause. Plays if stopped.
 586 toggle :: MPD ()
 587 toggle = status >>= \st -> case stState st of Playing -> pause True
 588                                               _       -> play Nothing
 589
 590 -- | Add a list of songs\/folders to a playlist.
 591 -- Should be more efficient than running 'add' many times.
 592 addMany :: PlaylistName -> [Path] -> MPD ()
 593 addMany _ [] = return ()
 594 addMany plname [x] = add_ plname x
 595 addMany plname xs = getResponses (map ((cmd ++) . show) xs) >> return ()
 596     where cmd = case plname of "" -> "add "
 597                                pl -> "playlistadd " ++ show pl ++ " "
 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 :: PlaylistName -> [PLIndex] -> MPD ()
 603 deleteMany _ [] = return ()
 604 deleteMany plname [x] = delete plname x
 605 deleteMany "" xs = getResponses (map cmd xs) >> return ()
 606     where cmd (Pos x) = "delete " ++ show x
 607           cmd (ID x)  = "deleteid " ++ show x
 608 deleteMany plname xs = getResponses (map cmd xs) >> return ()
 609     where cmd (Pos x) = "playlistdelete " ++ show plname ++ " " ++ show x
 610           cmd _       = ""
 611
 612 -- | Returns all songs and directories that match the given partial
 613 -- path name.
 614 complete :: String -> MPD [Either Path Song]
 615 complete path = do
 616     xs <- liftM matches . lsInfo $ dropFileName path
 617     case xs of
 618         [Left dir] -> complete $ dir ++ "/"
 619         _          -> return xs
 620     where
 621         matches = filter (isPrefixOf path . takePath)
 622         takePath = either id sgFilePath
 623
 624 -- | Crop playlist.
 625 -- The bounds are inclusive.
 626 -- If 'Nothing' or 'ID' is passed the cropping will leave your playlist alone
 627 -- on that side.
 628 crop :: Maybe PLIndex -> Maybe PLIndex -> MPD ()
 629 crop x y = do
 630     pl <- playlistInfo Nothing
 631     let x' = case x of Just (Pos p) -> fromInteger p
 632                        Just (ID i)  -> fromMaybe 0 (findByID i pl)
 633                        Nothing      -> 0
 634         -- ensure that no songs are deleted twice with 'max'.
 635         ys = case y of Just (Pos p) -> drop (max (fromInteger p) x') pl
 636                        Just (ID i)  -> maybe [] (flip drop pl . max x' . (+1))
 637                                       (findByID i pl)
 638                        Nothing      -> []
 639     deleteMany "" . mapMaybe sgIndex $ take x' pl ++ ys
 640     where findByID i = findIndex ((==) i . (\(ID j) -> j) . fromJust . sgIndex)
 641
 642 -- | Remove duplicate playlist entries.
 643 prune :: MPD ()
 644 prune = findDuplicates >>= deleteMany ""
 645
 646 -- Find duplicate playlist entries.
 647 findDuplicates :: MPD [PLIndex]
 648 findDuplicates =
 649     liftM (map ((\(ID x) -> ID x) . fromJust . sgIndex) . flip dups ([],[])) $
 650         playlistInfo Nothing
 651     where dups [] (_, dup) = dup
 652           dups (x:xs) (ys, dup)
 653               | x `elem` xs && x `notElem` ys = dups xs (ys, x:dup)
 654               | otherwise                     = dups xs (x:ys, dup)
 655
 656 -- | List directories non-recursively.
 657 lsDirs :: Path -> MPD [Path]
 658 lsDirs path =
 659     liftM (extractEntries (const Nothing,const Nothing, Just)) $
 660         takeEntries =<< getResponse ("lsinfo " ++ show path)
 661
 662 -- | List files non-recursively.
 663 lsFiles :: Path -> MPD [Path]
 664 lsFiles path =
 665     liftM (extractEntries (Just . sgFilePath, const Nothing, const Nothing)) $
 666         takeEntries =<< getResponse ("lsinfo " ++ show path)
 667
 668 -- | List all playlists.
 669 lsPlaylists :: MPD [PlaylistName]
 670 lsPlaylists =
 671     liftM (extractEntries (const Nothing, Just, const Nothing)) $
 672         takeEntries =<< getResponse "lsinfo"
 673
 674 -- | Search the database for songs relating to an artist.
 675 findArtist :: Artist -> MPD [Song]
 676 findArtist = find . Query Artist
 677
 678 -- | Search the database for songs relating to an album.
 679 findAlbum :: Album -> MPD [Song]
 680 findAlbum = find . Query Album
 681
 682 -- | Search the database for songs relating to a song title.
 683 findTitle :: Title -> MPD [Song]
 684 findTitle = find . Query Title
 685
 686 -- | List the artists in the database.
 687 listArtists :: MPD [Artist]
 688 listArtists = liftM takeValues (getResponse "list artist")
 689
 690 -- | List the albums in the database, optionally matching a given
 691 -- artist.
 692 listAlbums :: Maybe Artist -> MPD [Album]
 693 listAlbums artist = liftM takeValues (getResponse ("list album" ++
 694     maybe "" ((" artist " ++) . show) artist))
 695
 696 -- | List the songs in an album of some artist.
 697 listAlbum :: Artist -> Album -> MPD [Song]
 698 listAlbum artist album = find (MultiQuery [Query Artist artist
 699                                           ,Query Album album])
 700
 701 -- | Search the database for songs relating to an artist using 'search'.
 702 searchArtist :: Artist -> MPD [Song]
 703 searchArtist = search . Query Artist
 704
 705 -- | Search the database for songs relating to an album using 'search'.
 706 searchAlbum :: Album -> MPD [Song]
 707 searchAlbum = search . Query Album
 708
 709 -- | Search the database for songs relating to a song title.
 710 searchTitle :: Title -> MPD [Song]
 711 searchTitle = search . Query Title
 712
 713 -- | Retrieve the current playlist.
 714 -- Equivalent to @playlistinfo Nothing@.
 715 getPlaylist :: MPD [Song]
 716 getPlaylist = playlistInfo Nothing
 717
 718 --
 719 -- Miscellaneous functions.
 720 --
 721
 722 -- Run getResponse but discard the response.
 723 getResponse_ :: String -> MPD ()
 724 getResponse_ x = getResponse x >> return ()
 725
 726 -- Get the lines of the daemon's response to a list of commands.
 727 getResponses :: [String] -> MPD [String]
 728 getResponses cmds = getResponse $ intercalate "\n" cmds'
 729     where cmds' = "command_list_begin" : cmds ++ ["command_list_end"]
 730
 731 -- Helper that throws unexpected error if input is empty.
 732 failOnEmpty :: [String] -> MPD [String]
 733 failOnEmpty [] = throwError $ Unexpected "Non-empty response expected."
 734 failOnEmpty xs = return xs
 735
 736 -- A wrapper for getResponse that fails on non-empty responses.
 737 getResponse1 :: String -> MPD [String]
 738 getResponse1 x = getResponse x >>= failOnEmpty
 739
 740 --
 741 -- Parsing.
 742 --
 743
 744 -- Run 'toAssoc' and return only the values.
 745 takeValues :: [String] -> [String]
 746 takeValues = snd . unzip . toAssoc
 747
 748 data EntryType
 749     = SongEntry Song
 750     | PLEntry   String
 751     | DirEntry  String
 752       deriving Show
 753
 754 -- Separate the result of an lsinfo\/listallinfo call into directories,
 755 -- playlists, and songs.
 756 takeEntries :: [String] -> MPD [EntryType]
 757 takeEntries = mapM toEntry . splitGroups wrappers . toAssoc . reverse
 758     where
 759         toEntry xs@(("file",_):_)   = liftM SongEntry $ takeSongInfo xs
 760         toEntry (("directory",d):_) = return $ DirEntry d
 761         toEntry (("playlist",pl):_) = return $ PLEntry  pl
 762         toEntry _ = error "takeEntries: splitGroups is broken"
 763         wrappers = [("file",id), ("directory",id), ("playlist",id)]
 764
 765 -- Extract a subset of songs, directories, and playlists.
 766 extractEntries :: (Song -> Maybe a, String -> Maybe a, String -> Maybe a)
 767                -> [EntryType] -> [a]
 768 extractEntries (fSong,fPlayList,fDir) = catMaybes . map f
 769     where
 770         f (SongEntry s) = fSong s
 771         f (PLEntry pl)  = fPlayList pl
 772         f (DirEntry d)  = fDir d
 773
 774 -- Build a list of song instances from a response.
 775 takeSongs :: [String] -> MPD [Song]
 776 takeSongs = mapM takeSongInfo . splitGroups [("file",id)] . toAssoc
 777
 778 -- Builds a song instance from an assoc. list.
 779 takeSongInfo :: [(String, String)] -> MPD Song
 780 takeSongInfo xs = foldM f song xs
 781     where f a ("Artist", x)    = return a { sgArtist = x }
 782           f a ("Album", x)     = return a { sgAlbum  = x }
 783           f a ("Title", x)     = return a { sgTitle = x }
 784           f a ("Genre", x)     = return a { sgGenre = x }
 785           f a ("Name", x)      = return a { sgName = x }
 786           f a ("Composer", x)  = return a { sgComposer = x }
 787           f a ("Performer", x) = return a { sgPerformer = x }
 788           f a ("Date", x)      = parse parseDate (\x' -> a { sgDate = x' }) x
 789           f a ("Track", x)     = parse parseTuple (\x' -> a { sgTrack = x'}) x
 790           f a ("Disc", x)      = parse parseTuple (\x' -> a { sgDisc = x'}) x
 791           f a ("file", x)      = return a { sgFilePath = x }
 792           f a ("Time", x)      = parse parseNum (\x' -> a { sgLength = x'}) x
 793           f a ("Id", x)        = parse parseNum
 794                                  (\x' -> a { sgIndex = Just (ID x') }) x
 795           -- We prefer Id.
 796           f a ("Pos", _)       = return a
 797           -- Catch unrecognised keys
 798           f _ x                = throwError . Unexpected $ show x
 799
 800           parseTuple s = let (x, y) = breakChar '/' s in
 801                          -- Handle incomplete values. For example, songs might
 802                          -- have a track number, without specifying the total
 803                          -- number of tracks, in which case the resulting
 804                          -- tuple will have two identical parts.
 805                          case (parseNum x, parseNum y) of
 806                              (Just x', Nothing) -> Just (x', x')
 807                              (Just x', Just y') -> Just (x', y')
 808                              _                  -> Nothing
 809
 810           song = Song { sgArtist = "", sgAlbum = "", sgTitle = ""
 811                       , sgGenre = "", sgName = "", sgComposer = ""
 812                       , sgPerformer = "", sgDate = 0, sgTrack = (0,0)
 813                       , sgDisc = (0,0), sgFilePath = "", sgLength = 0
 814                       , sgIndex = Nothing }