MPD.hs

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