Copyright | (c) Joachim Fasting, Simon Hengel 2012 |
---|---|
License | MIT |
Maintainer | Joachim Fasting <joachifm@fastmail.fm> |
Stability | unstable |
Portability | unportable |
Safe Haskell | None |
Language | Haskell2010 |
An MPD client library. MPD is a daemon for playing music that is controlled over a network socket.
To use the library, do:
import qualified Network.MPD as MPD
- class (Monad m, MonadError MPDError m) => MonadMPD m
- data MPD a
- data MPDError
- data ACKType
- type Response = Either MPDError
- type Host = String
- type Port = Integer
- type Password = String
- withMPD :: MPD a -> IO (Response a)
- withMPD_ :: Maybe String -> Maybe String -> MPD a -> IO (Response a)
- withMPDEx :: Host -> Port -> Password -> MPD a -> IO (Response a)
- data Query
- (=?) :: Metadata -> Value -> Query
- (<&>) :: Query -> Query -> Query
- anything :: Query
- class ToString a where
- type Artist = Value
- type Album = Value
- type Title = Value
- newtype PlaylistName = PlaylistName ByteString
- data Path
- data Metadata
- data Value
- data ObjectType = SongObj
- type Seconds = Integer
- type Decibels = Integer
- data State
- data Subsystem
- data ReplayGainMode
- data Count = Count {}
- data LsResult
- data Device = Device {
- dOutputID :: Int
- dOutputName :: String
- dOutputEnabled :: Bool
- data Song = Song {}
- type Position = Int
- newtype Id = Id Int
- sgGetTag :: Metadata -> Song -> Maybe [Value]
- sgAddTag :: Metadata -> Value -> Song -> Song
- data Stats = Stats {}
- data Status = Status {
- stState :: State
- stVolume :: Maybe Int
- stRepeat :: Bool
- stRandom :: Bool
- stPlaylistVersion :: Integer
- stPlaylistLength :: Integer
- stSongPos :: Maybe Position
- stSongID :: Maybe Id
- stNextSongPos :: Maybe Position
- stNextSongID :: Maybe Id
- stTime :: Maybe (Double, Seconds)
- stBitrate :: Maybe Int
- stXFadeWidth :: Seconds
- stMixRampdB :: Double
- stMixRampDelay :: Double
- stAudio :: (Int, Int, Int)
- stUpdatingDb :: Maybe Integer
- stSingle :: Bool
- stConsume :: Bool
- stError :: Maybe String
- def :: Default a => a
- clearError :: MonadMPD m => m ()
- currentSong :: MonadMPD m => m (Maybe Song)
- idle :: MonadMPD m => [Subsystem] -> m [Subsystem]
- noidle :: MonadMPD m => m ()
- stats :: MonadMPD m => m Stats
- status :: MonadMPD m => m Status
- consume :: MonadMPD m => Bool -> m ()
- crossfade :: MonadMPD m => Seconds -> m ()
- random :: MonadMPD m => Bool -> m ()
- repeat :: MonadMPD m => Bool -> m ()
- setVolume :: MonadMPD m => Int -> m ()
- single :: MonadMPD m => Bool -> m ()
- replayGainMode :: MonadMPD m => ReplayGainMode -> m ()
- replayGainStatus :: MonadMPD m => m [(String, String)]
- next :: MonadMPD m => m ()
- pause :: MonadMPD m => Bool -> m ()
- play :: MonadMPD m => Maybe Position -> m ()
- playId :: MonadMPD m => Id -> m ()
- previous :: MonadMPD m => m ()
- seek :: MonadMPD m => Position -> Seconds -> m ()
- seekId :: MonadMPD m => Id -> Seconds -> m ()
- stop :: MonadMPD m => m ()
- addId :: MonadMPD m => Path -> Maybe Position -> m Id
- add :: MonadMPD m => Path -> m ()
- clear :: MonadMPD m => m ()
- delete :: MonadMPD m => Position -> m ()
- deleteId :: MonadMPD m => Id -> m ()
- move :: MonadMPD m => Position -> Position -> m ()
- moveId :: MonadMPD m => Id -> Position -> m ()
- playlist :: MonadMPD m => m [(Position, Path)]
- playlistFind :: MonadMPD m => Query -> m [Song]
- playlistInfo :: MonadMPD m => Maybe Position -> m [Song]
- playlistInfoRange :: MonadMPD m => Maybe (Position, Position) -> m [Song]
- playlistId :: MonadMPD m => Maybe Id -> m [Song]
- playlistSearch :: MonadMPD m => Query -> m [Song]
- plChanges :: MonadMPD m => Integer -> m [Song]
- plChangesPosId :: MonadMPD m => Integer -> m [(Position, Id)]
- shuffle :: MonadMPD m => Maybe (Position, Position) -> m ()
- swap :: MonadMPD m => Position -> Position -> m ()
- swapId :: MonadMPD m => Id -> Id -> m ()
- listPlaylist :: MonadMPD m => PlaylistName -> m [Path]
- listPlaylistInfo :: MonadMPD m => PlaylistName -> m [Song]
- listPlaylists :: MonadMPD m => m [PlaylistName]
- load :: MonadMPD m => PlaylistName -> m ()
- playlistAdd :: MonadMPD m => PlaylistName -> Path -> m ()
- playlistClear :: MonadMPD m => PlaylistName -> m ()
- playlistDelete :: MonadMPD m => PlaylistName -> Position -> m ()
- playlistMove :: MonadMPD m => PlaylistName -> Id -> Position -> m ()
- rename :: MonadMPD m => PlaylistName -> PlaylistName -> m ()
- rm :: MonadMPD m => PlaylistName -> m ()
- save :: MonadMPD m => PlaylistName -> m ()
- count :: MonadMPD m => Query -> m Count
- find :: MonadMPD m => Query -> m [Song]
- findAdd :: MonadMPD m => Query -> m ()
- list :: MonadMPD m => Metadata -> Maybe Artist -> m [Value]
- listAll :: MonadMPD m => Path -> m [Path]
- listAllInfo :: MonadMPD m => Path -> m [LsResult]
- lsInfo :: MonadMPD m => Path -> m [LsResult]
- search :: MonadMPD m => Query -> m [Song]
- update :: MonadMPD m => Maybe Path -> m Integer
- rescan :: MonadMPD m => Maybe Path -> m Integer
- stickerGet :: MonadMPD m => ObjectType -> String -> String -> m [String]
- stickerSet :: MonadMPD m => ObjectType -> String -> String -> String -> m ()
- stickerDelete :: MonadMPD m => ObjectType -> String -> String -> m ()
- stickerList :: MonadMPD m => ObjectType -> String -> m [(String, String)]
- stickerFind :: MonadMPD m => ObjectType -> String -> String -> m [(String, String)]
- password :: MonadMPD m => String -> m ()
- ping :: MonadMPD m => m ()
- disableOutput :: MonadMPD m => Int -> m ()
- enableOutput :: MonadMPD m => Int -> m ()
- outputs :: MonadMPD m => m [Device]
- commands :: MonadMPD m => m [String]
- notCommands :: MonadMPD m => m [String]
- tagTypes :: MonadMPD m => m [String]
- urlHandlers :: MonadMPD m => m [String]
- decoders :: MonadMPD m => m [(String, [(String, String)])]
- config :: MonadMPD m => m [(String, String)]
- type ChannelName = String
- type MessageText = String
- subscribe :: MonadMPD m => ChannelName -> m ()
- unsubscribe :: MonadMPD m => ChannelName -> m ()
- channels :: MonadMPD m => m [ChannelName]
- readMessages :: MonadMPD m => m [(ChannelName, MessageText)]
- sendMessage :: MonadMPD m => ChannelName -> MessageText -> m ()
Basic data types
class (Monad m, MonadError MPDError m) => MonadMPD m Source
A typeclass to allow for multiple implementations of a connection to an MPD server.
The main implementation of an MPD client. It actually connects to a server and interacts with it.
To use the error throwing/catching capabilities:
import Control.Monad.Error (throwError, catchError)
To run IO actions within the MPD monad:
import Control.Monad.Trans (liftIO)
The MPDError type is used to signal errors, both from the MPD and otherwise.
NoMPD | MPD not responding |
ConnectionError IOException | An error occurred while talking to MPD. |
Unexpected String | MPD returned an unexpected response. This is a bug, either in the library or in MPD itself. |
Custom String | Used for misc. errors |
ACK ACKType String | ACK type and a message from the server |
Represents various MPD errors (aka. ACKs).
InvalidArgument | Invalid argument passed (ACK 2) |
InvalidPassword | Invalid password supplied (ACK 3) |
Auth | Authentication required (ACK 4) |
UnknownCommand | Unknown command (ACK 5) |
FileNotFound | File or directory not found ACK 50) |
PlaylistMax | Playlist at maximum size (ACK 51) |
System | A system error (ACK 52) |
PlaylistLoad | Playlist loading failed (ACK 53) |
Busy | Update already running (ACK 54) |
NotPlaying | An operation requiring playback got interrupted (ACK 55) |
FileExists | File already exists (ACK 56) |
UnknownACK | An unknown ACK (aka. bug) |
Connections
withMPD :: MPD a -> IO (Response a) Source
A wrapper for withMPDEx
that uses localhost:6600 as the default
host:port, or whatever is found in the environment variables MPD_HOST and
MPD_PORT. If MPD_HOST is of the form "password@host" the password
will be supplied as well.
Examples:
withMPD $ play Nothing withMPD $ add_ "tool" >> play Nothing >> currentSong
withMPDEx :: Host -> Port -> Password -> MPD a -> IO (Response a) Source
The most configurable API for running an MPD action.
An interface for creating MPD queries.
For example, to match any song where the value of artist is "Foo", we use:
Artist =? "Foo"
We can also compose queries, thus narrowing the search. For example, to match any song where the value of artist is "Foo" and the value of album is "Bar", we use:
Artist =? "Foo" <&> Album =? "Bar"
A type class for values that can be converted to String
s.
toString :: a -> String Source
Convert given value to String
.
Convert given value to Text
.
toUtf8 :: a -> ByteString Source
Convert given value to a UTF-8 encoded ByteString
.
newtype PlaylistName Source
Used for commands which require a playlist name. If empty, the current playlist is used.
Used for commands which require a path within the database. If empty, the root path is used.
Available metadata types/scope modifiers, used for searching the database for entries with certain metadata values.
Represents the different playback states.
Represents the various MPD subsystems.
data ReplayGainMode Source
Represents the result of running count
.
Result of the lsInfo operation
LsDirectory Path | Directory |
LsSong Song | Song |
LsPlaylist PlaylistName | Playlist |
Represents an output device.
Device | |
|
Represents a single song item.
Container for database statistics.
Stats | |
|
Container for MPD status.
Status | |
|
clearError :: MonadMPD m => m () Source
Clear the current error message in status.
currentSong :: MonadMPD m => m (Maybe Song) Source
Get the currently playing song.
idle :: MonadMPD m => [Subsystem] -> m [Subsystem] Source
Wait until there is a noteworthy change in one or more of MPD's susbystems.
The first argument is a list of subsystems that should be considered. An empty list specifies that all subsystems should be considered.
A list of subsystems that have noteworthy changes is returned.
Note that running this command will block until either idle
returns or is
cancelled by noidle
.
replayGainMode :: MonadMPD m => ReplayGainMode -> m () Source
Set the replay gain mode.
replayGainStatus :: MonadMPD m => m [(String, String)] Source
Get the replay gain options.
move :: MonadMPD m => Position -> Position -> m () Source
Move a song to a given position in the current playlist.
moveId :: MonadMPD m => Id -> Position -> m () Source
Move a song from (songid) to (playlist index) in the playlist. If to is negative, it is relative to the current song in the playlist (if there is one).
playlist :: MonadMPD m => m [(Position, Path)] Source
Warning: this is deprecated; please use playlistInfo
instead.
Retrieve file paths and positions of songs in the current playlist.
Note that this command is only included for completeness sake; it's
deprecated and likely to disappear at any time, please use playlistInfo
instead.
playlistFind :: MonadMPD m => Query -> m [Song] Source
Search for songs in the current playlist with strict matching.
playlistInfo :: MonadMPD m => Maybe Position -> m [Song] Source
Retrieve metadata for songs in the current playlist.
playlistInfoRange :: MonadMPD m => Maybe (Position, Position) -> m [Song] Source
Like playlistInfo
but can restrict to a range of songs.
playlistId :: MonadMPD m => Maybe Id -> m [Song] Source
Displays a list of songs in the playlist. If id is specified, only its info is returned.
playlistSearch :: MonadMPD m => Query -> m [Song] Source
Search case-insensitively with partial matches for songs in the current playlist.
plChanges :: MonadMPD m => Integer -> m [Song] Source
Retrieve a list of changed songs currently in the playlist since a given playlist version.
plChangesPosId :: MonadMPD m => Integer -> m [(Position, Id)] Source
Like plChanges
but only returns positions and ids.
Shuffle the playlist.
listPlaylist :: MonadMPD m => PlaylistName -> m [Path] Source
Retrieve a list of files in a given playlist.
listPlaylistInfo :: MonadMPD m => PlaylistName -> m [Song] Source
Retrieve metadata for files in a given playlist.
listPlaylists :: MonadMPD m => m [PlaylistName] Source
Retreive a list of stored playlists.
load :: MonadMPD m => PlaylistName -> m () Source
Load an existing playlist.
playlistAdd :: MonadMPD m => PlaylistName -> Path -> m () Source
Add a song (or a whole directory) to a stored playlist. Will create a new playlist if the one specified does not already exist.
playlistClear :: MonadMPD m => PlaylistName -> m () Source
Clear a playlist. If the specified playlist does not exist, it will be created.
playlistDelete :: MonadMPD m => PlaylistName -> Position -> m () Source
Remove a song from a playlist.
playlistMove :: MonadMPD m => PlaylistName -> Id -> Position -> m () Source
Move a song to a given position in the playlist specified.
:: MonadMPD m | |
=> PlaylistName | Original playlist |
-> PlaylistName | New playlist name |
-> m () |
Rename an existing playlist.
rm :: MonadMPD m => PlaylistName -> m () Source
Delete existing playlist.
save :: MonadMPD m => PlaylistName -> m () Source
Save the current playlist.
find :: MonadMPD m => Query -> m [Song] Source
Search the database for entries exactly matching a query.
List all tags of the specified type.
listAll :: MonadMPD m => Path -> m [Path] Source
List the songs (without metadata) in a database directory recursively.
lsInfo :: MonadMPD m => Path -> m [LsResult] Source
Non-recursively list the contents of a database directory.
search :: MonadMPD m => Query -> m [Song] Source
Search the database using case insensitive matching.
update :: MonadMPD m => Maybe Path -> m Integer Source
Update the server's database.
If no path is given, the whole library will be scanned. Unreadable or non-existent paths are silently ignored.
The update job id is returned.
rescan :: MonadMPD m => Maybe Path -> m Integer Source
Like update
but also rescans unmodified files.
:: MonadMPD m | |
=> ObjectType | |
-> String | Object URI |
-> String | Sticker name |
-> m [String] |
Reads a sticker value for the specified object.
:: MonadMPD m | |
=> ObjectType | |
-> String | Object URI |
-> String | Sticker name |
-> String | Sticker value |
-> m () |
Adds a sticker value to the specified object.
:: MonadMPD m | |
=> ObjectType | |
-> String | Object URI |
-> String | Sticker name |
-> m () |
Delete a sticker value from the specified object.
:: MonadMPD m | |
=> ObjectType | |
-> String | Object URI |
-> m [(String, String)] | Sticker name/sticker value |
Lists the stickers for the specified object.
:: MonadMPD m | |
=> ObjectType | |
-> String | Path |
-> String | Sticker name |
-> m [(String, String)] | URI/sticker value |
Searches the sticker database for stickers with the specified name, below the specified path.
password :: MonadMPD m => String -> m () Source
Send password to server to authenticate session. Password is sent as plain text.
disableOutput :: MonadMPD m => Int -> m () Source
Turn off an output device.
enableOutput :: MonadMPD m => Int -> m () Source
Turn on an output device.
notCommands :: MonadMPD m => m [String] Source
Retrieve a list of unavailable (due to access restrictions) commands.
urlHandlers :: MonadMPD m => m [String] Source
Retrieve a list of supported urlhandlers.
decoders :: MonadMPD m => m [(String, [(String, String)])] Source
Retreive a list of decoder plugins with associated suffix and mime types.
Types
type ChannelName = String Source
type MessageText = String Source
Subscribing to channels
subscribe :: MonadMPD m => ChannelName -> m () Source
unsubscribe :: MonadMPD m => ChannelName -> m () Source
channels :: MonadMPD m => m [ChannelName] Source
Communicating with other clients
readMessages :: MonadMPD m => m [(ChannelName, MessageText)] Source
sendMessage :: MonadMPD m => ChannelName -> MessageText -> m () Source