1 {-# LANGUAGE PatternGuards #-}
3 libmpd for Haskell, an MPD client library.
4 Copyright (C) 2005-2008 Ben Sinclair <bsinclai@turing.une.edu.au>
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.
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.
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
21 -- | Module : Network.MPD.Commands
22 -- Copyright : (c) Ben Sinclair 2005-2008
24 -- Maintainer : bsinclai@turing.une.edu.au
26 -- Portability : unportable (uses PatternGuards)
28 -- Interface to the user commands supported by MPD.
30 module Network
.MPD
.Commands
(
31 -- * Command related data types
32 State
(..), Status
(..), Stats
(..),
35 Artist
, Album
, Title
, Seconds
, PlaylistName
, Path
,
36 PLIndex
(..), Song
(..), Count
(..),
39 disableOutput
, enableOutput
, kill
, outputs
, update
,
41 -- * Database commands
42 find, list, listAll
, listAllInfo
, lsInfo
, search
, count
,
44 -- * Playlist commands
46 add
, add_
, addId
, clear
, currentSong
, delete, load
, move
,
47 playlistInfo
, listPlaylist
, listPlaylistInfo
, playlist
, plChanges
,
48 plChangesPosId
, playlistFind
, playlistSearch
, rm
, rename
, save
, shuffle
,
51 -- * Playback commands
52 crossfade
, next, pause
, play
, previous
, random, repeat, seek
, setVolume
,
55 -- * Miscellaneous commands
56 clearError
, close
, commands
, notCommands
, password
, ping
, reconnect
, stats
,
57 status
, tagTypes
, urlHandlers
,
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
65 import Network
.MPD
.Core
66 import Network
.MPD
.Utils
68 import Control
.Monad
(foldM, liftM, unless)
69 import Control
.Monad
.Error
(throwError
)
70 import Prelude
hiding (repeat)
71 import Data
.List
(findIndex, intersperse, isPrefixOf)
73 import System
.FilePath (dropFileName
)
82 type Seconds
= Integer
84 -- | Used for commands which require a playlist name.
85 -- If empty, the current playlist is used.
86 type PlaylistName
= String
88 -- | Used for commands which require a path within the database.
89 -- If empty, the root path is used.
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
98 -- | A query is composed of a scope modifier and a query string.
100 -- To match entries where album equals \"Foo\", use:
102 -- > Query Album "Foo"
104 -- To match entries where album equals \"Foo\" and artist equals \"Bar\", use:
106 -- > MultiQuery [Query Album "Foo", Query Artist "Bar"]
107 data Query
= Query Meta
String -- ^ Simple query.
108 | MultiQuery
[Query
] -- ^ Query with multiple conditions.
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
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.
121 -- | Represents the different playback states.
127 -- | Container for MPD status.
129 Status
{ stState
:: State
130 -- | A percentage (0-100)
134 -- | A value that is incremented by the server every time the
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).
148 , stXFadeWidth
:: Seconds
149 -- | Samplerate\/bits\/channels for the chosen output device
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 }
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
-- ^ Total playing time.
165 , stsDbPlaytime
:: Seconds
-- ^ Total play time of all the songs in
167 , stsDbUpdate
:: Integer -- ^ Last database update in UNIX time.
171 -- | Represents a single song item.
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
}
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
186 -- | Represents the result of running 'count'.
188 Count
{ cSongs
:: Integer -- ^ Number of songs matching the query
189 , cPlaytime
:: Seconds
-- ^ Total play time of matching songs
193 -- | Represents an output device.
195 Device
{ dOutputID
:: Int -- ^ Output's ID number
196 , dOutputName
:: String -- ^ Output's name as defined in the MPD
197 -- configuration file
198 , dOutputEnabled
:: Bool }
205 -- | Turn off an output device.
206 disableOutput
:: Int -> MPD
()
207 disableOutput
= getResponse_
. ("disableoutput " ++) . show
209 -- | Turn on an output device.
210 enableOutput
:: Int -> MPD
()
211 enableOutput
= getResponse_
. ("enableoutput " ++) . show
213 -- | Retrieve information for all output devices.
214 outputs
:: MPD
[Device
]
215 outputs
= getResponse
"outputs" >>=
216 mapM (foldM f
empty) . splitGroups
. toAssoc
217 where f a
("outputid", x
) = parse parseNum
(\x
' -> a
{ dOutputID
= x
' }) x
218 f a
("outputname", x
) = return a
{ dOutputName
= x
}
219 f a
("outputenabled", x
) = parse parseBool
220 (\x
' -> a
{ dOutputEnabled
= x
'}) x
221 f _ x
= throwError
. Unexpected
$ show x
223 empty = Device
0 "" False
225 -- | Update the server's database.
226 -- If no paths are given, all paths will be scanned.
227 -- Unreadable or non-existent paths are silently ignored.
228 update
:: [Path
] -> MPD
()
229 update
[] = getResponse_
"update"
230 update
[x
] = getResponse_
("update " ++ show x
)
231 update xs
= getResponses
(map (("update " ++) . show) xs
) >> return ()
237 -- | List all metadata of metadata (sic).
238 list :: Meta
-- ^ Metadata to list
239 -> Maybe Query
-> MPD
[String]
240 list mtype query
= liftM takeValues
(getResponse cmd
)
241 where cmd
= "list " ++ show mtype
++ maybe "" ((" "++) . show) query
243 -- | Non-recursively list the contents of a database directory.
244 lsInfo
:: Path
-> MPD
[Either Path Song
]
245 lsInfo
= lsInfo
' "lsinfo"
247 -- | List the songs (without metadata) in a database directory recursively.
248 listAll
:: Path
-> MPD
[Path
]
249 listAll path
= liftM (map snd . filter ((== "file") . fst) . toAssoc
)
250 (getResponse
("listall " ++ show path
))
252 -- | Recursive 'lsInfo'.
253 listAllInfo
:: Path
-> MPD
[Either Path Song
]
254 listAllInfo
= lsInfo
' "listallinfo"
256 -- Helper for lsInfo and listAllInfo.
257 lsInfo
' :: String -> Path
-> MPD
[Either Path Song
]
258 lsInfo
' cmd path
= do
259 (dirs
,_
,songs
) <- takeEntries
=<< getResponse
(cmd
++ " " ++ show path
)
260 return (map Left dirs
++ map Right songs
)
262 -- | Search the database for entries exactly matching a query.
263 find :: Query
-> MPD
[Song
]
264 find query
= getResponse
("find " ++ show query
) >>= takeSongs
266 -- | Search the database using case insensitive matching.
267 search
:: Query
-> MPD
[Song
]
268 search query
= getResponse
("search " ++ show query
) >>= takeSongs
270 -- | Count the number of entries matching a query.
271 count
:: Query
-> MPD Count
272 count query
= getResponse
("count " ++ show query
) >>=
273 foldM f
empty . toAssoc
274 where f a
("songs", x
) = parse parseNum
275 (\x
' -> a
{ cSongs
= x
'}) x
276 f a
("playtime", x
) = parse parseNum
277 (\x
' -> a
{ cPlaytime
= x
' }) x
278 f _ x
= throwError
. Unexpected
$ show x
279 empty = Count
{ cSongs
= 0, cPlaytime
= 0 }
285 -- Unless otherwise noted all playlist commands operate on the current
288 -- This might do better to throw an exception than silently return 0.
289 -- | Like 'add', but returns a playlist id.
290 addId
:: Path
-> MPD
Integer
291 addId p
= getResponse1
("addid " ++ show p
) >>=
292 parse parseNum
id . snd . head . toAssoc
294 -- | Like 'add_' but returns a list of the files added.
295 add
:: PlaylistName
-> Path
-> MPD
[Path
]
296 add plname x
= add_ plname x
>> listAll x
298 -- | Add a song (or a whole directory) to a playlist.
299 -- Adds to current if no playlist is specified.
300 -- Will create a new playlist if the one specified does not already exist.
301 add_
:: PlaylistName
-> Path
-> MPD
()
302 add_
"" = getResponse_
. ("add " ++) . show
303 add_ plname
= getResponse_
.
304 (("playlistadd " ++ show plname
++ " ") ++) . show
306 -- | Clear a playlist. Clears current playlist if no playlist is specified.
307 -- If the specified playlist does not exist, it will be created.
308 clear
:: PlaylistName
-> MPD
()
309 clear
= getResponse_
. cmd
310 where cmd
"" = "clear"
311 cmd pl
= "playlistclear " ++ show pl
313 -- | Remove a song from a playlist.
314 -- If no playlist is specified, current playlist is used.
315 -- Note that a playlist position ('Pos') is required when operating on
316 -- playlists other than the current.
317 delete :: PlaylistName
-> PLIndex
-> MPD
()
318 delete "" (Pos x
) = getResponse_
("delete " ++ show x
)
319 delete "" (ID x
) = getResponse_
("deleteid " ++ show x
)
320 delete plname
(Pos x
) =
321 getResponse_
("playlistdelete " ++ show plname
++ " " ++ show x
)
322 delete _ _
= fail "'delete' within a playlist doesn't accept a playlist ID"
324 -- | Load an existing playlist.
325 load
:: PlaylistName
-> MPD
()
326 load
= getResponse_
. ("load " ++) . show
328 -- | Move a song to a given position.
329 -- Note that a playlist position ('Pos') is required when operating on
330 -- playlists other than the current.
331 move
:: PlaylistName
-> PLIndex
-> Integer -> MPD
()
332 move
"" (Pos from
) to
=
333 getResponse_
("move " ++ show from
++ " " ++ show to
)
334 move
"" (ID from
) to
=
335 getResponse_
("moveid " ++ show from
++ " " ++ show to
)
336 move plname
(Pos from
) to
=
337 getResponse_
("playlistmove " ++ show plname
++ " " ++ show from
++
339 move _ _ _
= fail "'move' within a playlist doesn't accept a playlist ID"
341 -- | Delete existing playlist.
342 rm
:: PlaylistName
-> MPD
()
343 rm
= getResponse_
. ("rm " ++) . show
345 -- | Rename an existing playlist.
346 rename
:: PlaylistName
-- ^ Original playlist
347 -> PlaylistName
-- ^ New playlist name
350 getResponse_
("rename " ++ show plname
++ " " ++ show new
)
352 -- | Save the current playlist.
353 save
:: PlaylistName
-> MPD
()
354 save
= getResponse_
. ("save " ++) . show
356 -- | Swap the positions of two songs.
357 -- Note that the positions must be of the same type, i.e. mixing 'Pos' and 'ID'
358 -- will result in a no-op.
359 swap
:: PLIndex
-> PLIndex
-> MPD
()
360 swap
(Pos x
) (Pos y
) = getResponse_
("swap " ++ show x
++ " " ++ show y
)
361 swap
(ID x
) (ID y
) = getResponse_
("swapid " ++ show x
++ " " ++ show y
)
362 swap _ _
= fail "'swap' cannot mix position and ID arguments"
364 -- | Shuffle the playlist.
366 shuffle
= getResponse_
"shuffle"
368 -- | Retrieve metadata for songs in the current playlist.
369 playlistInfo
:: Maybe PLIndex
-> MPD
[Song
]
370 playlistInfo x
= getResponse cmd
>>= takeSongs
371 where cmd
= case x
of
372 Just
(Pos x
') -> "playlistinfo " ++ show x
'
373 Just
(ID x
') -> "playlistid " ++ show x
'
374 Nothing
-> "playlistinfo"
376 -- | Retrieve metadata for files in a given playlist.
377 listPlaylistInfo
:: PlaylistName
-> MPD
[Song
]
378 listPlaylistInfo plname
=
379 takeSongs
=<< (getResponse
. ("listplaylistinfo " ++) $ show plname
)
381 -- | Retrieve a list of files in a given playlist.
382 listPlaylist
:: PlaylistName
-> MPD
[Path
]
383 listPlaylist
= liftM takeValues
. getResponse
. ("listplaylist " ++) . show
385 -- | Retrieve file paths and positions of songs in the current playlist.
386 -- Note that this command is only included for completeness sake; it's
387 -- deprecated and likely to disappear at any time, please use 'playlistInfo'
389 playlist
:: MPD
[(PLIndex
, Path
)]
390 playlist
= liftM (map f
) (getResponse
"playlist")
391 where f s
= let (pos
, name
) = breakChar
':' s
in
392 (Pos
$ read pos
, name
)
394 -- | Retrieve a list of changed songs currently in the playlist since
395 -- a given playlist version.
396 plChanges
:: Integer -> MPD
[Song
]
398 takeSongs
=<< (getResponse
. ("plchanges " ++) $ show version
)
400 -- | Like 'plChanges' but only returns positions and ids.
401 plChangesPosId
:: Integer -> MPD
[(PLIndex
, PLIndex
)]
402 plChangesPosId plver
=
403 getResponse
("plchangesposid " ++ show plver
) >>=
404 mapM f
. splitGroups
. toAssoc
405 where f xs |
[("cpos", x
), ("Id", y
)] <- xs
406 , Just
(x
', y
') <- pair parseNum
(x
, y
)
407 = return (Pos x
', ID y
')
408 |
otherwise = throwError
. Unexpected
$ show xs
410 -- | Search for songs in the current playlist with strict matching.
411 playlistFind
:: Query
-> MPD
[Song
]
412 playlistFind q
= takeSongs
=<< (getResponse
. ("playlistfind " ++) $ show q
)
414 -- | Search case-insensitively with partial matches for songs in the
416 playlistSearch
:: Query
-> MPD
[Song
]
418 takeSongs
=<< (getResponse
. ("playlistsearch " ++) $ show q
)
420 -- | Get the currently playing song.
421 currentSong
:: MPD
(Maybe Song
)
424 if stState cs
== Stopped
426 else getResponse1
"currentsong" >>= fmap Just
. takeSongInfo
. toAssoc
432 -- | Set crossfading between songs.
433 crossfade
:: Seconds
-> MPD
()
434 crossfade
= getResponse_
. ("crossfade " ++) . show
436 -- | Begin\/continue playing.
437 play
:: Maybe PLIndex
-> MPD
()
438 play Nothing
= getResponse_
"play"
439 play
(Just
(Pos x
)) = getResponse_
("play " ++ show x
)
440 play
(Just
(ID x
)) = getResponse_
("playid " ++ show x
)
443 pause
:: Bool -> MPD
()
444 pause
= getResponse_
. ("pause " ++) . showBool
448 stop
= getResponse_
"stop"
450 -- | Play the next song.
452 next = getResponse_
"next"
454 -- | Play the previous song.
456 previous
= getResponse_
"previous"
458 -- | Seek to some point in a song.
459 -- Seeks in current song if no position is given.
460 seek
:: Maybe PLIndex
-> Seconds
-> MPD
()
461 seek
(Just
(Pos x
)) time
=
462 getResponse_
("seek " ++ show x
++ " " ++ show time
)
463 seek
(Just
(ID x
)) time
=
464 getResponse_
("seekid " ++ show x
++ " " ++ show time
)
465 seek Nothing time
= do
467 unless (stState st
== Stopped
) (seek
(stSongID st
) time
)
469 -- | Set random playing.
470 random :: Bool -> MPD
()
471 random = getResponse_
. ("random " ++) . showBool
474 repeat :: Bool -> MPD
()
475 repeat = getResponse_
. ("repeat " ++) . showBool
477 -- | Set the volume (0-100 percent).
478 setVolume
:: Int -> MPD
()
479 setVolume
= getResponse_
. ("setvol " ++) . show
481 -- | Increase or decrease volume by a given percent, e.g.
482 -- 'volume 10' will increase the volume by 10 percent, while
483 -- 'volume (-10)' will decrease it by the same amount.
484 -- Note that this command is only included for completeness sake ; it's
485 -- deprecated and may disappear at any time, please use 'setVolume' instead.
486 volume
:: Int -> MPD
()
487 volume
= getResponse_
. ("volume " ++) . show
490 -- Miscellaneous commands
493 -- | Clear the current error message in status.
495 clearError
= getResponse_
"clearerror"
497 -- | Retrieve a list of available commands.
498 commands
:: MPD
[String]
499 commands
= liftM takeValues
(getResponse
"commands")
501 -- | Retrieve a list of unavailable (due to access restrictions) commands.
502 notCommands
:: MPD
[String]
503 notCommands
= liftM takeValues
(getResponse
"notcommands")
505 -- | Retrieve a list of available song metadata.
506 tagTypes
:: MPD
[String]
507 tagTypes
= liftM takeValues
(getResponse
"tagtypes")
509 -- | Retrieve a list of supported urlhandlers.
510 urlHandlers
:: MPD
[String]
511 urlHandlers
= liftM takeValues
(getResponse
"urlhandlers")
513 -- XXX should the password be quoted?
514 -- | Send password to server to authenticate session.
515 -- Password is sent as plain text.
516 password
:: String -> MPD
()
517 password
= getResponse_
. ("password " ++)
519 -- | Check that the server is still responding.
521 ping
= getResponse_
"ping"
523 -- | Get server statistics.
525 stats
= getResponse
"stats" >>= foldM f defaultStats
. toAssoc
527 f a
("artists", x
) = parse parseNum
(\x
' -> a
{ stsArtists
= x
' }) x
528 f a
("albums", x
) = parse parseNum
(\x
' -> a
{ stsAlbums
= x
' }) x
529 f a
("songs", x
) = parse parseNum
(\x
' -> a
{ stsSongs
= x
' }) x
530 f a
("uptime", x
) = parse parseNum
(\x
' -> a
{ stsUptime
= x
' }) x
531 f a
("playtime", x
) = parse parseNum
(\x
' -> a
{ stsPlaytime
= x
' }) x
532 f a
("db_playtime", x
) = parse parseNum
533 (\x
' -> a
{ stsDbPlaytime
= x
' }) x
534 f a
("db_update", x
) = parse parseNum
(\x
' -> a
{ stsDbUpdate
= x
' }) x
535 f _ x
= throwError
. Unexpected
$ show x
537 Stats
{ stsArtists
= 0, stsAlbums
= 0, stsSongs
= 0, stsUptime
= 0
538 , stsPlaytime
= 0, stsDbPlaytime
= 0, stsDbUpdate
= 0 }
540 -- | Get the server's status.
542 status
= getResponse
"status" >>= foldM f
empty . toAssoc
543 where f a
("state", x
) = parse state
(\x
' -> a
{ stState
= x
'}) x
544 f a
("volume", x
) = parse parseNum
(\x
' -> a
{ stVolume
= x
'}) x
545 f a
("repeat", x
) = parse parseBool
546 (\x
' -> a
{ stRepeat
= x
' }) x
547 f a
("random", x
) = parse parseBool
548 (\x
' -> a
{ stRandom
= x
' }) x
549 f a
("playlist", x
) = parse parseNum
550 (\x
' -> a
{ stPlaylistVersion
= x
'}) x
551 f a
("playlistlength", x
) = parse parseNum
552 (\x
' -> a
{ stPlaylistLength
= x
'}) x
553 f a
("xfade", x
) = parse parseNum
554 (\x
' -> a
{ stXFadeWidth
= x
'}) x
555 f a
("song", x
) = parse parseNum
556 (\x
' -> a
{ stSongPos
= Just
(Pos x
') }) x
557 f a
("songid", x
) = parse parseNum
558 (\x
' -> a
{ stSongID
= Just
(ID x
') }) x
559 f a
("time", x
) = parse time
(\x
' -> a
{ stTime
= x
' }) x
560 f a
("bitrate", x
) = parse parseNum
561 (\x
' -> a
{ stBitrate
= x
'}) x
562 f a
("audio", x
) = parse audio
(\x
' -> a
{ stAudio
= x
' }) x
563 f a
("updating_db", x
) = parse parseNum
564 (\x
' -> a
{ stUpdatingDb
= x
' }) x
565 f a
("error", x
) = return a
{ stError
= x
}
566 f _ x
= throwError
. Unexpected
$ show x
568 state
"play" = Just Playing
569 state
"pause" = Just Paused
570 state
"stop" = Just Stopped
573 time s
= pair parseNum
$ breakChar
':' s
575 audio s
= let (u
, u
') = breakChar
':' s
576 (v
, w
) = breakChar
':' u
' in
577 case (parseNum u
, parseNum v
, parseNum w
) of
578 (Just a
, Just b
, Just c
) -> Just
(a
, b
, c
)
581 empty = Status Stopped
0 False False 0 0 Nothing Nothing
(0,0) 0 0
585 -- Extensions\/shortcuts.
588 -- | Like 'update', but returns the update job id.
589 updateId
:: [Path
] -> MPD
Integer
590 updateId paths
= liftM (read . head . takeValues
) cmd
591 where cmd
= case paths
of
592 [] -> getResponse
"update"
593 [x
] -> getResponse
("update " ++ x
)
594 xs
-> getResponses
(map ("update " ++) xs
)
596 -- | Toggles play\/pause. Plays if stopped.
598 toggle
= status
>>= \st
-> case stState st
of Playing
-> pause
True
601 -- | Add a list of songs\/folders to a playlist.
602 -- Should be more efficient than running 'add' many times.
603 addMany
:: PlaylistName
-> [Path
] -> MPD
()
604 addMany _
[] = return ()
605 addMany plname
[x
] = add_ plname x
606 addMany plname xs
= getResponses
(map ((cmd
++) . show) xs
) >> return ()
607 where cmd
= case plname
of "" -> "add "
608 pl
-> "playlistadd " ++ show pl
++ " "
610 -- | Delete a list of songs from a playlist.
611 -- If there is a duplicate then no further songs will be deleted, so
612 -- take care to avoid them (see 'prune' for this).
613 deleteMany
:: PlaylistName
-> [PLIndex
] -> MPD
()
614 deleteMany _
[] = return ()
615 deleteMany plname
[x
] = delete plname x
616 deleteMany
"" xs
= getResponses
(map cmd xs
) >> return ()
617 where cmd
(Pos x
) = "delete " ++ show x
618 cmd
(ID x
) = "deleteid " ++ show x
619 deleteMany plname xs
= getResponses
(map cmd xs
) >> return ()
620 where cmd
(Pos x
) = "playlistdelete " ++ show plname
++ " " ++ show x
623 -- | Returns all songs and directories that match the given partial
625 complete
:: String -> MPD
[Either Path Song
]
627 xs
<- liftM matches
. lsInfo
$ dropFileName path
629 [Left dir
] -> complete
$ dir
++ "/"
632 matches
= filter (isPrefixOf path
. takePath
)
633 takePath
= either id sgFilePath
636 -- The bounds are inclusive.
637 -- If 'Nothing' or 'ID' is passed the cropping will leave your playlist alone
639 crop
:: Maybe PLIndex
-> Maybe PLIndex
-> MPD
()
641 pl
<- playlistInfo Nothing
642 let x
' = case x
of Just
(Pos p
) -> fromInteger p
643 Just
(ID i
) -> fromMaybe 0 (findByID i pl
)
645 -- ensure that no songs are deleted twice with 'max'.
646 ys
= case y
of Just
(Pos p
) -> drop (max (fromInteger p
) x
') pl
647 Just
(ID i
) -> maybe [] (flip drop pl
. max x
' . (+1))
650 deleteMany
"" . mapMaybe sgIndex
$ take x
' pl
++ ys
651 where findByID i
= findIndex ((==) i
. (\(ID j
) -> j
) . fromJust . sgIndex
)
653 -- | Remove duplicate playlist entries.
655 prune
= findDuplicates
>>= deleteMany
""
657 -- Find duplicate playlist entries.
658 findDuplicates
:: MPD
[PLIndex
]
660 liftM (map ((\(ID x
) -> ID x
) . fromJust . sgIndex
) . flip dups
([],[])) $
662 where dups
[] (_
, dup
) = dup
663 dups
(x
:xs
) (ys
, dup
)
664 | x `
elem` xs
&& x `
notElem` ys
= dups xs
(ys
, x
:dup
)
665 |
otherwise = dups xs
(x
:ys
, dup
)
667 -- | List directories non-recursively.
668 lsDirs
:: Path
-> MPD
[Path
]
669 lsDirs path
= liftM (\(x
,_
,_
) -> x
) $
670 takeEntries
=<< getResponse
("lsinfo " ++ show path
)
672 -- | List files non-recursively.
673 lsFiles
:: Path
-> MPD
[Path
]
674 lsFiles path
= liftM (map sgFilePath
. (\(_
,_
,x
) -> x
)) $
675 takeEntries
=<< getResponse
("lsinfo " ++ show path
)
677 -- | List all playlists.
678 lsPlaylists
:: MPD
[PlaylistName
]
679 lsPlaylists
= liftM (\(_
,x
,_
) -> x
) $ takeEntries
=<< getResponse
"lsinfo"
681 -- | Search the database for songs relating to an artist.
682 findArtist
:: Artist
-> MPD
[Song
]
683 findArtist
= find . Query Artist
685 -- | Search the database for songs relating to an album.
686 findAlbum
:: Album
-> MPD
[Song
]
687 findAlbum
= find . Query Album
689 -- | Search the database for songs relating to a song title.
690 findTitle
:: Title
-> MPD
[Song
]
691 findTitle
= find . Query Title
693 -- | List the artists in the database.
694 listArtists
:: MPD
[Artist
]
695 listArtists
= liftM takeValues
(getResponse
"list artist")
697 -- | List the albums in the database, optionally matching a given
699 listAlbums
:: Maybe Artist
-> MPD
[Album
]
700 listAlbums artist
= liftM takeValues
(getResponse
("list album" ++
701 maybe "" ((" artist " ++) . show) artist
))
703 -- | List the songs in an album of some artist.
704 listAlbum
:: Artist
-> Album
-> MPD
[Song
]
705 listAlbum artist album
= find (MultiQuery
[Query Artist artist
708 -- | Search the database for songs relating to an artist using 'search'.
709 searchArtist
:: Artist
-> MPD
[Song
]
710 searchArtist
= search
. Query Artist
712 -- | Search the database for songs relating to an album using 'search'.
713 searchAlbum
:: Album
-> MPD
[Song
]
714 searchAlbum
= search
. Query Album
716 -- | Search the database for songs relating to a song title.
717 searchTitle
:: Title
-> MPD
[Song
]
718 searchTitle
= search
. Query Title
720 -- | Retrieve the current playlist.
721 -- Equivalent to @playlistinfo Nothing@.
722 getPlaylist
:: MPD
[Song
]
723 getPlaylist
= playlistInfo Nothing
726 -- Miscellaneous functions.
729 -- Run getResponse but discard the response.
730 getResponse_
:: String -> MPD
()
731 getResponse_ x
= getResponse x
>> return ()
733 -- Get the lines of the daemon's response to a list of commands.
734 getResponses
:: [String] -> MPD
[String]
735 getResponses cmds
= getResponse
. concat $ intersperse "\n" cmds
'
736 where cmds
' = "command_list_begin" : cmds
++ ["command_list_end"]
738 -- Helper that throws unexpected error if input is empty.
739 failOnEmpty
:: [String] -> MPD
[String]
740 failOnEmpty
[] = throwError
$ Unexpected
"Non-empty response expected."
741 failOnEmpty xs
= return xs
743 -- A wrapper for getResponse that fails on non-empty responses.
744 getResponse1
:: String -> MPD
[String]
745 getResponse1 x
= getResponse x
>>= failOnEmpty
751 -- Run 'toAssoc' and return only the values.
752 takeValues
:: [String] -> [String]
753 takeValues
= snd . unzip . toAssoc
755 -- Separate the result of an lsinfo\/listallinfo call into directories,
756 -- playlists, and songs.
757 takeEntries
:: [String] -> MPD
([String], [String], [Song
])
759 ss
<- mapM takeSongInfo
. splitGroups
$ reverse filedata
760 return (dirs
, playlists
, ss
)
761 where (dirs
, playlists
, filedata
) = foldl split ([], [], []) $ toAssoc s
762 split (ds
, pls
, ss
) x
@(k
, v
) | k
== "directory" = (v
:ds
, pls
, ss
)
763 | k
== "playlist" = (ds
, v
:pls
, ss
)
764 |
otherwise = (ds
, pls
, x
:ss
)
766 -- Build a list of song instances from a response.
767 takeSongs
:: [String] -> MPD
[Song
]
768 takeSongs
= mapM takeSongInfo
. splitGroups
. toAssoc
770 -- Builds a song instance from an assoc. list.
771 takeSongInfo
:: [(String, String)] -> MPD Song
772 takeSongInfo xs
= foldM f song xs
773 where f a
("Artist", x
) = return a
{ sgArtist
= x
}
774 f a
("Album", x
) = return a
{ sgAlbum
= x
}
775 f a
("Title", x
) = return a
{ sgTitle
= x
}
776 f a
("Genre", x
) = return a
{ sgGenre
= x
}
777 f a
("Name", x
) = return a
{ sgName
= x
}
778 f a
("Composer", x
) = return a
{ sgComposer
= x
}
779 f a
("Performer", x
) = return a
{ sgPerformer
= x
}
780 f a
("Date", x
) = parse parseDate
(\x
' -> a
{ sgDate
= x
' }) x
781 f a
("Track", x
) = parse parseTuple
(\x
' -> a
{ sgTrack
= x
'}) x
782 f a
("Disc", x
) = parse parseTuple
(\x
' -> a
{ sgDisc
= x
'}) x
783 f a
("file", x
) = return a
{ sgFilePath
= x
}
784 f a
("Time", x
) = parse parseNum
(\x
' -> a
{ sgLength
= x
'}) x
785 f a
("Id", x
) = parse parseNum
786 (\x
' -> a
{ sgIndex
= Just
(ID x
') }) x
788 f a
("Pos", _
) = return a
789 -- Catch unrecognised keys
790 f _ x
= throwError
. Unexpected
$ show x
792 parseTuple s
= let (x
, y
) = breakChar
'/' s
in
793 -- Handle incomplete values. For example, songs might
794 -- have a track number, without specifying the total
795 -- number of tracks, in which case the resulting
796 -- tuple will have two identical parts.
797 case (parseNum x
, parseNum y
) of
798 (Just x
', Nothing
) -> Just
(x
', x
')
799 (Just x
', Just y
') -> Just
(x
', y
')
802 song
= Song
{ sgArtist
= "", sgAlbum
= "", sgTitle
= ""
803 , sgGenre
= "", sgName
= "", sgComposer
= ""
804 , sgPerformer
= "", sgDate
= 0, sgTrack
= (0,0)
805 , sgDisc
= (0,0), sgFilePath
= "", sgLength
= 0
806 , sgIndex
= Nothing
}
808 -- A helper that runs a parser on a string and, depending, on the outcome,
809 -- either returns the result of some command applied to the result, or throws
810 -- an Unexpected error. Used when building structures.
811 parse
:: (String -> Maybe a
) -> (a
-> b
) -> String -> MPD b
812 parse p g x
= maybe (throwError
$ Unexpected x
) (return . g
) (p x
)
814 -- A helper for running a parser returning Maybe on a pair of strings.
815 -- Returns Just if both strings where parsed successfully, Nothing otherwise.
816 pair
:: (String -> Maybe a
) -> (String, String) -> Maybe (a
, a
)
817 pair p
(x
, y
) = case (p x
, p y
) of
818 (Just a
, Just b
) -> Just
(a
, b
)