Stability | alpha |
---|---|
Maintainer | Joachim Fasting <joachim.fasting@gmail.com> |
Safe Haskell | None |
Network.MPD
Contents
Description
An MPD client library. MPD is a daemon for playing music that is controlled over a network socket. Its site is at http://www.musicpd.org/.
To use the library, do:
{-# LANGUAGE OverloadedStrings #-} import qualified Network.MPD as MPD
- class (Monad m, MonadError MPDError m) => MonadMPD m where
- close :: m ()
- data MPD a
- data MPDError
- data ACKType
- = InvalidArgument
- | InvalidPassword
- | Auth
- | UnknownCommand
- | FileNotFound
- | PlaylistMax
- | System
- | PlaylistLoad
- | Busy
- | NotPlaying
- | FileExists
- | UnknownACK
- 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)
- class ToString a where
- type Artist = Value
- type Album = Value
- type Title = Value
- newtype PlaylistName = PlaylistName ByteString
- newtype Path = Path ByteString
- data Metadata
- newtype Value = Value ByteString
- data ObjectType = SongObj
- type Seconds = Integer
- data State
- data Subsystem
- data ReplayGainMode
- data Count = Count {}
- defaultCount :: Count
- data LsResult
- data Device = Device {
- dOutputID :: Int
- dOutputName :: String
- dOutputEnabled :: Bool
- defaultDevice :: Device
- data Song = Song {}
- newtype Id = Id Int
- sgGetTag :: Metadata -> Song -> Maybe [Value]
- sgAddTag :: Metadata -> Value -> Song -> Song
- defaultSong :: Path -> Song
- data Stats = Stats {}
- defaultStats :: Stats
- data Status = Status {
- stState :: State
- stVolume :: Int
- stRepeat :: Bool
- stRandom :: Bool
- stPlaylistVersion :: Integer
- stPlaylistLength :: Integer
- stSongPos :: Maybe Int
- stSongID :: Maybe Id
- stNextSongPos :: Maybe Int
- stNextSongID :: Maybe Id
- stTime :: (Double, Seconds)
- stBitrate :: Int
- stXFadeWidth :: Seconds
- stMixRampdB :: Double
- stMixRampDelay :: Double
- stAudio :: (Int, Int, Int)
- stUpdatingDb :: Integer
- stSingle :: Bool
- stConsume :: Bool
- stError :: Maybe String
- defaultStatus :: Status
- data Query
- (=?) :: Metadata -> Value -> Query
- (<&>) :: Query -> Query -> Query
- anything :: Query
- clearError :: MonadMPD m => m ()
- currentSong :: (Functor m, MonadMPD m) => m (Maybe Song)
- idle :: MonadMPD m => [Subsystem] -> m [Subsystem]
- noidle :: MonadMPD m => m ()
- status :: MonadMPD m => m Status
- stats :: MonadMPD m => m Stats
- 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]
- next :: MonadMPD m => m ()
- pause :: MonadMPD m => Bool -> m ()
- play :: MonadMPD m => Maybe Int -> m ()
- playId :: MonadMPD m => Id -> m ()
- previous :: MonadMPD m => m ()
- seek :: MonadMPD m => Int -> Seconds -> m ()
- seekId :: MonadMPD m => Id -> Seconds -> m ()
- stop :: MonadMPD m => m ()
- add :: MonadMPD m => Path -> m [Path]
- add_ :: MonadMPD m => Path -> m ()
- addId :: MonadMPD m => Path -> Maybe Integer -> m Id
- clear :: MonadMPD m => m ()
- delete :: MonadMPD m => Int -> m ()
- deleteId :: MonadMPD m => Id -> m ()
- move :: MonadMPD m => Int -> Int -> m ()
- moveId :: MonadMPD m => Id -> Int -> m ()
- playlist :: MonadMPD m => m [(Int, Path)]
- playlistId :: MonadMPD m => Maybe Id -> m [Song]
- playlistFind :: MonadMPD m => Query -> m [Song]
- playlistInfo :: MonadMPD m => Maybe (Int, Int) -> m [Song]
- playlistSearch :: MonadMPD m => Query -> m [Song]
- plChanges :: MonadMPD m => Integer -> m [Song]
- plChangesPosId :: MonadMPD m => Integer -> m [(Int, Id)]
- shuffle :: MonadMPD m => Maybe (Int, Int) -> m ()
- swap :: MonadMPD m => Int -> Int -> 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 [Path]
- playlistAdd_ :: MonadMPD m => PlaylistName -> Path -> m ()
- playlistClear :: MonadMPD m => PlaylistName -> m ()
- playlistDelete :: MonadMPD m => PlaylistName -> Integer -> m ()
- playlistMove :: MonadMPD m => PlaylistName -> Integer -> Integer -> 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 -> Query -> 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 => [Path] -> m ()
- rescan :: MonadMPD m => [Path] -> m ()
- 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)]
- close :: MonadMPD m => m ()
- kill :: MonadMPD m => m ()
- 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)])]
Basic data types
class (Monad m, MonadError MPDError m) => MonadMPD m where
A typeclass to allow for multiple implementations of a connection to an MPD server.
data MPD a
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)
data MPDError
The MPDError type is used to signal errors, both from the MPD and otherwise.
data ACKType
Represents various MPD errors (aka. ACKs).
Constructors
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)
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)
The most configurable API for running an MPD action.
Command related data types
class ToString a where
A type class for values that can be converted to String
s.
Methods
Convert given value to String
.
Convert given value to Text
.
toUtf8 :: a -> ByteString
Convert given value an UTF-8 encoded ByteString
.
newtype PlaylistName
Used for commands which require a playlist name. If empty, the current playlist is used.
Constructors
PlaylistName ByteString |
newtype Path
Used for commands which require a path within the database. If empty, the root path is used.
Constructors
Path ByteString |
data Metadata
Available metadata types/scope modifiers, used for searching the database for entries with certain metadata values.
data State
Represents the different playback states.
data Subsystem
Represents the various MPD subsystems.
data ReplayGainMode
Instances
data LsResult
Result of the lsInfo operation
Constructors
LsDirectory Path | Directory |
LsSong Song | Song |
LsPlaylist PlaylistName | Playlist |
data Device
Represents an output device.
Constructors
Device | |
Fields
|
defaultSong :: Path -> Song
data Stats
Container for database statistics.
Constructors
Stats | |
Fields
|
data Status
Container for MPD status.
Constructors
Status | |
Fields
|
Query interface
data Query
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"
Querying MPD's status
clearError :: MonadMPD m => m ()
Clear the current error message in status.
currentSong :: (Functor m, MonadMPD m) => m (Maybe Song)
Get the currently playing song.
idle :: MonadMPD m => [Subsystem] -> m [Subsystem]
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
.
Playback options
replayGainMode :: MonadMPD m => ReplayGainMode -> m ()
Set the replay gain mode.
replayGainStatus :: MonadMPD m => m [String]
Get the replay gain options.
Controlling playback
The current playlist
Like add
, but returns a playlist id.
moveId :: MonadMPD m => Id -> Int -> m ()
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 [(Int, Path)]
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.
playlistId :: MonadMPD m => Maybe Id -> m [Song]
Displays a list of songs in the playlist. If id is specified, only its info is returned.
playlistFind :: MonadMPD m => Query -> m [Song]
Search for songs in the current playlist with strict matching.
playlistInfo :: MonadMPD m => Maybe (Int, Int) -> m [Song]
Retrieve metadata for songs in the current playlist.
playlistSearch :: MonadMPD m => Query -> m [Song]
Search case-insensitively with partial matches for songs in the current playlist.
plChanges :: MonadMPD m => Integer -> m [Song]
Retrieve a list of changed songs currently in the playlist since a given playlist version.
plChangesPosId :: MonadMPD m => Integer -> m [(Int, Id)]
Like plChanges
but only returns positions and ids.
Shuffle the playlist.
Stored playlist
listPlaylist :: MonadMPD m => PlaylistName -> m [Path]
Retrieve a list of files in a given playlist.
listPlaylistInfo :: MonadMPD m => PlaylistName -> m [Song]
Retrieve metadata for files in a given playlist.
listPlaylists :: MonadMPD m => m [PlaylistName]
Retreive a list of stored playlists.
load :: MonadMPD m => PlaylistName -> m ()
Load an existing playlist.
playlistAdd :: MonadMPD m => PlaylistName -> Path -> m [Path]
Like playlistAdd
but returns a list of the files added.
playlistAdd_ :: MonadMPD m => PlaylistName -> Path -> m ()
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 ()
Clear a playlist. If the specified playlist does not exist, it will be created.
Arguments
:: MonadMPD m | |
=> PlaylistName | |
-> Integer | Playlist position |
-> m () |
Remove a song from a playlist.
playlistMove :: MonadMPD m => PlaylistName -> Integer -> Integer -> m ()
Move a song to a given position in the playlist specified.
Arguments
:: MonadMPD m | |
=> PlaylistName | Original playlist |
-> PlaylistName | New playlist name |
-> m () |
Rename an existing playlist.
rm :: MonadMPD m => PlaylistName -> m ()
Delete existing playlist.
save :: MonadMPD m => PlaylistName -> m ()
Save the current playlist.
The music database
List all tags of the specified type.
listAll :: MonadMPD m => Path -> m [Path]
List the songs (without metadata) in a database directory recursively.
listAllInfo :: MonadMPD m => Path -> m [LsResult]
Recursive lsInfo
.
lsInfo :: MonadMPD m => Path -> m [LsResult]
Non-recursively list the contents of a database directory.
update :: MonadMPD m => [Path] -> m ()
Update the server's database. If no paths are given, all paths will be scanned. Unreadable or non-existent paths are silently ignored.
Stickers
Arguments
:: MonadMPD m | |
=> ObjectType | |
-> String | Object URI |
-> String | Sticker name |
-> m [String] |
Reads a sticker value for the specified object.
Arguments
:: MonadMPD m | |
=> ObjectType | |
-> String | Object URI |
-> String | Sticker name |
-> String | Sticker value |
-> m () |
Adds a sticker value to the specified object.
Arguments
:: MonadMPD m | |
=> ObjectType | |
-> String | Object URI |
-> String | Sticker name |
-> m () |
Delete a sticker value from the specified object.
Arguments
:: MonadMPD m | |
=> ObjectType | |
-> String | Object URI |
-> m [(String, String)] | Sticker name/sticker value |
Lists the stickers for the specified object.
Arguments
:: 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.
Connection
password :: MonadMPD m => String -> m ()
Send password to server to authenticate session. Password is sent as plain text.
Audio output devices
disableOutput :: MonadMPD m => Int -> m ()
Turn off an output device.
enableOutput :: MonadMPD m => Int -> m ()
Turn on an output device.
Reflection
notCommands :: MonadMPD m => m [String]
Retrieve a list of unavailable (due to access restrictions) commands.
urlHandlers :: MonadMPD m => m [String]
Retrieve a list of supported urlhandlers.