2 libmpd for Haskell, an MPD client library.
3 Copyright (C) 2005-2007 Ben Sinclair <bsinclai@turing.une.edu.au>
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.
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.
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
21 -- Copyright : (c) Ben Sinclair 2005-2007
23 -- Maintainer : bsinclai@turing.une.edu.au
25 -- Portability : Haskell 98
27 -- MPD client library.
32 State
(..), Status
(..), Stats
(..),
35 Artist
, Album
, Title
, Seconds
, PLIndex
(..),
42 disableoutput
, enableoutput
, kill
, outputs
, update
,
44 -- * Database commands
45 find, list, listAll
, listAllinfo
, lsinfo
, search
, count
,
47 -- * Playlist commands
49 add
, add_
, addid
, clear
, currentSong
, delete, load
, move
,
50 playlistinfo
, listplaylist
, listplaylistinfo
, playlist
, plchanges
,
51 plchangesposid
, playlistfind
, playlistsearch
, rm
, rename
, save
,
54 -- * Playback commands
55 crossfade
, next, pause
, play
, previous
, random, repeat, seek
,
56 setVolume
, volume
, stop
,
58 -- * Miscellaneous commands
59 clearerror
, close
, commands
, notcommands
, tagtypes
, urlhandlers
,
60 password
, ping
, reconnect
, stats
, status
,
62 -- * Extensions\/shortcuts
63 addMany
, deleteMany
, crop
, prune
, lsdirs
, lsfiles
, lsplaylists
,
64 findArtist
, findAlbum
, findTitle
, listArtists
, listAlbums
,
65 listAlbum
, searchArtist
, searchAlbum
, searchTitle
, getPlaylist
,
66 toggle
, updateid
, mkPasswordGen
, throwMPD
, catchMPD
70 import Control
.Monad
(liftM, unless)
71 import Prelude
hiding (repeat)
72 import Data
.IORef
(newIORef
, atomicModifyIORef
)
73 import Data
.List
(findIndex)
75 import System
.Environment
(getEnv)
77 import System
.IO.Error
(isDoesNotExistError, ioError)
88 type Seconds
= Integer
90 -- | Available metadata types\/scope modifiers, used for searching the
91 -- database for entries with certain metadata values.
92 data Meta
= Artist | Album | Title | Track | Name | Genre | Date
93 | Composer | Performer | Disc | Any | Filename
95 instance Show Meta
where
96 show Artist
= "Artist"
103 show Composer
= "Composer"
104 show Performer
= "Performer"
107 show Filename
= "Filename"
109 -- | A query is comprised of a scope modifier and a query string.
110 data Query
= Query Meta
String -- ^ Simple query.
111 | MultiQuery
[Query
] -- ^ Query with multiple conditions.
113 instance Show Query
where
114 show (Query meta query
) = show meta
++ " " ++ show query
115 show (MultiQuery xs
) = show xs
116 showList xs _
= unwords $ map show xs
118 -- | Represents a song's playlist index.
119 data PLIndex
= Pos
Integer -- ^ A playlist position index (starting from 0).
120 | ID
Integer -- ^ A playlist ID number that more robustly
121 -- identifies a song.
124 -- | Represents the different playback states.
130 -- | Container for MPD status.
132 Status
{ stState
:: State
,
133 -- | A percentage (0-100).
135 stRepeat
, stRandom
:: Bool,
136 -- | This value gets incremented by the server every time the
138 stPlaylistVersion
:: Integer,
139 stPlaylistLength
:: Integer,
140 -- | Current song's position in the playlist.
141 stSongPos
:: Maybe PLIndex
,
142 -- | Current song's playlist id.
143 stSongID
:: Maybe PLIndex
,
144 -- | (time elapsed, total time)
145 stTime
:: (Seconds
,Seconds
),
146 -- | Bitrate of playing song in kilobytes per second.
149 stXFadeWidth
:: Seconds
,
150 -- | (samplerate, bits, channels)
151 stAudio
:: (Int,Int,Int),
152 -- | Job id of currently running update (if any).
153 stUpdatingDb
:: Integer,
154 -- | Last error message (if any)
158 -- | Container for database statistics.
160 Stats
{ stsArtists
:: Integer -- ^ Number of artists.
161 , stsAlbums
:: Integer -- ^ Number of albums.
162 , stsSongs
:: Integer -- ^ Number of songs.
163 , stsUptime
:: Seconds
-- ^ Daemon uptime in seconds.
164 , stsPlaytime
:: Seconds
-- ^ Time length of music played.
165 , stsDbPlaytime
:: Seconds
-- ^ Total play time of all the songs in
167 , stsDbUpdate
:: Integer -- ^ Last database update in UNIX time.
171 -- | Description of a song.
172 data Song
= Song
{ sgArtist
, sgAlbum
, sgTitle
, sgFilePath
, sgGenre
, sgName
173 ,sgComposer
, sgPerformer
:: String
174 ,sgLength
:: Seconds
-- ^ Length in seconds
175 ,sgDate
:: Int -- ^ Year
176 ,sgTrack
:: (Int, Int) -- ^ (track number, total tracks)
177 ,sgDisc
:: (Int, Int) -- ^ (pos. in set, total in set)
178 ,sgIndex
:: Maybe PLIndex
}
181 -- Temporarily avoid writing an overloaded version of 'elem' for use in
183 instance Eq Song
where
184 (==) x y
= sgFilePath x
== sgFilePath y
186 -- | Describes a 'count'.
187 data Count
= Count
{ cSongs
:: Integer -- ^ Number of songs that matches
189 , cPlaytime
:: Seconds
-- ^ Total play time of matching
194 -- | Represents an output device.
196 Device
{ dOutputID
:: Int -- ^ Output's id number
197 , dOutputName
:: String -- ^ Output's name as defined in the MPD
198 -- configuration file
199 , dOutputEnabled
:: Bool }
202 -- | Run an MPD action using localhost:6600 as the default host:port,
203 -- or whatever is found in the environment variables MPD_HOST and
204 -- MPD_PORT. If MPD_HOST is of the form \"password\@host\" then the
205 -- password will be supplied as well.
206 withMPD
:: MPD a
-> IO (Either ACK a
)
208 port
<- liftM read (getEnvDefault
"MPD_PORT" "6600")
209 (pw
,host
) <- liftM (break (== '@')) (getEnvDefault
"MPD_HOST" "localhost")
210 let (host
',pw
') = if null host
then (pw
,host
) else (drop 1 host
,pw
)
211 pwGen
<- mkPasswordGen
[pw
']
212 withMPDEx host
' port pwGen m
214 getEnvDefault x dflt
=
215 catch (getEnv x
) (\e
-> if isDoesNotExistError e
216 then return dflt
else ioError e
)
222 -- | Turn off an output device.
223 disableoutput
:: Int -> MPD
()
224 disableoutput
= getResponse_
. ("disableoutput " ++) . show
226 -- | Turn on an output device.
227 enableoutput
:: Int -> MPD
()
228 enableoutput
= getResponse_
. ("enableoutput " ++) . show
230 -- | Retrieve information for all output devices.
231 outputs
:: MPD
[Device
]
232 outputs
= liftM (map takeDevInfo
. splitGroups
. kvise
)
233 (getResponse
"outputs")
235 takeDevInfo xs
= Device
{
236 dOutputID
= takeNum
"outputid" xs
,
237 dOutputName
= takeString
"outputname" xs
,
238 dOutputEnabled
= takeBool
"outputenabled" xs
241 -- | Update the server's database.
242 update
:: [String] -- ^ Optionally specify a list of paths
244 update
[] = getResponse_
"update"
245 update
[x
] = getResponse_
("update " ++ show x
)
246 update xs
= getResponses
(map (("update " ++) . show) xs
) >> return ()
252 -- | List all metadata of metadata (sic).
253 list :: Meta
-- ^ Metadata to list
254 -> Maybe Query
-> MPD
[String]
255 list mtype query
= liftM takeValues
(getResponse cmd
)
256 where cmd
= "list " ++ show mtype
++ maybe "" ((" "++) . show) query
258 -- | Non-recursively list the contents of a database directory.
259 lsinfo
:: Maybe String -- ^ Optionally specify a path.
260 -> MPD
[Either String Song
]
262 (dirs
,_
,songs
) <- liftM takeEntries
263 (getResponse
("lsinfo " ++ maybe "" show path
))
264 return (map Left dirs
++ map Right songs
)
266 -- | List the songs (without metadata) in a database directory recursively.
267 listAll
:: Maybe String -> MPD
[String]
268 listAll path
= liftM (map snd . filter ((== "file") . fst) . kvise
)
269 (getResponse
("listall " ++ maybe "" show path
))
271 -- | Recursive 'lsinfo'.
272 listAllinfo
:: Maybe String -- ^ Optionally specify a path
273 -> MPD
[Either String Song
]
274 listAllinfo path
= do
275 (dirs
,_
,songs
) <- liftM takeEntries
276 (getResponse
("listallinfo " ++ maybe "" show path
))
277 return (map Left dirs
++ map Right songs
)
279 -- | Search the database for entries exactly matching a query.
280 find :: Query
-> MPD
[Song
]
281 find query
= liftM takeSongs
(getResponse
("find " ++ show query
))
283 -- | Search the database using case insensitive matching.
284 search
:: Query
-> MPD
[Song
]
285 search query
= liftM takeSongs
(getResponse
("search " ++ show query
))
287 -- | Count the number of entries matching a query.
288 count
:: Query
-> MPD Count
289 count query
= liftM (takeCountInfo
. kvise
)
290 (getResponse
("count " ++ show query
))
291 where takeCountInfo xs
= Count
{ cSongs
= takeNum
"songs" xs
,
292 cPlaytime
= takeNum
"playtime" xs
}
298 -- Unless otherwise noted all playlist commands operate on the current
301 -- | Like 'add', but returns a playlist id.
302 addid
:: String -> MPD
Integer
304 liftM (read . snd . head . kvise
) (getResponse
("addid " ++ show x
))
306 -- | Like 'add_' but returns a list of the files added.
307 add
:: Maybe String -> String -> MPD
[String]
308 add plname x
= add_ plname x
>> listAll
(Just x
)
310 -- | Add a song (or a whole directory) to a playlist.
311 -- Adds to current if no playlist is specified.
312 -- Will create a new playlist if the one specified does not already exist.
313 add_
:: Maybe String -- ^ Optionally specify a playlist to operate on
315 add_ Nothing
= getResponse_
. ("add " ++) . show
316 add_
(Just plname
) = getResponse_
.
317 (("playlistadd " ++ show plname
++ " ") ++) . show
319 -- | Clear a playlist. Clears current playlist if no playlist is specified.
320 -- If the specified playlist does not exist, it will be created.
321 clear
:: Maybe String -- ^ Optional name of a playlist to clear.
323 clear
= getResponse_
. maybe "clear" (("playlistclear " ++) . show)
325 -- | Remove a song from a playlist.
326 -- If no playlist is specified, current playlist is used.
327 -- Note that a playlist position ('Pos') is required when operating on
328 -- playlists other than the current.
329 delete :: Maybe String -- ^ Optionally specify a playlist to operate on
331 delete Nothing
(Pos x
) = getResponse_
("delete " ++ show x
)
332 delete Nothing
(ID x
) = getResponse_
("deleteid " ++ show x
)
333 delete (Just plname
) (Pos x
) =
334 getResponse_
("playlistdelete " ++ show plname
++ " " ++ show x
)
335 delete _ _
= return ()
337 -- | Load an existing playlist.
338 load
:: String -> MPD
()
339 load
= getResponse_
. ("load " ++) . show
341 -- | Move a song to a given position.
342 -- Note that a playlist position ('Pos') is required when operating on
343 -- playlists other than the current.
344 move
:: Maybe String -- ^ Optionally specify a playlist to operate on
345 -> PLIndex
-> Integer -> MPD
()
346 move Nothing
(Pos from
) to
=
347 getResponse_
("move " ++ show from
++ " " ++ show to
)
348 move Nothing
(ID from
) to
=
349 getResponse_
("moveid " ++ show from
++ " " ++ show to
)
350 move
(Just plname
) (Pos from
) to
=
351 getResponse_
("playlistmove " ++ show plname
++ " " ++ show from
++
353 move _ _ _
= return ()
355 -- | Delete existing playlist.
356 rm
:: String -> MPD
()
357 rm
= getResponse_
. ("rm " ++) . show
359 -- | Rename an existing playlist.
360 rename
:: String -- ^ Name of playlist to be renamed
361 -> String -- ^ New playlist name
364 getResponse_
("rename " ++ show plname
++ " " ++ show new
)
366 -- | Save the current playlist.
367 save
:: String -> MPD
()
368 save
= getResponse_
. ("save " ++) . show
370 -- | Swap the positions of two songs.
371 -- Note that the positions must be of the same type, i.e. mixing 'Pos' and 'ID'
372 -- will result in a no-op.
373 swap
:: PLIndex
-> PLIndex
-> MPD
()
374 swap
(Pos x
) (Pos y
) = getResponse_
("swap " ++ show x
++ " " ++ show y
)
375 swap
(ID x
) (ID y
) = getResponse_
("swapid " ++ show x
++ " " ++ show y
)
378 -- | Shuffle the playlist.
380 shuffle
= getResponse_
"shuffle"
382 -- | Retrieve metadata for songs in the current playlist.
383 playlistinfo
:: Maybe PLIndex
-- ^ Optional playlist index.
385 playlistinfo x
= liftM takeSongs
(getResponse cmd
)
386 where cmd
= case x
of
387 Just
(Pos x
') -> "playlistinfo " ++ show x
'
388 Just
(ID x
') -> "playlistid " ++ show x
'
389 Nothing
-> "playlistinfo"
391 -- | Retrieve metadata for files in a given playlist.
392 listplaylistinfo
:: String -> MPD
[Song
]
393 listplaylistinfo
= liftM takeSongs
. getResponse
.
394 ("listplaylistinfo " ++) . show
396 -- | Retrieve a list of files in a given playlist.
397 listplaylist
:: String -> MPD
[String]
398 listplaylist
= liftM takeValues
. getResponse
. ("listplaylist " ++) . show
400 -- | Retrieve file paths and positions of songs in the current playlist.
401 -- Note that this command is only included for completeness sake; it's
402 -- deprecated and likely to disappear at any time.
403 playlist
:: MPD
[(PLIndex
, String)]
404 playlist
= liftM (map f
) (getResponse
"playlist")
405 where f s
= let (pos
, name
) = break (== ':') s
406 in (Pos
$ read pos
, drop 1 name
)
408 -- | Retrieve a list of changed songs currently in the playlist since
409 -- a given playlist version.
410 plchanges
:: Integer -> MPD
[Song
]
411 plchanges
= liftM takeSongs
. getResponse
. ("plchanges " ++) . show
413 -- | Like 'plchanges' but only returns positions and ids.
414 plchangesposid
:: Integer -> MPD
[(PLIndex
, PLIndex
)]
415 plchangesposid plver
=
416 liftM (map takePosid
. splitGroups
. kvise
) (getResponse cmd
)
417 where cmd
= "plchangesposid " ++ show plver
418 takePosid xs
= (Pos
$ takeNum
"cpos" xs
, ID
$ takeNum
"Id" xs
)
420 -- | Search for songs in the current playlist with strict matching.
421 playlistfind
:: Query
-> MPD
[Song
]
422 playlistfind query
= liftM takeSongs
423 (getResponse
("playlistfind " ++ show query
))
425 -- | Search case-insensitively with partial matches for songs in the
427 playlistsearch
:: Query
-> MPD
[Song
]
428 playlistsearch query
= liftM takeSongs
429 (getResponse
("playlistsearch " ++ show query
))
431 -- | Get the currently playing song.
432 currentSong
:: MPD
(Maybe Song
)
435 if stState currStatus
== Stopped
437 else do ls
<- liftM kvise
(getResponse
"currentsong")
438 return $ if null ls
then Nothing
439 else Just
(takeSongInfo ls
)
445 -- | Set crossfading between songs.
446 crossfade
:: Seconds
-> MPD
()
447 crossfade
= getResponse_
. ("crossfade " ++) . show
449 -- | Begin\/continue playing.
450 play
:: Maybe PLIndex
-> MPD
()
451 play Nothing
= getResponse_
"play"
452 play
(Just
(Pos x
)) = getResponse_
("play " ++ show x
)
453 play
(Just
(ID x
)) = getResponse_
("playid " ++ show x
)
456 pause
:: Bool -> MPD
()
457 pause
= getResponse_
. ("pause " ++) . showBool
461 stop
= getResponse_
"stop"
463 -- | Play the next song.
465 next = getResponse_
"next"
467 -- | Play the previous song.
469 previous
= getResponse_
"previous"
471 -- | Seek to some point in a song.
472 -- Seeks in current song if no position is given.
473 seek
:: Maybe PLIndex
-> Seconds
-> MPD
()
474 seek
(Just
(Pos x
)) time
=
475 getResponse_
("seek " ++ show x
++ " " ++ show time
)
476 seek
(Just
(ID x
)) time
=
477 getResponse_
("seekid " ++ show x
++ " " ++ show time
)
478 seek Nothing time
= do
480 unless (stState st
== Stopped
) (seek
(stSongID st
) time
)
482 -- | Set random playing.
483 random :: Bool -> MPD
()
484 random = getResponse_
. ("random " ++) . showBool
487 repeat :: Bool -> MPD
()
488 repeat = getResponse_
. ("repeat " ++) . showBool
491 setVolume
:: Int -> MPD
()
492 setVolume
= getResponse_
. ("setvol " ++) . show
494 -- | Increase or decrease volume by a given percent, e.g.
495 -- 'volume 10' will increase the volume by 10 percent, while
496 -- 'volume (-10)' will decrease it by the same amount.
497 -- Note that this command is only included for completeness sake ; it's
498 -- deprecated and may disappear at any time.
499 volume
:: Int -> MPD
()
500 volume
= getResponse_
. ("volume " ++) . show
503 -- Miscellaneous commands
506 -- | Retrieve a list of available commands.
507 commands
:: MPD
[String]
508 commands
= liftM takeValues
(getResponse
"commands")
510 -- | Retrieve a list of unavailable commands.
511 notcommands
:: MPD
[String]
512 notcommands
= liftM takeValues
(getResponse
"notcommands")
514 -- | Retrieve a list of available song metadata.
515 tagtypes
:: MPD
[String]
516 tagtypes
= liftM takeValues
(getResponse
"tagtypes")
518 -- | Retrieve a list of supported urlhandlers.
519 urlhandlers
:: MPD
[String]
520 urlhandlers
= liftM takeValues
(getResponse
"urlhandlers")
522 -- XXX should the password be quoted?
523 -- | Send password to server to authenticate session.
524 -- Password is sent as plain text.
525 password
:: String -> MPD
()
526 password
= getResponse_
. ("password " ++)
528 -- | Check that the server is still responding.
530 ping
= getResponse_
"ping"
532 -- | Get server statistics.
534 stats
= liftM (parseStats
. kvise
) (getResponse
"stats")
535 where parseStats xs
=
536 Stats
{ stsArtists
= takeNum
"artists" xs
,
537 stsAlbums
= takeNum
"albums" xs
,
538 stsSongs
= takeNum
"songs" xs
,
539 stsUptime
= takeNum
"uptime" xs
,
540 stsPlaytime
= takeNum
"playtime" xs
,
541 stsDbPlaytime
= takeNum
"db_playtime" xs
,
542 stsDbUpdate
= takeNum
"db_update" xs
}
544 -- | Get the server's status.
546 status
= liftM (parseStatus
. kvise
) (getResponse
"status")
547 where parseStatus xs
=
548 Status
{ stState
= maybe Stopped parseState
$ lookup "state" xs
,
549 stVolume
= takeNum
"volume" xs
,
550 stRepeat
= takeBool
"repeat" xs
,
551 stRandom
= takeBool
"random" xs
,
552 stPlaylistVersion
= takeNum
"playlist" xs
,
553 stPlaylistLength
= takeNum
"playlistlength" xs
,
554 stXFadeWidth
= takeNum
"xfade" xs
,
555 stSongPos
= takeIndex Pos
"song" xs
,
556 stSongID
= takeIndex ID
"songid" xs
,
557 stTime
= maybe (0,0) parseTime
$ lookup "time" xs
,
558 stBitrate
= takeNum
"bitrate" xs
,
559 stAudio
= maybe (0,0,0) parseAudio
$ lookup "audio" xs
,
560 stUpdatingDb
= takeNum
"updating_db" xs
,
561 stError
= takeString
"error" xs
563 parseState x
= case x
of "play" -> Playing
566 parseTime x
= let (y
,_
:z
) = break (== ':') x
in (read y
, read z
)
568 let (u
,_
:u
') = break (== ':') x
; (v
,_
:w
) = break (== ':') u
' in
569 (read u
, read v
, read w
)
572 -- Extensions\/shortcuts.
575 -- | Like 'update', but returns the update job id.
576 updateid
:: [String] -> MPD
Integer
577 updateid paths
= liftM (read . head . takeValues
) cmd
578 where cmd
= case paths
of
579 [] -> getResponse
"update"
580 [x
] -> getResponse
("update " ++ x
)
581 xs
-> getResponses
(map ("update " ++) xs
)
583 -- | Toggles play\/pause. Plays if stopped.
588 Playing
-> pause
True
591 -- | Add a list of songs\/folders to a playlist.
592 -- Should be more efficient than running 'add' many times.
593 addMany
:: Maybe String -> [String] -> MPD
()
594 addMany _
[] = return ()
595 addMany plname
[x
] = add_ plname x
596 addMany plname xs
= getResponses
(map (cmd
++) xs
) >> return ()
597 where cmd
= maybe ("add ") (\pl
-> "playlistadd " ++ show pl
++ " ") plname
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.
602 deleteMany
:: Maybe String -> [PLIndex
] -> MPD
()
603 deleteMany _
[] = return ()
604 deleteMany plname
[x
] = delete plname x
605 deleteMany
(Just plname
) xs
= getResponses
(map cmd xs
) >> return ()
606 where cmd
(Pos x
) = "playlistdelete " ++ show plname
++ " " ++ show x
608 deleteMany Nothing xs
= getResponses
(map cmd xs
) >> return ()
609 where cmd
(Pos x
) = "delete " ++ show x
610 cmd
(ID x
) = "deleteid " ++ show x
613 -- The bounds are inclusive.
614 -- If 'Nothing' or 'ID' is passed the cropping will leave your playlist alone
616 crop
:: Maybe PLIndex
-> Maybe PLIndex
-> MPD
()
618 pl
<- playlistinfo Nothing
619 let x
' = case x
of Just
(Pos p
) -> fromInteger p
620 Just
(ID i
) -> maybe 0 id (findByID i pl
)
622 -- ensure that no songs are deleted twice with 'max'.
623 ys
= case y
of Just
(Pos p
) -> drop (max (fromInteger p
) x
') pl
624 Just
(ID i
) -> maybe [] (flip drop pl
. max x
' . (+1))
627 deleteMany Nothing
(mapMaybe sgIndex
(take x
' pl
++ ys
))
628 where findByID i
= findIndex ((==) i
. (\(ID j
) -> j
) . fromJust . sgIndex
)
630 -- | Remove duplicate playlist entries.
632 prune
= findDuplicates
>>= deleteMany Nothing
634 -- Find duplicate playlist entries.
635 findDuplicates
:: MPD
[PLIndex
]
637 liftM (map ((\(ID x
) -> ID x
) . fromJust . sgIndex
) . flip dups
([],[])) $
639 where dups
[] (_
, dup
) = dup
640 dups
(x
:xs
) (ys
, dup
)
641 | x `
elem` xs
&& x `
notElem` ys
= dups xs
(ys
, x
:dup
)
642 |
otherwise = dups xs
(x
:ys
, dup
)
644 -- | List directories non-recursively.
645 lsdirs
:: Maybe String -- ^ optional path.
647 lsdirs path
= liftM ((\(x
,_
,_
) -> x
) . takeEntries
)
648 (getResponse
("lsinfo " ++ maybe "" show path
))
650 -- | List files non-recursively.
651 lsfiles
:: Maybe String -- ^ optional path.
653 lsfiles path
= liftM (map sgFilePath
. (\(_
,_
,x
) -> x
) . takeEntries
)
654 (getResponse
("lsinfo " ++ maybe "" show path
))
656 -- | List all playlists.
657 lsplaylists
:: MPD
[String]
658 lsplaylists
= liftM ((\(_
,x
,_
) -> x
) . takeEntries
) (getResponse
"lsinfo")
660 -- | Search the database for songs relating to an artist.
661 findArtist
:: Artist
-> MPD
[Song
]
662 findArtist
= find . Query Artist
664 -- | Search the database for songs relating to an album.
665 findAlbum
:: Album
-> MPD
[Song
]
666 findAlbum
= find . Query Album
668 -- | Search the database for songs relating to a song title.
669 findTitle
:: Title
-> MPD
[Song
]
670 findTitle
= find . Query Title
672 -- | List the artists in the database.
673 listArtists
:: MPD
[Artist
]
674 listArtists
= liftM takeValues
(getResponse
"list artist")
676 -- | List the albums in the database, optionally matching a given
678 listAlbums
:: Maybe Artist
-> MPD
[Album
]
679 listAlbums artist
= liftM takeValues
(getResponse
("list album" ++
680 maybe "" ((" artist " ++) . show) artist
))
682 -- | List the songs in an album of some artist.
683 listAlbum
:: Artist
-> Album
-> MPD
[Song
]
684 listAlbum artist album
= find (MultiQuery
[Query Artist artist
687 -- | Search the database for songs relating to an artist using 'search'.
688 searchArtist
:: Artist
-> MPD
[Song
]
689 searchArtist
= search
. Query Artist
691 -- | Search the database for songs relating to an album using 'search'.
692 searchAlbum
:: Album
-> MPD
[Song
]
693 searchAlbum
= search
. Query Album
695 -- | Search the database for songs relating to a song title.
696 searchTitle
:: Title
-> MPD
[Song
]
697 searchTitle
= search
. Query Title
699 -- | Retrieve the current playlist.
700 -- Equivalent to 'playlistinfo Nothing'.
701 getPlaylist
:: MPD
[Song
]
702 getPlaylist
= playlistinfo Nothing
704 -- | Create an action that produces passwords for a connection. You
705 -- can pass these to 'withMPDEx' and it will use them to get passwords
706 -- to send to the server until one works or it runs out of them.
708 -- > do gen <- mkPasswordGen ["password1", "password2"]
709 -- > withMPDEx "localhost" 6600 gen (update [])
710 mkPasswordGen
:: [String] -> IO (IO (Maybe String))
711 mkPasswordGen
= liftM f
. newIORef
712 where f
= flip atomicModifyIORef
$ \xs
-> (drop 1 xs
, listToMaybe xs
)
715 -- Miscellaneous functions.
718 -- Run getResponse but discard the response.
719 getResponse_
:: String -> MPD
()
720 getResponse_ x
= getResponse x
>> return ()
722 -- Get the lines of the daemon's response to a list of commands.
723 getResponses
:: [String] -> MPD
[String]
724 getResponses cmds
= getResponse
.
725 unlines $ "command_list_begin" : cmds
++ ["command_list_end"]
727 -- Break up a list of strings into an assoc. list, separating at
729 kvise
:: [String] -> [(String, String)]
731 where f x
= let (k
,v
) = break (== ':') x
in
732 (k
,dropWhile (== ' ') $ drop 1 v
)
734 -- Takes an assoc. list with recurring keys, and groups each cycle of
735 -- keys with their values together. The first key of each cycle needs
736 -- to be present in every cycle for it to work, but the rest don't
739 -- > splitGroups [(1,'a'),(2,'b'),(1,'c'),(2,'d')] ==
740 -- > [[(1,'a'),(2,'b')],[(1,'c'),(2,'d')]]
741 splitGroups
:: Eq a
=> [(a
, b
)] -> [[(a
, b
)]]
743 splitGroups
(x
:xs
) = ((x
:us
):splitGroups vs
)
744 where (us
,vs
) = break (\y
-> fst x
== fst y
) xs
746 -- Run 'kvise' and return only the values.
747 takeValues
:: [String] -> [String]
748 takeValues
= snd . unzip . kvise
750 -- Separate the result of an lsinfo\/listallinfo call into directories,
751 -- playlists, and songs.
752 takeEntries
:: [String] -> ([String], [String], [Song
])
754 (dirs
, playlists
, map takeSongInfo
$ splitGroups
(reverse filedata
))
755 where (dirs
, playlists
, filedata
) = foldl split ([], [], []) $ kvise s
756 split (ds
, pls
, ss
) x
@(k
, v
) | k
== "directory" = (v
:ds
, pls
, ss
)
757 | k
== "playlist" = (ds
, v
:pls
, ss
)
758 |
otherwise = (ds
, pls
, x
:ss
)
760 -- Build a list of song instances from a response.
761 takeSongs
:: [String] -> [Song
]
762 takeSongs
= map takeSongInfo
. splitGroups
. kvise
764 -- Builds a song instance from an assoc. list.
765 takeSongInfo
:: [(String,String)] -> Song
768 sgArtist
= takeString
"Artist" xs
,
769 sgAlbum
= takeString
"Album" xs
,
770 sgTitle
= takeString
"Title" xs
,
771 sgGenre
= takeString
"Genre" xs
,
772 sgName
= takeString
"Name" xs
,
773 sgComposer
= takeString
"Composer" xs
,
774 sgPerformer
= takeString
"Performer" xs
,
775 sgDate
= takeNum
"Date" xs
,
776 sgTrack
= maybe (0, 0) parseTrack
$ lookup "Track" xs
,
777 sgDisc
= maybe (0, 0) parseTrack
$ lookup "Disc" xs
,
778 sgFilePath
= takeString
"file" xs
,
779 sgLength
= takeNum
"Time" xs
,
780 sgIndex
= takeIndex ID
"Id" xs
782 where parseTrack x
= let (trck
, tot
) = break (== '/') x
783 in (read trck
, parseNum
(drop 1 tot
))
785 -- Helpers for retrieving values from an assoc. list.
786 takeString
:: String -> [(String, String)] -> String
787 takeString v
= fromMaybe "" . lookup v
789 takeIndex
:: (Integer -> PLIndex
) -> String -> [(String, String)]
791 takeIndex c v
= maybe Nothing
(Just
. c
. parseNum
) . lookup v
793 takeNum
:: (Read a
, Num a
) => String -> [(String, String)] -> a
794 takeNum v
= maybe 0 parseNum
. lookup v
796 takeBool
:: String -> [(String, String)] -> Bool
797 takeBool v
= maybe False parseBool
. lookup v
799 -- Parse a numeric value, returning 0 on failure.
800 parseNum
:: (Read a
, Num a
) => String -> a
801 parseNum
= fromMaybe 0 . maybeReads
802 where maybeReads s
= do ; [(x
, "")] <- return (reads s
) ; return x
804 -- Inverts 'parseBool'.
805 showBool
:: Bool -> String
806 showBool x
= if x
then "1" else "0"
808 -- Parse a boolean response value.
809 parseBool
:: String -> Bool
810 parseBool
= (== "1") . take 1