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