libmpd-0.9.1.0/src/0000755000000000000000000000000013543437501012110 5ustar0000000000000000libmpd-0.9.1.0/src/Network/0000755000000000000000000000000013543437501013541 5ustar0000000000000000libmpd-0.9.1.0/src/Network/MPD/0000755000000000000000000000000013613474506014165 5ustar0000000000000000libmpd-0.9.1.0/src/Network/MPD/Applicative/0000755000000000000000000000000013613477327016432 5ustar0000000000000000libmpd-0.9.1.0/src/Network/MPD/Commands/0000755000000000000000000000000013613477327015732 5ustar0000000000000000libmpd-0.9.1.0/src/Network/MPD/Core/0000755000000000000000000000000013543437501015051 5ustar0000000000000000libmpd-0.9.1.0/tests/0000755000000000000000000000000013543437501012463 5ustar0000000000000000libmpd-0.9.1.0/src/Network/MPD.hs0000644000000000000000000000606713543437501014526 0ustar0000000000000000{-# LANGUAGE CPP #-} {- | Module : Network.MPD Copyright : (c) Joachim Fasting, Simon Hengel 2012 License : MIT Maintainer : Joachim Fasting Stability : unstable Portability : unportable An MPD client library. MPD is a daemon for playing music that is controlled over a network socket. To use the library, do: > {-# LANGUAGE OverloadedStrings #-} > import qualified Network.MPD as MPD -} module Network.MPD ( -- * Basic data types MonadMPD, MPD, MPDError(..), ACKType(..), Response, Host, Port, Password, -- * Connections withMPD, withMPD_, withMPDEx, module Network.MPD.Commands, #ifdef TEST getConnectionSettings, getEnvDefault #endif ) where import Prelude import qualified Control.Exception as E import Network.MPD.Commands import Network.MPD.Core import System.Environment (getEnv) import System.IO.Error (isDoesNotExistError) import Data.Maybe (listToMaybe) -- | 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 withMPD :: MPD a -> IO (Response a) withMPD = withMPD_ Nothing Nothing -- | Same as `withMPD`, but takes optional arguments that override MPD_HOST and -- MPD_PORT. -- -- This is e.g. useful for clients that optionally take @--port@ and @--host@ -- as command line arguments, and fall back to `withMPD`'s defaults if those -- arguments are not given. withMPD_ :: Maybe String -- ^ optional override for MPD_HOST -> Maybe String -- ^ optional override for MPD_PORT -> MPD a -> IO (Response a) withMPD_ mHost mPort action = do settings <- getConnectionSettings mHost mPort case settings of Right (host, port, pw) -> withMPDEx host port pw action Left err -> (return . Left . Custom) err getConnectionSettings :: Maybe String -> Maybe String -> IO (Either String (Host, Port, Password)) getConnectionSettings mHost mPort = do (host, pw) <- parseHost `fmap` maybe (getEnvDefault "MPD_HOST" "localhost") return mHost port <- maybe (getEnvDefault "MPD_PORT" "6600") return mPort case maybeRead port of Just p -> (return . Right) (host, p, pw) Nothing -> (return . Left) (show port ++ " is not a valid port!") where parseHost s = case breakChar '@' s of (host, "") -> (host, "") (pw, host) -> (host, pw) getEnvDefault :: String -> String -> IO String getEnvDefault x dflt = E.catch (getEnv x) (\e -> if isDoesNotExistError e then return dflt else ioError e) -- Break a string by character, removing the separator. breakChar :: Char -> String -> (String, String) breakChar c s = let (x, y) = break (== c) s in (x, drop 1 y) maybeRead :: Read a => String -> Maybe a maybeRead = fmap fst . listToMaybe . reads libmpd-0.9.1.0/src/Network/MPD/Applicative.hs0000644000000000000000000000262413543437501016762 0ustar0000000000000000module Network.MPD.Applicative ( Command , runCommand -- * Querying MPD's status , module Network.MPD.Applicative.Status -- * Playback options , module Network.MPD.Applicative.PlaybackOptions -- * Controlling playback , module Network.MPD.Applicative.PlaybackControl -- * The current playlist , module Network.MPD.Applicative.CurrentPlaylist -- * Stored playlists , module Network.MPD.Applicative.StoredPlaylists -- * The music database , module Network.MPD.Applicative.Database -- * Stickers , module Network.MPD.Applicative.Stickers -- * Connection settings , module Network.MPD.Applicative.Connection -- * Audio output devices , module Network.MPD.Applicative.Output -- * Reflection , module Network.MPD.Applicative.Reflection -- * Mounting , module Network.MPD.Applicative.Mount -- * Client-to-client , module Network.MPD.Applicative.ClientToClient ) where import Network.MPD.Applicative.Internal import Network.MPD.Applicative.ClientToClient import Network.MPD.Applicative.Connection import Network.MPD.Applicative.CurrentPlaylist import Network.MPD.Applicative.Database import Network.MPD.Applicative.Mount import Network.MPD.Applicative.Output import Network.MPD.Applicative.PlaybackControl import Network.MPD.Applicative.PlaybackOptions import Network.MPD.Applicative.Reflection import Network.MPD.Applicative.Status import Network.MPD.Applicative.Stickers import Network.MPD.Applicative.StoredPlaylists libmpd-0.9.1.0/src/Network/MPD/Applicative/ClientToClient.hs0000644000000000000000000000402113543437501021633 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.ClientToClient Copyright : (c) Joachim Fasting 2013 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Client to client communication. -} module Network.MPD.Applicative.ClientToClient ( -- * Types ChannelName , MessageText -- * Subscribing to channels , subscribe , unsubscribe , channels -- * Communicating with other clients , readMessages , sendMessage ) where import Control.Applicative import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Util import Network.MPD.Util import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 ------------------------------------------------------------------------ type ChannelName = String type MessageText = String ------------------------------------------------------------------------ subscribe :: ChannelName -> Command () subscribe name = Command emptyResponse ["subscribe" <@> name] unsubscribe :: ChannelName -> Command () unsubscribe name = Command emptyResponse ["unsubscribe" <@> name] channels :: Command [ChannelName] channels = Command p ["channels"] where p = map UTF8.toString . takeValues <$> getResponse ------------------------------------------------------------------------ readMessages :: Command [(ChannelName, MessageText)] readMessages = Command (liftParser p) ["readmessages"] where p = mapM parseMessage . splitGroups ["channel"] . toAssocList parseMessage :: [(ByteString, ByteString)] -> Either String (ChannelName, MessageText) parseMessage [("channel", ch),("message", msg)] = Right (UTF8.toString ch, UTF8.toString msg) parseMessage _ = Left "Unexpected result from readMessages" sendMessage :: ChannelName -> MessageText -> Command () sendMessage name text = Command emptyResponse ["sendmessage" <@> name <++> text] libmpd-0.9.1.0/src/Network/MPD/Applicative/Connection.hs0000644000000000000000000000121513543437501021054 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.Connection Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Connection settings. -} module Network.MPD.Applicative.Connection ( password , ping ) where import Network.MPD.Applicative.Internal import Network.MPD.Core -- | Authenticate session. The password is sent in plain text. password :: Password -> Command () password pwd = Command emptyResponse ["password " ++ pwd] -- | Ping daemon. ping :: Command () ping = Command emptyResponse ["ping"] libmpd-0.9.1.0/src/Network/MPD/Applicative/CurrentPlaylist.hs0000644000000000000000000001336613543437501022133 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.CurrentPlaylist Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable The current playlist. -} module Network.MPD.Applicative.CurrentPlaylist ( add , addId , clear , delete , deleteRange , deleteId , move , moveId , moveRange , playlistFind , playlistInfo , playlistInfoRange , playlistId , playlistSearch , plChanges , plChangesPosId , prio , prioId , shuffle , swap , swapId , addTagId , clearTagId , rangeId ) where import Network.MPD.Commands.Arg hiding (Command) import qualified Network.MPD.Commands.Arg as Arg import Network.MPD.Util import Network.MPD.Commands.Query import Network.MPD.Commands.Parse import Network.MPD.Commands.Types import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Util -- | Add a song (or a whole directory) to the current playlist. add :: Path -> Command () add path = Command emptyResponse ["add" <@> path] -- | Add a song (non-recursively) and return its id. addId :: Path -> Maybe Position -> Command Id addId path pos = Command p c where c = ["addid" <@> path <++> pos] p = do r <- getResponse case toAssocList r of [("Id", n)] -> maybe (unexpected r) (return . Id) (parseNum n) _ -> unexpected r -- | Clear the current playlist. clear :: Command () clear = Command emptyResponse ["clear"] -- | Delete song at the given playlist position. delete :: Position -> Command () delete pos = Command emptyResponse ["delete" <@> pos] -- XXX: this does not exist in the monadic version -- | Delete a range of songs from the playlist. deleteRange :: (Position, Position) -> Command () deleteRange range = Command emptyResponse ["delete" <@> range] -- | Delete song by id. deleteId :: Id -> Command () deleteId i = Command emptyResponse ["deleteid" <@> i] -- | Move song from one position to another. move :: Position -> Position -> Command () move pos to = Command emptyResponse ["move" <@> pos <++> to] -- | Move a range of songs. moveRange :: (Position, Position) -> Position -> Command () moveRange range to = Command emptyResponse ["move" <@> range <++> to] -- | Move song id to position. -- If the position is negative, it is relative to the current song. moveId :: Id -> Position -> Command () moveId i to = Command emptyResponse ["moveid" <@> i <++> to] -- Note: 'playlist' deliberately not defined here -- Internal helper for playlist* commands playlist' :: MPDArg a => Arg.Command -> a -> Command [Song] playlist' cmd q = Command (liftParser takeSongs) [cmd <@> q] -- | Find songs in current playlist with strict matching. playlistFind :: Query -> Command [Song] playlistFind = playlist' "playlistfind" -- | Get song metadata for all items in the current playlist. -- Optionally restrict listing the song at the given position. playlistInfo :: Maybe Position -> Command [Song] playlistInfo = playlist' "playlistinfo" -- | Like 'playlistInfo' but can restrict listing to a range -- of songs. playlistInfoRange :: Maybe (Position, Position) -> Command [Song] playlistInfoRange = playlist' "playlistinfo" -- | Get song metadata for all items in the current playlist. -- Optionally restrict selection to a single song id. playlistId :: Maybe Id -> Command [Song] playlistId = playlist' "playlistid" -- | Search case-insensitively for partial matches in current playlist. playlistSearch :: Query -> Command [Song] playlistSearch = playlist' "playlistsearch" -- | Get song metadata for items that have changed in the playlist since -- the given playlist version. plChanges :: Integer -> Command [Song] plChanges = playlist' "plchanges" -- | Get positions and ids of songs that have changed in the playlist -- since the given playlist version. plChangesPosId :: Integer -> Command [(Position, Id)] plChangesPosId ver = Command p ["plchangesposid" <@> ver] where -- XXX: possibly suboptimal definition p :: Parser [(Position, Id)] p = liftParser $ mapM f . splitGroups ["cpos"] . toAssocList f xs | [("cpos", x), ("Id", y)] <- xs , Just (x', y') <- pair parseNum (x, y) = Right (x', Id y') | otherwise = Left "" -- | Set the priority of the specified songs. prio :: Priority -> (Position, Position) -> Command () prio p range = Command emptyResponse ["prio" <@> p <++> range] -- | Set priority by song id. prioId :: Priority -> Id -> Command () prioId p ids = Command emptyResponse ["prioid" <@> p <++> ids] -- | Shuffle the current playlist. -- Optionally restrict to a range of songs. shuffle :: Maybe (Position, Position) -> Command () shuffle mbRange = Command emptyResponse ["shuffle" <@> mbRange] -- | Swap songs by position. swap :: Position -> Position -> Command () swap pos1 pos2 = Command emptyResponse ["swap" <@> pos1 <++> pos2] -- | Swap songs by id. swapId :: Id -> Id -> Command () swapId id1 id2 = Command emptyResponse ["swapid" <@> id1 <++> id2] -- | Add tag to specified (remote) song. addTagId :: Id -> Metadata -> Value -> Command () addTagId id' tag val = Command emptyResponse ["addtagid" <@> id' <++> tag <++> val] -- | Remove tag from specified (remote) song. clearTagId :: Id -> Metadata -> Command () clearTagId id' tags = Command emptyResponse ["cleartagid" <@> id' <++> tags] -- | Specify portion of song that shall be played. -- Both ends of the range are optional; omitting both plays everything. rangeId :: Id -> (Maybe Double, Maybe Double) -> Command () rangeId id' (mbStart, mbEnd) = Command emptyResponse ["rangeid " ++ show id' ++ " " ++ arg ] where arg = maybe "" show mbStart ++ ":" ++ maybe "" show mbEnd libmpd-0.9.1.0/src/Network/MPD/Applicative/Database.hs0000644000000000000000000000753613543437501020475 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.Database Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable The music database. -} module Network.MPD.Applicative.Database where import Control.Applicative import qualified Network.MPD.Commands.Arg as Arg import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Commands.Parse import Network.MPD.Commands.Query import Network.MPD.Util import Network.MPD.Commands.Types import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Util -- | Get a count of songs and their total playtime that exactly match the -- query. count :: Query -> Command Count count q = Command (liftParser parseCount) ["count" <@> q] -- | Find songs matching the query exactly. find :: Query -> Command [Song] find q = Command p ["find" <@> q] where p :: Parser [Song] p = liftParser takeSongs -- | Like 'find' but adds the results to the current playlist. findAdd :: Query -> Command () findAdd q = Command emptyResponse ["findadd" <@> q] -- | Lists all tags of the specified type. -- -- Note that the optional artist value is only ever used if the -- metadata type is 'Album', and is then taken to mean that the albums -- by that artist be listed. list :: Metadata -> Maybe Artist -> Command [Value] list m q = Command p c where p = map Value . takeValues <$> getResponse c = case m of Album -> ["list Album" <@> q] _ -> ["list" <@> m] -- | List all songs and directories in a database path. listAll :: Path -> Command [Path] listAll path = Command p ["listall" <@> path] where p :: Parser [Path] p = map (Path . snd) . filter ((== "file") . fst) . toAssocList <$> getResponse -- Internal helper lsInfo' :: Arg.Command -> Path -> Command [LsResult] lsInfo' cmd path = Command p [cmd <@> path] where p :: Parser [LsResult] p = liftParser takeEntries -- | Same as 'listAll' but also returns metadata. listAllInfo :: Path -> Command [LsResult] listAllInfo = lsInfo' "listallinfo" -- | List the contents of a database directory. lsInfo :: Path -> Command [LsResult] lsInfo = lsInfo' "lsinfo" -- | Read comments from the file at the specified path. readComments :: Path -> Command [(String, String)] readComments uri = Command p ["readcomments" <@> uri] where p = map decodePair . toAssocList <$> getResponse -- | Like 'find' but with inexact matching. search :: Query -> Command [Song] search q = Command p ["search" <@> q] where p :: Parser [Song] p = liftParser takeSongs -- | Like 'search' but adds the results to the current playlist. -- -- Since MPD 0.17. searchAdd :: Query -> Command () searchAdd q = Command emptyResponse ["searchadd" <@> q] -- | Like 'searchAdd' but adds results to the named playlist. -- -- Since MPD 0.17. searchAddPl :: PlaylistName -> Query -> Command () searchAddPl pl q = Command emptyResponse ["searchaddpl" <@> pl <++> q] -- | Update the music database. -- If no path is supplied, the entire database is updated. update :: Maybe Path -> Command Integer update = update_ "update" -- | Like 'update' but also rescan unmodified files. rescan :: Maybe Path -> Command Integer rescan = update_ "rescan" -- A helper for 'update' and 'rescan. update_ :: Arg.Command -> Maybe Path -> Command Integer update_ cmd mPath = Command p [cmd <@> mPath] where p :: Parser Integer p = do r <- getResponse case toAssocList r of [("updating_db", id_)] -> maybe (unexpected r) return (parseNum id_) _ -> unexpected r libmpd-0.9.1.0/src/Network/MPD/Applicative/Mount.hs0000644000000000000000000000321013543437501020054 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.Mount Copyright : (c) Joachim Fasting 2014 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Mounting remote storage. -} module Network.MPD.Applicative.Mount ( mount , unmount , listMounts , listNeighbors ) where import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Applicative.Internal import Network.MPD.Util import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 mount :: String -- Path -> String -- Uri -> Command () mount p u = Command emptyResponse ["mount" <@> p <++> u] unmount :: String -- Path -> Command () unmount p = Command emptyResponse ["unmount" <@> p] listMounts :: Command [(String, String)] -- (Path, Uri) listMounts = Command (liftParser p) ["listmounts"] where p = mapM parseMount . splitGroups ["mount"] . toAssocList parseMount :: [(ByteString, ByteString)] -> Either String (String, String) parseMount [("mount", mo), ("storage", st)] = Right (UTF8.toString mo, UTF8.toString st) parseMount _ = Left "Unexpected result from listMounts" listNeighbors :: Command [(String, String)] -- (Uri, Name) listNeighbors = Command (liftParser p) ["listneighbors"] where p = mapM parseNeighbor . splitGroups ["neighbor"] . toAssocList parseNeighbor :: [(ByteString, ByteString)] -> Either String (String, String) parseNeighbor [("neighbor", ne), ("name", na)] = Right (UTF8.toString ne, UTF8.toString na) parseNeighbor _ = Left "Unexpected result from listNeighbors" libmpd-0.9.1.0/src/Network/MPD/Applicative/Output.hs0000644000000000000000000000205713543437501020262 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.Output Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Audio output devices. -} module Network.MPD.Applicative.Output ( disableOutput , enableOutput , toggleOutput , outputs ) where import Network.MPD.Applicative.Internal import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Commands.Parse import Network.MPD.Commands.Types -- | Turn off output. disableOutput :: Int -> Command () disableOutput n = Command emptyResponse ["disableoutput" <@> n] -- | Turn on output. enableOutput :: Int -> Command () enableOutput n = Command emptyResponse ["enableoutput" <@> n] -- | Toggle output. toggleOutput :: Int -> Command () toggleOutput n = Command emptyResponse ["toggleoutput" <@> n] -- | Get information about all available output devices. outputs :: Command [Device] outputs = Command (liftParser parseOutputs) ["outputs"] libmpd-0.9.1.0/src/Network/MPD/Applicative/PlaybackControl.hs0000644000000000000000000000307413543437501022051 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.PlaybackControl Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Controlling playback. -} module Network.MPD.Applicative.PlaybackControl ( next , pause , play , playId , previous , seek , seekId , stop ) where import Network.MPD.Applicative.Internal import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Commands.Types -- | Play next song in the playlist. next :: Command () next = Command emptyResponse ["next"] -- | Toggle pause. pause :: Bool -> Command () pause f = Command emptyResponse ["pause" <@> f] -- | Begin playback (optionally at a specific position). play :: Maybe Position -> Command () play mbPos = Command emptyResponse c where c = return $ maybe "play" ("play" <@>) mbPos -- | Begin playback at the specified song id. playId :: Id -> Command () playId id' = Command emptyResponse ["playid" <@> id'] -- | Play previous song. previous :: Command () previous = Command emptyResponse ["previous"] -- | Seek to time in the song at the given position. seek :: Position -> FractionalSeconds -> Command () seek pos time = Command emptyResponse ["seek" <@> pos <++> time] -- | Seek to time in the song with the given id. seekId :: Id -> FractionalSeconds -> Command () seekId id' time = Command emptyResponse ["seekid" <@> id' <++> time] -- | Stop playback. stop :: Command () stop = Command emptyResponse ["stop"] libmpd-0.9.1.0/src/Network/MPD/Applicative/PlaybackOptions.hs0000644000000000000000000000456213543437501022067 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.PlaybackOptions Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Playback options -} module Network.MPD.Applicative.PlaybackOptions ( consume , crossfade , random , repeat , setVolume , single , replayGainMode , replayGainStatus , mixrampDb , mixrampDelay ) where import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Util import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Commands.Types import Network.MPD.Util (toAssocList) import Control.Applicative import Prelude hiding (repeat) -- | Toggle consume mode. consume :: Bool -> Command () consume f = Command emptyResponse ["consume" <@> f] -- | Set crossfading between songs. crossfade :: Seconds -> Command () crossfade secs = Command emptyResponse ["crossfade" <@> secs] -- | Toggle random mode. random :: Bool -> Command () random f = Command emptyResponse ["random" <@> f] -- | Toggle repeat mode. repeat :: Bool -> Command () repeat f = Command emptyResponse ["repeat" <@> f] -- | Set volume. setVolume :: Volume -> Command () setVolume vol = Command emptyResponse ["setvol" <@> vol] -- | Toggle single mode. single :: Bool -> Command () single f = Command emptyResponse ["single" <@> f] -- | Set replay gain mode. replayGainMode :: ReplayGainMode -> Command () replayGainMode f = Command emptyResponse ["replay_gain_mode" <@> f] -- | Get replay gain status: option name and its value. replayGainStatus :: Command [(String, String)] replayGainStatus = Command p ["replay_gain_status"] where p = map decodePair . toAssocList <$> getResponse -- | Set MixRamp overlap threshold. -- 0dB is the normalized maximum value; use negative values to adjust it. -- -- Songs must have MixRamp tags set by an external tool for this to -- work; crossfading is used if no tags are present. mixrampDb :: Decibels -> Command () mixrampDb db = Command emptyResponse ["mixrampdb" <@> db] -- | Additional time subtracted from the overlap calculated by -- 'mixrampDb'. -- "NaN" disables MixRamp overlapping and reverts to crossfading. mixrampDelay :: Seconds -> Command () mixrampDelay sec = Command emptyResponse ["mixrampdelay" <@> sec] libmpd-0.9.1.0/src/Network/MPD/Applicative/Reflection.hs0000644000000000000000000000423213543437501021051 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.Reflection Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Reflection. -} module Network.MPD.Applicative.Reflection ( commands , notCommands , tagTypes , urlHandlers , decoders , config ) where import Network.MPD.Util import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Util import Control.Applicative import Prelude hiding (repeat, read) import qualified Data.ByteString.UTF8 as UTF8 -- | Get a list of available commands. commands :: Command [String] commands = Command p ["commands"] where p = map UTF8.toString . takeValues <$> getResponse -- | Get a list of unavailable commands (i.e., commands that require -- an authenticated session). notCommands :: Command [String] notCommands = Command p ["notcommands"] where p = map UTF8.toString . takeValues <$> getResponse -- | Get a list of available song metadata. tagTypes :: Command [String] tagTypes = Command p ["tagtypes"] where p = map UTF8.toString . takeValues <$> getResponse -- | Get a list of available URL handlers. urlHandlers :: Command [String] urlHandlers = Command p ["urlhandlers"] where p = map UTF8.toString . takeValues <$> getResponse -- | Get a list of available decoder plugins, with their supported -- suffixes and MIME types. decoders :: Command [(String, [(String, String)])] decoders = Command p ["decoders"] where p = takeDecoders . toAssocList <$> getResponse takeDecoders [] = [] takeDecoders ((_, m):xs) = let (info, rest) = break ((==) "plugin" . fst) xs in (UTF8.toString m, map decodePair info) : takeDecoders rest -- | Get configuration values of interest to a client. -- -- Note: only permitted for clients connected via a unix domain -- socket (aka \"local clients\"). config :: Command [(String, String)] config = Command p ["config"] where p = map (\(k, v) -> (UTF8.toString k, UTF8.toString v)) . toAssocList <$> getResponse libmpd-0.9.1.0/src/Network/MPD/Applicative/Status.hs0000644000000000000000000001406313613477327020255 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, TupleSections #-} {- | Module : Network.MPD.Applicative.Status Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Querying MPD's status. -} module Network.MPD.Applicative.Status ( clearError , currentSong , idle , noidle , status , stats ) where import Control.Monad import Control.Arrow ((***)) import Network.MPD.Util import Network.MPD.Applicative.Internal import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Commands.Parse import Network.MPD.Commands.Types import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 -- | Clear current error message in status. clearError :: Command () clearError = Command emptyResponse ["clearerror"] -- | Song metadata for currently playing song, if any. currentSong :: Command (Maybe Song) currentSong = Command (liftParser parseMaybeSong) ["currentsong"] takeSubsystems :: [ByteString] -> Either String [Subsystem] takeSubsystems = mapM f . toAssocList where f :: (ByteString, ByteString) -> Either String Subsystem f ("changed", system) = case system of "database" -> Right DatabaseS "update" -> Right UpdateS "stored_playlist" -> Right StoredPlaylistS "playlist" -> Right PlaylistS "player" -> Right PlayerS "mixer" -> Right MixerS "output" -> Right OutputS "options" -> Right OptionsS k -> Left ("Unknown subsystem: " ++ UTF8.toString k) f x = Left ("idle: Unexpected " ++ show x) -- | Wait until there is noteworthy change in one or more of MPD's -- subsystems. -- When active, only 'noidle' commands are allowed. idle :: [Subsystem] -> Command [Subsystem] idle ss = Command (liftParser takeSubsystems) c where c = ["idle" <@> foldr (<++>) (Args []) ss] -- | Cancel an 'idle' request. noidle :: Command () noidle = Command emptyResponse ["noidle"] -- | Get database statistics. stats :: Command Stats stats = Command (liftParser parseStats) ["stats"] -- | Get the current status of the player. status :: Command Status status = Command (liftParser parseStatus) ["status"] where -- Builds a 'Status' instance from an assoc. list. parseStatus :: [ByteString] -> Either String Status parseStatus = foldM go def . toAssocList where go a p@(k, v) = case k of "volume" -> vol $ \x -> a { stVolume = x } "repeat" -> bool $ \x -> a { stRepeat = x } "random" -> bool $ \x -> a { stRandom = x } "single" -> bool $ \x -> a { stSingle = x } "consume" -> bool $ \x -> a { stConsume = x } "playlist" -> num $ \x -> a { stPlaylistVersion = x } "playlistlength" -> num $ \x -> a { stPlaylistLength = x } "state" -> state $ \x -> a { stState = x } "song" -> int $ \x -> a { stSongPos = Just x } "songid" -> int $ \x -> a { stSongID = Just $ Id x } "nextsong" -> int $ \x -> a { stNextSongPos = Just x } "nextsongid" -> int $ \x -> a { stNextSongID = Just $ Id x } "time" -> time $ \x -> a { stTime = Just x } "elapsed" -> frac $ \x -> a { stTime = fmap ((x,) . snd) (stTime a) } "duration" -> frac $ \x -> a { stTime = fmap ((,x) . fst) (stTime a) } "bitrate" -> int $ \x -> a { stBitrate = Just x } "xfade" -> num $ \x -> a { stXFadeWidth = x } "mixrampdb" -> frac $ \x -> a { stMixRampdB = x } "mixrampdelay" -> frac $ \x -> a { stMixRampDelay = x } "audio" -> audio $ \x -> a { stAudio = x } "updating_db" -> num $ \x -> a { stUpdatingDb = Just x } "error" -> Right a { stError = Just (UTF8.toString v) } "partition" -> Right a { stPartition = UTF8.toString v } _ -> Right a where unexpectedPair = Left ("unexpected key-value pair: " ++ show p) int f = maybe unexpectedPair (Right . f) (parseNum v :: Maybe Int) num f = maybe unexpectedPair (Right . f) (parseNum v) bool f = maybe unexpectedPair (Right . f) (parseBool v) frac f = maybe unexpectedPair (Right . f) (parseFrac v) -- This is sometimes "audio: 0:?:0", so we ignore any parse -- errors. audio f = Right $ maybe a f (parseTriple ':' parseNum v) time f = case parseFrac *** parseFrac $ breakChar ':' v of (Just a_, Just b) -> (Right . f) (a_, b) _ -> unexpectedPair state f = case v of "play" -> (Right . f) Playing "pause" -> (Right . f) Paused "stop" -> (Right . f) Stopped _ -> unexpectedPair -- A volume of -1 indicates an audio backend w/o a mixer vol f = case (parseNum v :: Maybe Int) of Nothing -> unexpectedPair -- does it really make sense to fail here? when does this occur? Just v' -> (Right . f) (g v') where g n | n < 0 = Nothing | otherwise = Just $ fromIntegral n libmpd-0.9.1.0/src/Network/MPD/Applicative/Stickers.hs0000644000000000000000000000425213543437501020550 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.Stickers Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Stickers. -} module Network.MPD.Applicative.Stickers ( stickerGet , stickerSet , stickerDelete , stickerList , stickerFind ) where import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Util import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Commands.Types import Network.MPD.Util import Control.Applicative import qualified Data.ByteString.UTF8 as UTF8 -- | Read sticker value for the object specified. stickerGet :: ObjectType -> String -> String -> Command [String] stickerGet typ uri name = Command p c where p :: Parser [String] p = map UTF8.toString . takeValues <$> getResponse c = ["sticker get" <@> typ <++> uri <++> name] -- | Add sticker value to the object. Will overwrite existing stickers -- with the same name. stickerSet :: ObjectType -> String -> String -> String -> Command () stickerSet typ uri name value = Command emptyResponse c where c = ["sticker set" <@> typ <++> uri <++> name <++> value] -- | Delete a sticker value from the object. If no sticker name is -- given, all sticker values attached to the object are deleted. stickerDelete :: ObjectType -> String -> String -> Command () stickerDelete typ uri name = Command emptyResponse c where c = ["sticker delete" <@> typ <++> uri <++> name] -- | List stickers for the object. stickerList :: ObjectType -> String -> Command [(String, String)] stickerList typ uri = Command p c where p = map decodePair . toAssocList <$> getResponse c = ["sticker list" <@> typ <++> uri] -- | Search the sticker database for stickers with the specified name, -- below the specified directory. stickerFind :: ObjectType -> String -> String -> Command [(String, String)] stickerFind typ uri name = Command p c where p = map decodePair . toAssocList <$> getResponse c = ["sticker find" <@> typ <++> uri <++> name] libmpd-0.9.1.0/src/Network/MPD/Applicative/StoredPlaylists.hs0000644000000000000000000000550613543437501022131 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Applicative.StoredPlaylists Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Stored playlists. -} module Network.MPD.Applicative.StoredPlaylists ( listPlaylist , listPlaylistInfo , listPlaylists , load , playlistAdd , playlistClear , playlistDelete , playlistMove , rename , rm , save ) where import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Util import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Commands.Types import Network.MPD.Util import Control.Applicative -- | List song items in the playlist. listPlaylist :: PlaylistName -> Command [Path] listPlaylist plName = Command p ["listplaylist" <@> plName] where p = map Path . takeValues <$> getResponse -- | List song items in the playlist with metadata. listPlaylistInfo :: PlaylistName -> Command [Song] listPlaylistInfo plName = Command (liftParser takeSongs) ["listplaylistinfo" <@> plName] -- | Get a list of stored playlists. listPlaylists :: Command [PlaylistName] listPlaylists = Command p ["listplaylists"] where p = map PlaylistName . go [] . toAssocList <$> getResponse -- XXX: need to fail gracefully here -- After each playlist name we get a timestamp go acc [] = acc go acc ((_, b):_:xs) = go (b : acc) xs go _ _ = error "listPlaylists: bug" -- | Load playlist into the current queue. load :: PlaylistName -> Command () load plName = Command emptyResponse ["load" <@> plName] -- | Add a database path to the named playlist. playlistAdd :: PlaylistName -> Path -> Command () playlistAdd plName path = Command emptyResponse ["playlistadd" <@> plName <++> path] -- | Clear the playlist. playlistClear :: PlaylistName -> Command () playlistClear plName = Command emptyResponse ["playlistclear" <@> plName] -- | Delete the item at the given position from the playlist. playlistDelete :: PlaylistName -> Position -> Command () playlistDelete name pos = Command emptyResponse ["playlistdelete" <@> name <++> pos] -- | Move a song to a new position within the playlist. playlistMove :: PlaylistName -> Id -> Position -> Command () playlistMove name from to = Command emptyResponse ["playlistmove" <@> name <++> from <++> to] -- | Rename the playlist. rename :: PlaylistName -> PlaylistName -> Command () rename plName new = Command emptyResponse ["rename" <@> plName <++> new] -- | Remove the playlist. rm :: PlaylistName -> Command () rm plName = Command emptyResponse ["rm" <@> plName] -- | Save current queue to the named playlist. save :: PlaylistName -> Command () save plName = Command emptyResponse ["save" <@> plName] libmpd-0.9.1.0/src/Network/MPD/Commands/Extensions.hs0000644000000000000000000000741613543437501020425 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.Extensions Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : Joachim Fasting Stability : unstable Portability : unportable Extensions and shortcuts to the standard MPD command set. -} module Network.MPD.Commands.Extensions where import Network.MPD.Core import Network.MPD.Commands import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.CurrentPlaylist as A import qualified Network.MPD.Applicative.StoredPlaylists as A import Control.Monad (liftM) import Data.Traversable (for) import Data.Foldable (for_) -- | This is exactly the same as `update`. updateId :: MonadMPD m => Maybe Path -> m Integer updateId = update {-# DEPRECATED updateId "use `update` instead" #-} -- | Toggles play\/pause. Plays if stopped. toggle :: MonadMPD m => m () toggle = status >>= \st -> case stState st of Playing -> pause True _ -> play Nothing -- | Add a list of songs\/folders to a playlist. -- Should be more efficient than running 'add' many times. addMany :: MonadMPD m => PlaylistName -> [Path] -> m () addMany plname xs = A.runCommand (for_ xs cmd) where cmd | plname == "" = A.add | otherwise = A.playlistAdd plname -- | Recursive 'addId'. For directories, it will use the given position -- for the first file in the directory and use the successor for the remaining -- files. It returns a list of playlist ids for the songs added. addIdMany :: MonadMPD m => Path -> Maybe Position -> m [Id] addIdMany x (Just p) = do fs <- listAll x let fs' = map (\(a, b) -> (a, Just b)) $ zip fs [p ..] A.runCommand $ for fs' (uncurry A.addId) addIdMany x Nothing = do fs <- listAll x A.runCommand $ for fs (`A.addId` Nothing) -- | Like 'add' but returns a list of the files added. addList :: MonadMPD m => Path -> m [Path] addList x = add x >> listAll x {-# DEPRECATED addList "will be removed in a future version" #-} -- | Like 'playlistAdd' but returns a list of the files added. playlistAddList :: MonadMPD m => PlaylistName -> Path -> m [Path] playlistAddList plname path = playlistAdd plname path >> listAll path {-# DEPRECATED playlistAddList "will be removed in a future version" #-} {- -- | Returns all songs and directories that match the given partial -- path name. complete :: MonadMPD m => String -> m [Either Path Song] complete path = do xs <- liftM matches . lsInfo $ dropFileName path case xs of [Left dir] -> complete $ dir ++ "/" _ -> return xs where matches = filter (isPrefixOf path . takePath) takePath = either id sgFilePath -} -- | List the artists in the database. listArtists :: MonadMPD m => m [Artist] listArtists = list Artist Nothing -- | List the albums in the database, optionally matching a given -- artist. listAlbums :: MonadMPD m => Maybe Artist -> m [Album] listAlbums = list Album -- | List the songs in an album of some artist. listAlbum :: MonadMPD m => Artist -> Album -> m [Song] listAlbum artist album = find (Artist =? artist <&> Album =? album) -- | Retrieve the current playlist. -- Equivalent to @playlistinfo Nothing@. getPlaylist :: MonadMPD m => m [Song] getPlaylist = playlistInfo Nothing -- | Increase or decrease volume by a given percent, e.g. -- 'volume 10' will increase the volume by 10 percent, while -- 'volume (-10)' will decrease it by the same amount. volume :: MonadMPD m => Int -> m () volume n = do cur <- stVolume `liftM` status case cur of Nothing -> return () Just v -> setVolume (adjust v) where adjust x = round $ (fromIntegral n / (100 :: Double)) * x' + x' where x' = fromIntegral x libmpd-0.9.1.0/src/Network/MPD/Core.hs0000644000000000000000000002226013613474506015413 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Module : Network.MPD.Core -- Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010 -- License : MIT (see LICENSE) -- Maintainer : Joachim Fasting -- Stability : alpha -- -- The core datatypes and operations are defined here, including the -- primary instance of the 'MonadMPD' class, 'MPD'. module Network.MPD.Core ( -- * Classes MonadMPD(..), -- * Data types MPD, MPDError(..), ACKType(..), Response, Host, Port, Password, -- * Running withMPDEx, -- * Interacting getResponse, kill, ) where import Network.MPD.Util import Network.MPD.Core.Class import Network.MPD.Core.Error import Data.Char (isDigit) import Control.Applicative (Applicative(..), (<$>), (<*)) import qualified Control.Exception as E import Control.Exception.Safe (catch, catchAny) import Control.Monad (ap, unless) import Control.Monad.Error (ErrorT(..), MonadError(..)) import Control.Monad.Reader (ReaderT(..), ask) import Control.Monad.State (StateT, MonadIO(..), modify, gets, evalStateT) import qualified Data.Foldable as F import System.IO (IOMode(..)) import Network.Socket ( Family(..) , SockAddr(..) , SocketType(..) , addrAddress , addrFamily , addrProtocol , addrSocketType , connect , defaultHints , getAddrInfo , socket , socketToHandle , withSocketsDo ) import System.IO (Handle, hPutStrLn, hReady, hClose, hFlush) import System.IO.Error (isEOFError, tryIOError, ioeGetErrorType) import Text.Printf (printf) import qualified GHC.IO.Exception as GE import qualified Prelude import Prelude hiding (break, drop, dropWhile, read) import Data.ByteString.Char8 (ByteString, isPrefixOf, break, drop, dropWhile) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.UTF8 as UTF8 -- -- Data types. -- type Host = String type Port = Integer -- -- IO based MPD client implementation. -- -- | 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) newtype MPD a = MPD { runMPD :: ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a } deriving (Functor, Monad, MonadIO, MonadError MPDError) instance Applicative MPD where (<*>) = ap pure = return instance MonadMPD MPD where open = mpdOpen close = mpdClose send = mpdSend getPassword = MPD $ gets stPassword setPassword pw = MPD $ modify (\st -> st { stPassword = pw }) getVersion = MPD $ gets stVersion -- | Inner state for MPD data MPDState = MPDState { stHandle :: Maybe Handle , stPassword :: String , stVersion :: (Int, Int, Int) } -- | A response is either an 'MPDError' or some result. type Response = Either MPDError -- | The most configurable API for running an MPD action. withMPDEx :: Host -> Port -> Password -> MPD a -> IO (Response a) withMPDEx host port pw x = withSocketsDo $ runReaderT (evalStateT (runErrorT . runMPD $ open >> (x <* close)) initState) (host, port) where initState = MPDState Nothing pw (0, 0, 0) mpdOpen :: MPD () mpdOpen = MPD $ do (host, port) <- ask runMPD close addr:_ <- liftIO $ getAddr host port sock <- liftIO $ socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) mHandle <- liftIO (safeConnectTo (sock,(addrAddress addr))) modify (\st -> st { stHandle = mHandle }) F.forM_ mHandle $ \_ -> runMPD checkConn >>= (`unless` runMPD close) where getAddr addr@('/':_) _ = return [ defaultHints { addrFamily = AF_UNIX , addrSocketType = Stream , addrAddress = SockAddrUnix addr } ] getAddr host port = getAddrInfo (Just defaultHints) (Just host) (Just $ show port) safeConnectTo (sock,addr) = (connect sock addr) >> (Just <$> socketToHandle sock ReadWriteMode) `catchAny` const (return Nothing) checkConn = do singleMsg <- send "" let [msg] = singleMsg if "OK MPD" `isPrefixOf` msg then MPD $ checkVersion $ parseVersion msg else return False checkVersion Nothing = throwError $ Custom "Couldn't determine MPD version" checkVersion (Just version) | version < requiredVersion = throwError $ Custom $ printf "MPD %s is not supported, upgrade to MPD %s or above!" (formatVersion version) (formatVersion requiredVersion) | otherwise = do modify (\st -> st { stVersion = version }) return True where requiredVersion = (0, 15, 0) parseVersion = parseTriple '.' parseNum . dropWhile (not . isDigit) formatVersion :: (Int, Int, Int) -> String formatVersion (x, y, z) = printf "%d.%d.%d" x y z mpdClose :: MPD () mpdClose = MPD $ do mHandle <- gets stHandle F.forM_ mHandle $ \h -> do modify $ \st -> st{stHandle = Nothing} r <- liftIO $ sendClose h F.forM_ r throwError where sendClose handle = (hPutStrLn handle "close" >> hReady handle >> hClose handle >> return Nothing) `catch` handler handler err | isEOFError err = return Nothing | otherwise = (return . Just . ConnectionError) err mpdSend :: String -> MPD [ByteString] mpdSend str = send' `catchError` handler where handler err | ConnectionError e <- err, isRetryable e = mpdOpen >> send' | otherwise = throwError err send' :: MPD [ByteString] send' = MPD $ gets stHandle >>= maybe (throwError NoMPD) go go handle = (liftIO . tryIOError $ do unless (null str) $ B.hPutStrLn handle (UTF8.fromString str) >> hFlush handle getLines handle []) >>= either (\err -> modify (\st -> st { stHandle = Nothing }) >> throwError (ConnectionError err)) return getLines :: Handle -> [ByteString] -> IO [ByteString] getLines handle acc = do l <- B.hGetLine handle if "OK" `isPrefixOf` l || "ACK" `isPrefixOf` l then (return . reverse) (l:acc) else getLines handle (l:acc) -- | Re-connect and retry for these Exceptions. isRetryable :: E.IOException -> Bool isRetryable e = or [ isEOFError e, isResourceVanished e ] -- | Predicate to identify ResourceVanished exceptions. -- Note: these are GHC only! isResourceVanished :: GE.IOException -> Bool isResourceVanished e = ioeGetErrorType e == GE.ResourceVanished -- -- Other operations. -- -- | Kill the server. Obviously, the connection is then invalid. kill :: (MonadMPD m) => m () kill = send "kill" >> return () -- | Send a command to the MPD server and return the result. getResponse :: (MonadMPD m) => String -> m [ByteString] getResponse cmd = (send cmd >>= parseResponse) `catchError` sendpw where sendpw e@(ACK Auth _) = do pw <- getPassword if null pw then throwError e else send ("password " ++ pw) >>= parseResponse >> send cmd >>= parseResponse sendpw e = throwError e -- Consume response and return a Response. parseResponse :: (MonadError MPDError m) => [ByteString] -> m [ByteString] parseResponse xs | null xs = throwError $ NoMPD | "ACK" `isPrefixOf` x = throwError $ parseAck x | otherwise = return $ Prelude.takeWhile ("OK" /=) xs where x = head xs -- Turn MPD ACK into the corresponding 'MPDError' parseAck :: ByteString -> MPDError parseAck s = ACK ack (UTF8.toString msg) where ack = case code of 2 -> InvalidArgument 3 -> InvalidPassword 4 -> Auth 5 -> UnknownCommand 50 -> FileNotFound 51 -> PlaylistMax 52 -> System 53 -> PlaylistLoad 54 -> Busy 55 -> NotPlaying 56 -> FileExists _ -> UnknownACK (code, _, msg) = splitAck s -- Break an ACK into (error code, current command, message). -- ACKs are of the form: -- ACK [error@command_listNum] {current_command} message_text\n splitAck :: ByteString -> (Int, ByteString, ByteString) splitAck s = (read code, cmd, msg) where (code, notCode) = between '[' '@' s (cmd, notCmd) = between '{' '}' notCode msg = drop 1 $ dropWhile (' ' ==) notCmd -- take whatever is between 'f' and 'g'. between a b xs = let (_, y) = break (== a) xs in break (== b) (drop 1 y) libmpd-0.9.1.0/src/Network/MPD/Core/Class.hs0000644000000000000000000000216413543437501016455 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -- | Module : Network.MPD.Core.Class -- Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010 -- License : MIT (see LICENSE) -- Maintainer : Joachim Fasting -- Stability : alpha -- -- The MPD typeclass. module Network.MPD.Core.Class where import Data.ByteString (ByteString) import Network.MPD.Core.Error (MPDError) import Control.Monad.Error (MonadError) type Password = String -- | A typeclass to allow for multiple implementations of a connection -- to an MPD server. class (Monad m, MonadError MPDError m) => MonadMPD m where -- | Open (or re-open) a connection to the MPD server. open :: m () -- | Close the connection. close :: m () -- | Send a string to the server and return its response. send :: String -> m [ByteString] -- | Produce a password to send to the server should it ask for -- one. getPassword :: m Password -- | Alters password to be sent to the server. setPassword :: Password -> m () -- | Get MPD protocol version getVersion :: m (Int, Int, Int) libmpd-0.9.1.0/src/Network/MPD/Core/Error.hs0000644000000000000000000000525313543437501016503 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {- | Module : Network.MPD.Core.Error Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : Joachim Fasting Stability : unstable Portability : unportable MPD errors. -} module Network.MPD.Core.Error where import qualified Control.Exception as E import Control.Monad.Error (Error(..)) import Data.Typeable -- | The MPDError type is used to signal errors, both from the MPD and -- otherwise. data MPDError = NoMPD -- ^ MPD not responding | ConnectionError E.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 deriving (Eq, Typeable) instance E.Exception MPDError instance Show MPDError where show NoMPD = "Could not connect to MPD" show (ConnectionError e) = "Connection error (" ++ show e ++ ")" show (Unexpected s) = "MPD returned an unexpected response: " ++ unlines [ s , "" , "This is most likely a bug in libmpd! Please report it here:" , "" , "https://github.com/vimus/libmpd-haskell/issues/new" ] show (Custom s) = s show (ACK _ s) = s instance Error MPDError where noMsg = Custom "An error occurred" strMsg = Custom -- | Represents various MPD errors (aka. ACKs). data ACKType = 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) deriving Eq libmpd-0.9.1.0/src/Network/MPD/Commands.hs0000644000000000000000000000373513543437501016266 0ustar0000000000000000{- | Module : Network.MPD.Commands Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Interface to the user commands supported by MPD. -} module Network.MPD.Commands ( module Network.MPD.Commands.Query , ToString(..) , Artist , Album , Title , PlaylistName(..) , Path , Metadata(..) , Value , ObjectType(..) , Seconds , FractionalSeconds , Decibels , PlaybackState(..) , Subsystem(..) , ReplayGainMode(..) , Count(..) , LsResult(..) , Device(..) , Song(..) , Priority(..) , Position , Volume , Id(..) , sgGetTag , sgAddTag , Stats(..) , Status(..) , def , module Network.MPD.Commands.Status , module Network.MPD.Commands.PlaybackOptions , module Network.MPD.Commands.PlaybackControl , module Network.MPD.Commands.CurrentPlaylist , module Network.MPD.Commands.StoredPlaylists , module Network.MPD.Commands.Database , module Network.MPD.Commands.Stickers , module Network.MPD.Commands.Connection , module Network.MPD.Commands.Output , module Network.MPD.Commands.Reflection , module Network.MPD.Commands.ClientToClient , module Network.MPD.Commands.Mount ) where import Network.MPD.Commands.Query import Network.MPD.Commands.Types import Network.MPD.Commands.Status import Network.MPD.Commands.PlaybackOptions import Network.MPD.Commands.PlaybackControl import Network.MPD.Commands.CurrentPlaylist import Network.MPD.Commands.StoredPlaylists import Network.MPD.Commands.Database import Network.MPD.Commands.Stickers import Network.MPD.Commands.Connection import Network.MPD.Commands.Output import Network.MPD.Commands.Reflection import Network.MPD.Commands.ClientToClient import Network.MPD.Commands.Mount libmpd-0.9.1.0/src/Network/MPD/Commands/Arg.hs0000644000000000000000000000474413543437501017000 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, GeneralizedNewtypeDeriving #-} {- | Module : Network.MPD.Commands.Arg Copyright : (c) Joachim Fasting, Simon Hengel 2012 License : MIT Maintainer : Joachim Fasting Stability : alpha Portability : unportable Prepare command arguments. -} module Network.MPD.Commands.Arg (Command, Args(..), MPDArg(..), (<++>), (<@>)) where import Network.MPD.Util (showBool) import Data.ByteString (ByteString) import qualified Data.ByteString.UTF8 as UTF8 import Data.String -- | Arguments for getResponse are accumulated as strings in values of -- this type after being converted from whatever type (an instance of -- MPDArg) they were to begin with. newtype Args = Args [String] deriving Show -- | A uniform interface for argument preparation -- The basic idea is that one should be able -- to magically prepare an argument for use with -- an MPD command, without necessarily knowing/\caring -- how it needs to be represented internally. class Show a => MPDArg a where prep :: a -> Args -- Note that because of this, we almost -- never have to actually provide -- an implementation of 'prep' prep = Args . return . show -- | Groups together arguments to getResponse. infixl 3 <++> (<++>) :: (MPDArg a, MPDArg b) => a -> b -> Args x <++> y = Args $ xs ++ ys where Args xs = prep x Args ys = prep y newtype Command = Command String deriving IsString -- | Converts a command name and a string of arguments into the string -- to hand to getResponse. infix 2 <@> (<@>) :: (MPDArg a) => Command -> a -> String Command x <@> y = unwords $ x : filter (not . null) y' where Args y' = prep y instance MPDArg Args where prep = id instance MPDArg String where -- We do this to avoid mangling -- non-ascii characters with 'show' prep x = Args ['"' : addSlashes x ++ "\""] instance MPDArg ByteString where prep = prep . UTF8.toString instance (MPDArg a) => MPDArg (Maybe a) where prep Nothing = Args [] prep (Just x) = prep x instance (MPDArg a, MPDArg b) => MPDArg (a, b) where prep (x, y) = Args [show x ++ ":" ++ show y] instance MPDArg Int instance MPDArg Integer instance MPDArg Bool where prep = Args . return . showBool instance MPDArg Double addSlashes :: String -> String addSlashes = concatMap escapeSpecial where specials = "\\\"" escapeSpecial x | x `elem` specials = ['\\', x] | otherwise = [x] libmpd-0.9.1.0/src/Network/MPD/Commands/Parse.hs0000644000000000000000000001307513543437501017336 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} -- | Module : Network.MPD.Commands.Parse -- Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010 -- License : MIT (see LICENSE) -- Maintainer : Joachim Fasting -- Stability : alpha -- -- Parsers for MPD data types. module Network.MPD.Commands.Parse where import Network.MPD.Commands.Types import Control.Applicative import Control.Monad.Error import Data.Maybe (fromMaybe) import Network.MPD.Util import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 -- | Builds a 'Count' instance from an assoc. list. parseCount :: [ByteString] -> Either String Count parseCount = foldM f def . toAssocList where f :: Count -> (ByteString, ByteString) -> Either String Count f a ("songs", x) = return $ parse parseNum (\x' -> a { cSongs = x'}) a x f a ("playtime", x) = return $ parse parseNum (\x' -> a { cPlaytime = x' }) a x f _ x = Left $ show x -- | Builds a list of 'Device' instances from an assoc. list parseOutputs :: [ByteString] -> Either String [Device] parseOutputs = mapM (foldM f def) . splitGroups ["outputid"] . toAssocList where f a ("outputid", x) = return $ parse parseNum (\x' -> a { dOutputID = x' }) a x f a ("outputname", x) = return a { dOutputName = UTF8.toString x } f a ("outputenabled", x) = return $ parse parseBool (\x' -> a { dOutputEnabled = x'}) a x f _ x = Left $ show x -- | Builds a 'Stats' instance from an assoc. list. parseStats :: [ByteString] -> Either String Stats parseStats = foldM f def . toAssocList where f a ("artists", x) = return $ parse parseNum (\x' -> a { stsArtists = x' }) a x f a ("albums", x) = return $ parse parseNum (\x' -> a { stsAlbums = x' }) a x f a ("songs", x) = return $ parse parseNum (\x' -> a { stsSongs = x' }) a x f a ("uptime", x) = return $ parse parseNum (\x' -> a { stsUptime = x' }) a x f a ("playtime", x) = return $ parse parseNum (\x' -> a { stsPlaytime = x' }) a x f a ("db_playtime", x) = return $ parse parseNum (\x' -> a { stsDbPlaytime = x' }) a x f a ("db_update", x) = return $ parse parseNum (\x' -> a { stsDbUpdate = x' }) a x f _ x = Left $ show x parseMaybeSong :: [ByteString] -> Either String (Maybe Song) parseMaybeSong xs | null xs = Right Nothing | otherwise = Just <$> (parseSong . toAssocList) xs -- | Builds a 'Song' instance from an assoc. list. parseSong :: [(ByteString, ByteString)] -> Either String Song parseSong xs = case xs of ("file", path):ys -> foldM f (defaultSong (Path path)) ys _ -> Left "Got a song without a file path! This indicates a bug in either libmpd-haskell or MPD itself!" where f :: Song -> (ByteString, ByteString) -> Either String Song f s ("Last-Modified", v) = return s { sgLastModified = parseIso8601 v } f s ("Time", v) = return s { sgLength = fromMaybe 0 $ parseNum v } f s ("Id", v) = return $ parse parseNum (\v' -> s { sgId = Just $ Id v' }) s v f s ("Pos", v) = maybe (return $ parse parseNum (\v' -> s { sgIndex = Just v' }) s v) (const $ return s) (sgIndex s) f s (k, v) = return . maybe s (\m -> sgAddTag m (Value v) s) $ readMeta k -- Custom-made Read instance readMeta "ArtistSort" = Just ArtistSort readMeta "Artist" = Just Artist readMeta "Album" = Just Album readMeta "AlbumArtist" = Just AlbumArtist readMeta "AlbumArtistSort" = Just AlbumArtistSort readMeta "Title" = Just Title readMeta "Genre" = Just Genre readMeta "Name" = Just Name readMeta "Composer" = Just Composer readMeta "Performer" = Just Performer readMeta "Comment" = Just Comment readMeta "Date" = Just Date readMeta "Track" = Just Track readMeta "Disc" = Just Disc readMeta "MUSICBRAINZ_ARTISTID" = Just MUSICBRAINZ_ARTISTID readMeta "MUSICBRAINZ_ALBUMID" = Just MUSICBRAINZ_ALBUMID readMeta "MUSICBRAINZ_ALBUMARTISTID" = Just MUSICBRAINZ_ALBUMARTISTID readMeta "MUSICBRAINZ_TRACKID" = Just MUSICBRAINZ_TRACKID readMeta "MUSICBRAINZ_RELEASETRACKID" = Just MUSICBRAINZ_RELEASETRACKID readMeta _ = Nothing -- | A helper that runs a parser on a string and, depending on the -- outcome, either returns the result of some command applied to the -- result, or a default value. Used when building structures. parse :: (ByteString -> Maybe a) -> (a -> b) -> b -> ByteString -> b parse parser f x = maybe x f . parser -- | A helper for running a parser returning Maybe on a pair of strings. -- Returns Just if both strings where parsed successfully, Nothing otherwise. pair :: (ByteString -> Maybe a) -> (ByteString, ByteString) -> Maybe (a, a) pair p (x, y) = case (p x, p y) of (Just a, Just b) -> Just (a, b) _ -> Nothing libmpd-0.9.1.0/src/Network/MPD/Commands/Query.hs0000644000000000000000000000332513543437501017366 0ustar0000000000000000{-# LANGUAGE CPP #-} {- | Module : Network.MPD.Commands.Query Copyright : (c) Joachim Fasting 2012 License : MIT Maintainer : Joachim Fasting Stability : unstable Portability : unportable Query interface. -} module Network.MPD.Commands.Query (Query, (=?), (<&>), anything) where import Network.MPD.Commands.Arg import Network.MPD.Commands.Types import Data.Monoid #if MIN_VERSION_base(4,9,0) import Data.Semigroup #endif -- | 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" newtype Query = Query [Match] deriving Show -- A single query clause, comprising a metadata key and a desired value. data Match = Match Metadata Value instance Show Match where show (Match meta query) = show meta ++ " \"" ++ toString query ++ "\"" showList xs _ = unwords $ map show xs instance Monoid Query where mempty = Query [] Query a `mappend` Query b = Query (a ++ b) #if MIN_VERSION_base(4,9,0) instance Semigroup Query where (<>) = mappend #endif instance MPDArg Query where prep = foldl (<++>) (Args []) . f where f (Query ms) = map (\(Match m q) -> Args [show m] <++> q) ms -- | An empty query. Matches anything. anything :: Query anything = mempty -- | Create a query. (=?) :: Metadata -> Value -> Query m =? s = Query [Match m s] -- | Combine queries. infixr 6 <&> (<&>) :: Query -> Query -> Query (<&>) = mappend libmpd-0.9.1.0/src/Network/MPD/Commands/Types.hs0000644000000000000000000003037213613477327017377 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, GeneralizedNewtypeDeriving #-} -- | Module : Network.MPD.Commands.Types -- Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010 -- License : MIT (see LICENSE) -- Maintainer : Joachim Fasting -- Stability : alpha -- -- Various MPD data structures and types module Network.MPD.Commands.Types ( ToString(..) , Artist , Album , Title , PlaylistName(..) , Path(..) , Metadata(..) , Value(..) , ObjectType(..) , Seconds , FractionalSeconds , Decibels , PlaybackState(..) , Subsystem(..) , ReplayGainMode(..) , Count(..) , LsResult(..) , Device(..) , Song(..) , Position , Id(..) , Priority(..) , sgGetTag , sgAddTag , Volume(..) , Stats(..) , Status(..) , def , defaultSong ) where import Network.MPD.Commands.Arg (MPDArg(prep), Args(Args)) import Data.Default.Class import qualified Data.Map as M import Data.Map.Strict (insertWith) import Data.Time.Clock (UTCTime) import Data.String import Data.Text (Text) import qualified Data.Text.Encoding as Text import Data.ByteString (ByteString) import qualified Data.ByteString.UTF8 as UTF8 -- The purpose of this class is to allow users to choose the optimal -- representation of response values. -- | A type class for values that can be converted to `String`s. class ToString a where -- | Convert given value to `String`. toString :: a -> String -- | Convert given value to `Text`. toText :: a -> Text -- | Convert given value to a UTF-8 encoded `ByteString`. toUtf8 :: a -> ByteString type Artist = Value type Album = Value type Title = Value -- | Used for commands which require a playlist name. -- If empty, the current playlist is used. newtype PlaylistName = PlaylistName ByteString deriving (Eq, Show, MPDArg) instance ToString PlaylistName where toString (PlaylistName x) = UTF8.toString x toText (PlaylistName x) = Text.decodeUtf8 x toUtf8 (PlaylistName x) = x instance IsString PlaylistName where fromString = PlaylistName . UTF8.fromString -- | Used for commands which require a path within the database. -- If empty, the root path is used. newtype Path = Path ByteString deriving (Eq, Show, MPDArg) instance ToString Path where toString (Path x) = UTF8.toString x toText (Path x) = Text.decodeUtf8 x toUtf8 (Path x) = x instance IsString Path where fromString = Path . UTF8.fromString -- | Available metadata types\/scope modifiers, used for searching the -- database for entries with certain metadata values. data Metadata = Artist | ArtistSort | Album | AlbumArtist | AlbumArtistSort | Title | Track | Name | Genre | Date | Composer | Performer | Comment | Disc | MUSICBRAINZ_ARTISTID | MUSICBRAINZ_ALBUMID | MUSICBRAINZ_ALBUMARTISTID | MUSICBRAINZ_TRACKID | MUSICBRAINZ_RELEASETRACKID deriving (Eq, Enum, Ord, Bounded, Show) instance MPDArg Metadata -- | A metadata value. newtype Value = Value ByteString deriving (Eq, Show, MPDArg) instance ToString Value where toString (Value x) = UTF8.toString x toText (Value x) = Text.decodeUtf8 x toUtf8 (Value x) = x instance IsString Value where fromString = Value . UTF8.fromString -- | Object types. data ObjectType = SongObj deriving (Eq, Show) instance MPDArg ObjectType where prep SongObj = Args ["song"] type FractionalSeconds = Double type Seconds = Integer type Decibels = Integer -- | Represents the different playback states. data PlaybackState = Playing | Stopped | Paused deriving (Eq, Enum, Ord, Bounded, Show) -- | Represents the various MPD subsystems. data Subsystem = DatabaseS -- ^ The song database | UpdateS -- ^ Database updates | StoredPlaylistS -- ^ Stored playlists | PlaylistS -- ^ The current playlist | PlayerS -- ^ The player | MixerS -- ^ The volume mixer | OutputS -- ^ Audio outputs | OptionsS -- ^ Playback options | StickerS -- ^ Sticker database | SubscriptionS -- ^ Subscription | MessageS -- ^ Message on subscribed channel deriving (Eq, Enum, Ord, Bounded, Show) instance MPDArg Subsystem where prep DatabaseS = Args ["database"] prep UpdateS = Args ["update"] prep StoredPlaylistS = Args ["stored_playlist"] prep PlaylistS = Args ["playlist"] prep PlayerS = Args ["player"] prep MixerS = Args ["mixer"] prep OutputS = Args ["output"] prep OptionsS = Args ["options"] prep StickerS = Args ["sticker"] prep SubscriptionS = Args ["subscription"] prep MessageS = Args ["message"] data ReplayGainMode = Off -- ^ Disable replay gain | TrackMode -- ^ Per track mode | AlbumMode -- ^ Per album mode deriving (Eq, Enum, Ord, Bounded, Show) instance MPDArg ReplayGainMode where prep Off = Args ["off"] prep TrackMode = Args ["track"] prep AlbumMode = Args ["album"] -- | Represents the result of running 'count'. data Count = Count { cSongs :: Integer -- ^ Number of songs matching the query , cPlaytime :: Seconds -- ^ Total play time of matching songs } deriving (Eq, Show) defaultCount :: Count defaultCount = Count { cSongs = 0, cPlaytime = 0 } instance Default Count where def = defaultCount -- | Result of the lsInfo operation data LsResult = LsDirectory Path -- ^ Directory | LsSong Song -- ^ Song | LsPlaylist PlaylistName -- ^ Playlist deriving (Eq, Show) -- | Represents an output device. data Device = Device { dOutputID :: Int -- ^ Output's ID number , dOutputName :: String -- ^ Output's name as defined in the MPD -- configuration file , dOutputEnabled :: Bool } deriving (Eq, Show) defaultDevice :: Device defaultDevice = Device { dOutputID = 0, dOutputName = "", dOutputEnabled = False } instance Default Device where def = defaultDevice -- | Represents a single song item. data Song = Song { sgFilePath :: Path -- | Map of available tags (multiple occurrences of one tag type allowed) , sgTags :: M.Map Metadata [Value] -- | Last modification date , sgLastModified :: Maybe UTCTime -- | Length of the song in seconds , sgLength :: Seconds -- | Id in playlist , sgId :: Maybe Id -- | Position in playlist , sgIndex :: Maybe Position } deriving (Eq, Show) -- | The position of a song in a playlist. type Position = Int newtype Id = Id Int deriving (Eq, Show) instance (MPDArg Id) where prep (Id x) = prep x newtype Priority = Priority Int deriving (Eq, Show) instance (MPDArg Priority) where prep (Priority x) = prep x -- | Get list of specific tag type sgGetTag :: Metadata -> Song -> Maybe [Value] sgGetTag meta s = M.lookup meta $ sgTags s -- | Add metadata tag value. sgAddTag :: Metadata -> Value -> Song -> Song sgAddTag meta value s = s { sgTags = insertWith (++) meta [value] (sgTags s) } defaultSong :: Path -> Song defaultSong path = Song { sgFilePath = path, sgTags = M.empty, sgLastModified = Nothing , sgLength = 0, sgId = Nothing, sgIndex = Nothing } -- | Container for database statistics. data Stats = Stats { stsArtists :: Integer -- ^ Number of artists. , stsAlbums :: Integer -- ^ Number of albums. , stsSongs :: Integer -- ^ Number of songs. , stsUptime :: Seconds -- ^ Daemon uptime in seconds. , stsPlaytime :: Seconds -- ^ Total playing time. , stsDbPlaytime :: Seconds -- ^ Total play time of all the songs in -- the database. , stsDbUpdate :: Integer -- ^ Last database update in UNIX time. } deriving (Eq, Show) defaultStats :: Stats defaultStats = Stats { stsArtists = 0, stsAlbums = 0, stsSongs = 0, stsUptime = 0 , stsPlaytime = 0, stsDbPlaytime = 0, stsDbUpdate = 0 } instance Default Stats where def = defaultStats -- | Volume values. -- -- Values of this type are always in the range 0-100. -- -- Arithmetic on volumes has the property that: -- -- @current + new = 100 if current + new > 100@ -- -- @current - new = 0 if current - new < 0@ -- -- but @current / 0@ still yields a division by zero exception. newtype Volume = Volume Int deriving (Eq, Ord) instance Show Volume where showsPrec p (Volume v) = showsPrec p v instance Enum Volume where toEnum = Volume . min 100 . max 0 fromEnum (Volume x) = x instance Bounded Volume where minBound = 0 maxBound = 100 instance Num Volume where Volume x + Volume y = toEnum (x + y) Volume x - Volume y = toEnum (x - y) Volume x * Volume y = toEnum (x * y) negate = id abs = id signum = const 0 fromInteger = toEnum . fromIntegral instance Integral Volume where quotRem (Volume x) (Volume y) = let (x', y') = x `quotRem` y in (Volume x', Volume y') toInteger (Volume x) = fromIntegral x instance Real Volume where toRational (Volume x) = toRational x instance MPDArg Volume where prep (Volume x) = prep x -- | Container for MPD status. data Status = Status { stState :: PlaybackState -- | A percentage (0-100). -- -- 'Nothing' indicates that the output lacks mixer support. , stVolume :: Maybe Volume , stRepeat :: Bool , stRandom :: Bool -- | A value that is incremented by the server every time the -- playlist changes. , stPlaylistVersion :: Integer -- | The number of items in the current playlist. , stPlaylistLength :: Integer -- | Current song's position in the playlist. , stSongPos :: Maybe Position -- | Current song's playlist ID. , stSongID :: Maybe Id -- | Next song's position in the playlist. , stNextSongPos :: Maybe Position -- | Next song's playlist ID. , stNextSongID :: Maybe Id -- | Time elapsed\/total time of playing song (if any). , stTime :: Maybe (FractionalSeconds, FractionalSeconds) -- | Bitrate (in kilobytes per second) of playing song (if any). , stBitrate :: Maybe Int -- | Crossfade time. , stXFadeWidth :: Seconds -- | MixRamp threshold in dB , stMixRampdB :: Double -- | MixRamp extra delay in seconds , stMixRampDelay :: Double -- | Samplerate\/bits\/channels for the chosen output device -- (see mpd.conf). , stAudio :: (Int, Int, Int) -- | Job ID of currently running update (if any). , stUpdatingDb :: Maybe Integer -- | If True, MPD will play only one song and stop after finishing it. , stSingle :: Bool -- | If True, a song will be removed after it has been played. , stConsume :: Bool -- | Last error message (if any). , stError :: Maybe String -- | The name of MPD partition. , stPartition :: String } deriving (Eq, Show) defaultStatus :: Status defaultStatus = Status { stState = Stopped, stVolume = Just 0, stRepeat = False , stRandom = False, stPlaylistVersion = 0, stPlaylistLength = 0 , stSongPos = Nothing, stSongID = Nothing, stTime = Nothing , stNextSongPos = Nothing, stNextSongID = Nothing , stBitrate = Nothing, stXFadeWidth = 0, stMixRampdB = 0 , stMixRampDelay = 0, stAudio = (0,0,0), stUpdatingDb = Nothing , stSingle = False, stConsume = False, stError = Nothing , stPartition = "" } instance Default Status where def = defaultStatus libmpd-0.9.1.0/src/Network/MPD/Commands/ClientToClient.hs0000644000000000000000000000245313543437501021142 0ustar0000000000000000{-| Module : Network.MPD.Commands.ClientToClient Copyright : (c) Joachim Fasting 2013 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Client-to-client communication. -} module Network.MPD.Commands.ClientToClient ( -- * Types A.ChannelName , A.MessageText -- * Subscribing to channels , subscribe , unsubscribe , channels -- * Communicating with other clients , readMessages , sendMessage ) where ------------------------------------------------------------------------ import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.ClientToClient as A import Network.MPD.Core ------------------------------------------------------------------------ subscribe :: MonadMPD m => A.ChannelName -> m () subscribe = A.runCommand . A.subscribe unsubscribe :: MonadMPD m => A.ChannelName -> m () unsubscribe = A.runCommand . A.subscribe channels :: MonadMPD m => m [A.ChannelName] channels = A.runCommand A.channels readMessages :: MonadMPD m => m [(A.ChannelName, A.MessageText)] readMessages = A.runCommand A.readMessages sendMessage :: MonadMPD m => A.ChannelName -> A.MessageText -> m () sendMessage name text = A.runCommand (A.sendMessage name text) libmpd-0.9.1.0/src/Network/MPD/Commands/Status.hs0000644000000000000000000000310313543437501017536 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.Status Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Querying MPD's status. -} module Network.MPD.Commands.Status ( clearError , currentSong , idle , noidle , stats , status ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.Status as A import Network.MPD.Commands.Types import Network.MPD.Core -- | Clear the current error message in status. clearError :: MonadMPD m => m () clearError = A.runCommand A.clearError -- | Get the currently playing song. currentSong :: MonadMPD m => m (Maybe Song) currentSong = A.runCommand A.currentSong -- | 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'. idle :: MonadMPD m => [Subsystem] -> m [Subsystem] idle = A.runCommand . A.idle -- | Cancel 'idle'. noidle :: MonadMPD m => m () noidle = A.runCommand A.noidle -- | Get server statistics. stats :: MonadMPD m => m Stats stats = A.runCommand A.stats -- | Get the server's status. status :: MonadMPD m => m Status status = A.runCommand A.status libmpd-0.9.1.0/src/Network/MPD/Commands/PlaybackOptions.hs0000644000000000000000000000306513543437501021364 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.PlaybackOptions Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Playback options. -} module Network.MPD.Commands.PlaybackOptions ( consume , crossfade , random , repeat , setVolume , single , replayGainMode , replayGainStatus ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.PlaybackOptions as A import Network.MPD.Commands.Types import Network.MPD.Core import Prelude hiding (repeat) -- | Set consume mode consume :: MonadMPD m => Bool -> m () consume = A.runCommand . A.consume -- | Set crossfading between songs. crossfade :: MonadMPD m => Seconds -> m () crossfade = A.runCommand . A.crossfade -- | Set random playing. random :: MonadMPD m => Bool -> m () random = A.runCommand . A.random -- | Set repeating. repeat :: MonadMPD m => Bool -> m () repeat = A.runCommand . A.repeat -- | Set the volume. setVolume :: MonadMPD m => Volume -> m () setVolume = A.runCommand . A.setVolume -- | Set single mode single :: MonadMPD m => Bool -> m () single = A.runCommand . A.single -- | Set the replay gain mode. replayGainMode :: MonadMPD m => ReplayGainMode -> m () replayGainMode = A.runCommand . A.replayGainMode -- | Get the replay gain options. replayGainStatus :: MonadMPD m => m [(String, String)] replayGainStatus = A.runCommand A.replayGainStatus libmpd-0.9.1.0/src/Network/MPD/Commands/PlaybackControl.hs0000644000000000000000000000267313543437501021355 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.PlaybackControl Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Controlling playback. -} module Network.MPD.Commands.PlaybackControl ( next , pause , play , playId , previous , seek , seekId , stop ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.PlaybackControl as A import Network.MPD.Commands.Types import Network.MPD.Core -- | Play the next song. next :: MonadMPD m => m () next = A.runCommand A.next -- | Pause playing. pause :: MonadMPD m => Bool -> m () pause = A.runCommand . A.pause -- | Begin\/continue playing. play :: MonadMPD m => Maybe Position -> m () play = A.runCommand . A.play -- | Play a file with given id. playId :: MonadMPD m => Id -> m () playId = A.runCommand . A.playId -- | Play the previous song. previous :: MonadMPD m => m () previous = A.runCommand A.previous -- | Seek to some point in a song. seek :: MonadMPD m => Position -> FractionalSeconds -> m () seek pos = A.runCommand . A.seek pos -- | Seek to some point in a song (id version) seekId :: MonadMPD m => Id -> FractionalSeconds -> m () seekId id' = A.runCommand . A.seekId id' -- | Stop playing. stop :: MonadMPD m => m () stop = A.runCommand A.stop libmpd-0.9.1.0/src/Network/MPD/Commands/CurrentPlaylist.hs0000644000000000000000000001174413543437501021431 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} {- | Module : Network.MPD.Commands.CurrentPlaylist Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable The current playlist. -} module Network.MPD.Commands.CurrentPlaylist ( addId , add , clear , delete , deleteId , move , moveId , playlist , playlistFind , playlistInfo , playlistInfoRange , playlistId , playlistSearch , plChanges , plChangesPosId , prio , prioId , shuffle , swap , swapId , addTagId , clearTagId , rangeId ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.CurrentPlaylist as A import Network.MPD.Commands.Query import Network.MPD.Commands.Types import Network.MPD.Core import Network.MPD.Util import Control.Monad.Error (throwError) -- | Like 'add', but returns a playlist id. addId :: MonadMPD m => Path -> Maybe Position -> m Id addId path = A.runCommand . A.addId path -- | Add a song (or a whole directory) to the current playlist. add :: MonadMPD m => Path -> m () add = A.runCommand . A.add -- | Clear the current playlist. clear :: MonadMPD m => m () clear = A.runCommand A.clear -- | Remove a song from the current playlist. delete :: MonadMPD m => Position -> m () delete = A.runCommand . A.delete -- | Remove a song from the current playlist. deleteId :: MonadMPD m => Id -> m () deleteId = A.runCommand . A.deleteId -- | Move a song to a given position in the current playlist. move :: MonadMPD m => Position -> Position -> m () move pos = A.runCommand . A.move pos -- | 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). moveId :: MonadMPD m => Id -> Position -> m () moveId i = A.runCommand . A.moveId i -- | 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. playlist :: MonadMPD m => m [(Position, Path)] playlist = mapM f =<< getResponse "playlist" where f s | (pos, name) <- breakChar ':' s , Just pos' <- parseNum pos = return (pos', Path name) | otherwise = throwError . Unexpected $ show s {-# WARNING playlist "this is deprecated; please use 'playlistInfo' instead." #-} -- | Search for songs in the current playlist with strict matching. playlistFind :: MonadMPD m => Query -> m [Song] playlistFind = A.runCommand . A.playlistFind -- | Retrieve metadata for songs in the current playlist. playlistInfo :: MonadMPD m => Maybe Position -> m [Song] playlistInfo = A.runCommand . A.playlistInfo -- | Like 'playlistInfo' but can restrict to a range of songs. playlistInfoRange :: MonadMPD m => Maybe (Position, Position) -> m [Song] playlistInfoRange = A.runCommand . A.playlistInfoRange -- | Displays a list of songs in the playlist. -- If id is specified, only its info is returned. playlistId :: MonadMPD m => Maybe Id -> m [Song] playlistId = A.runCommand . A.playlistId -- | Search case-insensitively with partial matches for songs in the -- current playlist. playlistSearch :: MonadMPD m => Query -> m [Song] playlistSearch = A.runCommand . A.playlistSearch -- | Retrieve a list of changed songs currently in the playlist since -- a given playlist version. plChanges :: MonadMPD m => Integer -> m [Song] plChanges = A.runCommand . A.plChanges -- | Like 'plChanges' but only returns positions and ids. plChangesPosId :: MonadMPD m => Integer -> m [(Position, Id)] plChangesPosId = A.runCommand . A.plChangesPosId -- | Set the priority of the specified songs. prio :: MonadMPD m => Priority -> (Position, Position) -> m () prio p = A.runCommand . A.prio p -- | Set priority by song id. prioId :: MonadMPD m => Priority -> Id -> m () prioId p = A.runCommand . A.prioId p -- | Shuffle the playlist. shuffle :: MonadMPD m => Maybe (Position, Position) -- ^ Optional range (start, end) -> m () shuffle = A.runCommand . A.shuffle -- | Swap the positions of two songs. swap :: MonadMPD m => Position -> Position -> m () swap pos1 = A.runCommand . A.swap pos1 -- | Swap the positions of two songs (Id version) swapId :: MonadMPD m => Id -> Id -> m () swapId id1 = A.runCommand . A.swapId id1 -- | Add tag to (remote) song. addTagId :: (MonadMPD m) => Id -> Metadata -> Value -> m () addTagId id' tag = A.runCommand . A.addTagId id' tag -- | Remove tag from (remote) song. clearTagId :: (MonadMPD m) => Id -> Metadata -> m () clearTagId id' = A.runCommand . A.clearTagId id' -- | Specify portion of song that shall be played. -- Both ends of the range are optional; omitting both plays everything. rangeId :: (MonadMPD m) => Id -> (Maybe Double, Maybe Double) -> m () rangeId id' = A.runCommand . A.rangeId id' libmpd-0.9.1.0/src/Network/MPD/Commands/StoredPlaylists.hs0000644000000000000000000000470513543437501021431 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.StoredPlaylists Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Stored playlists. -} module Network.MPD.Commands.StoredPlaylists ( listPlaylist , listPlaylistInfo , listPlaylists , load , playlistAdd , playlistClear , playlistDelete , playlistMove , rename , rm , save ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.StoredPlaylists as A import Network.MPD.Commands.Types import Network.MPD.Core -- | Retrieve a list of files in a given playlist. listPlaylist :: MonadMPD m => PlaylistName -> m [Path] listPlaylist = A.runCommand . A.listPlaylist -- | Retrieve metadata for files in a given playlist. listPlaylistInfo :: MonadMPD m => PlaylistName -> m [Song] listPlaylistInfo = A.runCommand . A.listPlaylistInfo -- | Retreive a list of stored playlists. listPlaylists :: MonadMPD m => m [PlaylistName] listPlaylists = A.runCommand A.listPlaylists -- | Load an existing playlist. load :: MonadMPD m => PlaylistName -> m () load = A.runCommand . A.load -- | Add a song (or a whole directory) to a stored playlist. -- Will create a new playlist if the one specified does not already exist. playlistAdd :: MonadMPD m => PlaylistName -> Path -> m () playlistAdd plname = A.runCommand . A.playlistAdd plname -- | Clear a playlist. If the specified playlist does not exist, it will be -- created. playlistClear :: MonadMPD m => PlaylistName -> m () playlistClear = A.runCommand . A.playlistClear -- | Remove a song from a playlist. playlistDelete :: MonadMPD m => PlaylistName -> Position -> m () playlistDelete name = A.runCommand . A.playlistDelete name -- | Move a song to a given position in the playlist specified. playlistMove :: MonadMPD m => PlaylistName -> Id -> Position -> m () playlistMove name from = A.runCommand . A.playlistMove name from -- | Rename an existing playlist. rename :: MonadMPD m => PlaylistName -- ^ Original playlist -> PlaylistName -- ^ New playlist name -> m () rename plname = A.runCommand . A.rename plname -- | Delete existing playlist. rm :: MonadMPD m => PlaylistName -> m () rm = A.runCommand . A.rm -- | Save the current playlist. save :: MonadMPD m => PlaylistName -> m () save = A.runCommand . A.save libmpd-0.9.1.0/src/Network/MPD/Commands/Database.hs0000644000000000000000000000451513543437501017767 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.Database Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable The music database. -} module Network.MPD.Commands.Database ( count , find , findAdd , list , listAll , listAllInfo , lsInfo , readComments , search , update , rescan ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.Database as A import Network.MPD.Commands.Query import Network.MPD.Commands.Types import Network.MPD.Core -- | Count the number of entries matching a query. count :: MonadMPD m => Query -> m Count count = A.runCommand . A.count -- | Search the database for entries exactly matching a query. find :: MonadMPD m => Query -> m [Song] find = A.runCommand . A.find -- | Adds songs matching a query to the current playlist. findAdd :: MonadMPD m => Query -> m () findAdd = A.runCommand . A.findAdd -- | List all tags of the specified type. list :: MonadMPD m => Metadata -- ^ Metadata to list -> Maybe Artist -> m [Value] list m = A.runCommand . A.list m -- | List the songs (without metadata) in a database directory recursively. listAll :: MonadMPD m => Path -> m [Path] listAll = A.runCommand . A.listAll -- | Recursive 'lsInfo'. listAllInfo :: MonadMPD m => Path -> m [LsResult] listAllInfo = A.runCommand . A.listAllInfo -- | Non-recursively list the contents of a database directory. lsInfo :: MonadMPD m => Path -> m [LsResult] lsInfo = A.runCommand . A.lsInfo -- | Read comments from file at path. readComments :: MonadMPD m => Path -> m [(String, String)] readComments = A.runCommand . A.readComments -- | Search the database using case insensitive matching. search :: MonadMPD m => Query -> m [Song] search = A.runCommand . A.search -- | 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. update :: MonadMPD m => Maybe Path -> m Integer update = A.runCommand . A.update -- | Like 'update' but also rescans unmodified files. rescan :: MonadMPD m => Maybe Path -> m Integer rescan = A.runCommand . A.rescan libmpd-0.9.1.0/src/Network/MPD/Commands/Stickers.hs0000644000000000000000000000371513543437501020053 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.Stickers Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Stickers. -} module Network.MPD.Commands.Stickers ( stickerGet , stickerSet , stickerDelete , stickerList , stickerFind ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.Stickers as A import Network.MPD.Commands.Types import Network.MPD.Core -- | Reads a sticker value for the specified object. stickerGet :: MonadMPD m => ObjectType -> String -- ^ Object URI -> String -- ^ Sticker name -> m [String] stickerGet typ uri = A.runCommand . A.stickerGet typ uri -- | Adds a sticker value to the specified object. stickerSet :: MonadMPD m => ObjectType -> String -- ^ Object URI -> String -- ^ Sticker name -> String -- ^ Sticker value -> m () stickerSet typ uri name = A.runCommand . A.stickerSet typ uri name -- | Delete a sticker value from the specified object. stickerDelete :: MonadMPD m => ObjectType -> String -- ^ Object URI -> String -- ^ Sticker name -> m () stickerDelete typ uri = A.runCommand . A.stickerDelete typ uri -- | Lists the stickers for the specified object. stickerList :: MonadMPD m => ObjectType -> String -- ^ Object URI -> m [(String, String)] -- ^ Sticker name\/sticker value stickerList typ = A.runCommand . A.stickerList typ -- | Searches the sticker database for stickers with the specified name, below -- the specified path. stickerFind :: MonadMPD m => ObjectType -> String -- ^ Path -> String -- ^ Sticker name -> m [(String, String)] -- ^ URI\/sticker value stickerFind typ uri = A.runCommand . A.stickerFind typ uri libmpd-0.9.1.0/src/Network/MPD/Commands/Connection.hs0000644000000000000000000000155413543437501020362 0ustar0000000000000000{- | Module : Network.MPD.Commands.Connection Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Connection settings. -} module Network.MPD.Commands.Connection ( password , ping ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.Connection as A import Network.MPD.Core -- XXX should the password be quoted? Change "++" to "<@>" if so. If -- it should, it also needs to be fixed in N.M.Core. -- | Send password to server to authenticate session. -- Password is sent as plain text. password :: MonadMPD m => String -> m () password = A.runCommand . A.password -- | Check that the server is still responding. ping :: MonadMPD m => m () ping = A.runCommand A.ping libmpd-0.9.1.0/src/Network/MPD/Commands/Output.hs0000644000000000000000000000205613543437501017561 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.Output Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Audio output devices. -} module Network.MPD.Commands.Output ( disableOutput , enableOutput , toggleOutput , outputs ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.Output as A import Network.MPD.Core import Network.MPD.Commands.Types -- | Turn off an output device. disableOutput :: MonadMPD m => Int -> m () disableOutput = A.runCommand . A.disableOutput -- | Turn on an output device. enableOutput :: MonadMPD m => Int -> m () enableOutput = A.runCommand . A.enableOutput -- | Toggle output device. toggleOutput :: MonadMPD m => Int -> m () toggleOutput = A.runCommand . A.toggleOutput -- | Retrieve information for all output devices. outputs :: MonadMPD m => m [Device] outputs = A.runCommand A.outputs libmpd-0.9.1.0/src/Network/MPD/Commands/Reflection.hs0000644000000000000000000000256213543437501020355 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.Reflection Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012 License : MIT (see LICENSE) Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Reflection. -} module Network.MPD.Commands.Reflection ( commands , notCommands , tagTypes , urlHandlers , decoders , config ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.Reflection as A import Network.MPD.Core -- | Retrieve a list of available commands. commands :: MonadMPD m => m [String] commands = A.runCommand A.commands -- | Retrieve a list of unavailable (due to access restrictions) commands. notCommands :: MonadMPD m => m [String] notCommands = A.runCommand A.notCommands -- | Retrieve a list of available song metadata. tagTypes :: MonadMPD m => m [String] tagTypes = A.runCommand A.tagTypes -- | Retrieve a list of supported urlhandlers. urlHandlers :: MonadMPD m => m [String] urlHandlers = A.runCommand A.urlHandlers -- | Retreive a list of decoder plugins with associated suffix and mime types. decoders :: MonadMPD m => m [(String, [(String, String)])] decoders = A.runCommand A.decoders -- | Retrieve configuration keys and values. config :: MonadMPD m => m [(String, String)] config = A.runCommand A.config libmpd-0.9.1.0/src/Network/MPD/Commands/Mount.hs0000644000000000000000000000151713543437501017364 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Network.MPD.Commands.Mount Copyright : (c) Joachim Fasting 2014 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Mounting remote storage. -} module Network.MPD.Commands.Mount ( mount , unmount , listMounts , listNeighbors ) where import qualified Network.MPD.Applicative.Internal as A import qualified Network.MPD.Applicative.Mount as A import Network.MPD.Core mount :: (MonadMPD m) => String -> String -> m () mount p = A.runCommand . A.mount p unmount :: (MonadMPD m) => String -> m () unmount = A.runCommand . A.unmount listMounts :: (MonadMPD m) => m [(String, String)] listMounts = A.runCommand A.listMounts listNeighbors :: (MonadMPD m) => m [(String, String)] listNeighbors = A.runCommand A.listNeighbors libmpd-0.9.1.0/src/Network/MPD/Applicative/Util.hs0000644000000000000000000000241713543437501017677 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.MPD.Applicative.Util where import Network.MPD.Commands.Parse import Network.MPD.Commands.Types import Network.MPD.Util import Control.Monad (liftM) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 -- Separate the result of an lsinfo\/listallinfo call into directories, -- playlists, and songs. takeEntries :: [ByteString] -> Either String [LsResult] takeEntries = mapM toEntry . splitGroups groupHeads . toAssocList where toEntry xs@(("file",_):_) = LsSong `liftM` parseSong xs toEntry (("directory",d):_) = (return . LsDirectory . Path) d toEntry (("playlist",pl):_) = (return . LsPlaylist . PlaylistName) pl toEntry _ = error "takeEntries: splitGroups is broken" groupHeads = ["file", "directory", "playlist"] takeSongs :: [ByteString] -> Either String [Song] takeSongs = mapM parseSong . splitGroups ["file"] . toAssocList -- Run 'toAssocList' and return only the values. takeValues :: [ByteString] -> [ByteString] takeValues = snd . unzip . toAssocList -- an internal helper function decodePair :: (ByteString, ByteString) -> (String, String) decodePair (x, y) = (UTF8.toString x, UTF8.toString y) libmpd-0.9.1.0/src/Network/MPD/Applicative/Internal.hs0000644000000000000000000000603713613474506020544 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE CPP #-} {- | Module : Network.MPD.Applicative.Internal Copyright : (c) Simon Hengel 2012 License : MIT Maintainer : joachifm@fastmail.fm Stability : stable Portability : unportable Applicative MPD command interface. This allows us to combine commands into command lists, as in > (,,) <$> currentSong <*> stats <*> status where the requests are automatically combined into a command list and the result of each command passed to the consumer. -} module Network.MPD.Applicative.Internal ( Parser(..) , liftParser , getResponse , emptyResponse , unexpected , Command(..) , runCommand ) where import Control.Applicative import Control.Monad import Data.ByteString.Char8 (ByteString) import Network.MPD.Core hiding (getResponse) import qualified Network.MPD.Core as Core import Control.Monad.Error import qualified Control.Monad.Fail as Fail -- | A line-oriented parser that returns a value along with any remaining input. newtype Parser a = Parser { runParser :: [ByteString] -> Either String (a, [ByteString]) } deriving Functor instance Monad Parser where return a = Parser $ \input -> Right (a, input) p1 >>= p2 = Parser $ \input -> runParser p1 input >>= uncurry (runParser . p2) instance Fail.MonadFail Parser where fail = Prelude.fail instance Applicative Parser where pure = return (<*>) = ap -- | Convert a regular parser. liftParser :: ([ByteString] -> Either String a) -> Parser a liftParser p = Parser $ \input -> case break (== "list_OK") input of (xs, ys) -> fmap (, drop 1 ys) (p xs) -- | Return everything until the next "list_OK". getResponse :: Parser [ByteString] getResponse = Parser $ \input -> case break (== "list_OK") input of (xs, ys) -> Right (xs, drop 1 ys) -- | For commands returning an empty response. emptyResponse :: Parser () emptyResponse = do r <- getResponse unless (null r) $ unexpected r -- | Fail with unexpected response. unexpected :: [ByteString] -> Parser a unexpected = fail . ("unexpected Response: " ++) . show -- | A compound command, comprising a parser for the responses and a -- combined request of an arbitrary number of commands. data Command a = Command { commandParser :: Parser a , commandRequest :: [String] } deriving Functor instance Applicative Command where pure a = Command (pure a) [] (Command p1 c1) <*> (Command p2 c2) = Command (p1 <*> p2) (c1 ++ c2) -- | Execute a 'Command'. runCommand :: MonadMPD m => Command a -> m a runCommand (Command p c) = do r <- Core.getResponse command case runParser p r of Left err -> throwError (Unexpected err) Right (a, []) -> return a Right (_, xs) -> throwError (Unexpected $ "superfluous input: " ++ show xs) where command = case c of [x] -> x xs -> unlines ("command_list_ok_begin" : xs) ++ "command_list_end" libmpd-0.9.1.0/src/Network/MPD/Util.hs0000644000000000000000000001012613543437501015432 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, CPP #-} -- | Module : Network.MPD.Util -- Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010 -- License : MIT (see LICENSE) -- Maintainer : Joachim Fasting -- Stability : alpha -- -- Utilities. module Network.MPD.Util ( parseDate, parseIso8601, formatIso8601, parseNum, parseFrac, parseBool, showBool, breakChar, parseTriple, toAssoc, toAssocList, splitGroups, read ) where import Control.Arrow import Data.Time.Format (ParseTime, parseTime, FormatTime, formatTime) #if MIN_VERSION_time(1,5,0) import Data.Time.Format (defaultTimeLocale) #else import System.Locale (defaultTimeLocale) #endif import qualified Prelude import Prelude hiding (break, take, drop, dropWhile, read) import Data.ByteString.Char8 (break, drop, dropWhile, ByteString) import qualified Data.ByteString.UTF8 as UTF8 import Data.String import Control.Applicative import qualified Data.Attoparsec.ByteString.Char8 as A -- | Like Prelude.read, but works with ByteString. read :: Read a => ByteString -> a read = Prelude.read . UTF8.toString -- Break a string by character, removing the separator. breakChar :: Char -> ByteString -> (ByteString, ByteString) breakChar c = second (drop 1) . break (== c) -- Parse a date value. -- > parseDate "2008" = Just 2008 -- > parseDate "2008-03-01" = Just 2008 parseDate :: ByteString -> Maybe Int parseDate = parseMaybe p where p = A.decimal <* A.skipMany (A.char '-' <|> A.digit) -- Parse date in iso 8601 format parseIso8601 :: (ParseTime t) => ByteString -> Maybe t parseIso8601 = parseTime defaultTimeLocale iso8601Format . UTF8.toString formatIso8601 :: FormatTime t => t -> String formatIso8601 = formatTime defaultTimeLocale iso8601Format iso8601Format :: String iso8601Format = "%FT%TZ" -- Parse a positive or negative integer value, returning 'Nothing' on failure. parseNum :: (Read a, Integral a) => ByteString -> Maybe a parseNum = parseMaybe (A.signed A.decimal) -- Parse C style floating point value, returning 'Nothing' on failure. parseFrac :: (Fractional a, Read a) => ByteString -> Maybe a parseFrac = parseMaybe p where p = A.string "nan" *> pure (Prelude.read "NaN") <|> A.string "inf" *> pure (Prelude.read "Infinity") <|> A.string "-inf" *> pure (Prelude.read "-Infinity") <|> A.rational -- Inverts 'parseBool'. showBool :: IsString a => Bool -> a -- FIXME: can we change the type to (Bool -> ByteString)? -- not without also changing Arg to use bytestrings rather than plain String. showBool x = if x then "1" else "0" -- Parse a boolean response value. parseBool :: ByteString -> Maybe Bool parseBool = parseMaybe p where p = A.char '1' *> pure True <|> A.char '0' *> pure False -- Break a string into triple. parseTriple :: Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a) parseTriple c f s = let (u, u') = breakChar c s (v, w) = breakChar c u' in case (f u, f v, f w) of (Just a, Just b, Just c') -> Just (a, b, c') _ -> Nothing -- Break a string into a key-value pair, separating at the first ':'. toAssoc :: ByteString -> (ByteString, ByteString) toAssoc = second (dropWhile (== ' ') . drop 1) . break (== ':') toAssocList :: [ByteString] -> [(ByteString, ByteString)] toAssocList = map toAssoc -- Takes an association list with recurring keys and groups each cycle of keys -- with their values together. There can be several keys that begin cycles, -- (the elements of the first parameter). splitGroups :: [ByteString] -> [(ByteString, ByteString)] -> [[(ByteString, ByteString)]] splitGroups groupHeads = go where go [] = [] go (x:xs) = let (ys, zs) = Prelude.break isGroupHead xs in (x:ys) : go zs isGroupHead = (`elem` groupHeads) . fst -- A helper for running a Parser, turning errors into Nothing. parseMaybe :: A.Parser a -> ByteString -> Maybe a parseMaybe p s = either (const Nothing) Just $ A.parseOnly (p <* A.endOfInput) s libmpd-0.9.1.0/tests/Main.hs0000644000000000000000000000005413543437501013702 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} libmpd-0.9.1.0/LICENSE0000644000000000000000000000253113543437501012327 0ustar0000000000000000Copyright (c) 2005-2009 Ben Sinclair Copyright (c) 2007-2015 Joachim Fasting Copyright (c) 2009 Daniel Schoepe Copyright (c) 2010 Andrzej Rybczak Copyright (c) 2011-2014 Simon Hengel Copyright (c) 2012 Niklas Haas Copyright (c) 2014 Matvey Aksenov Copyright (c) 2014 Wieland Hoffmann Copyright (c) 2014 Tim Heap Copyright (c) 2014 Tobias Brandt Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. libmpd-0.9.1.0/Setup.lhs0000755000000000000000000000011413543437501013130 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain libmpd-0.9.1.0/libmpd.cabal0000644000000000000000000000765213613477327013576 0ustar0000000000000000Name: libmpd Version: 0.9.1.0 Synopsis: An MPD client library. Description: A client library for MPD, the Music Player Daemon. Category: Network, Sound License: MIT License-file: LICENSE Copyright: Ben Sinclair 2005-2009, Joachim Fasting 2007-2015, Daniel Schoepe 2009, Andrzej Rybczak 2010, Simon Hengel 2011-2014, Niklas Haas 2012, Matvey Aksenov 2014, Wieland Hoffmann 2014, Tim Heap 2014, Tobias Brandt 2014 Author: Ben Sinclair Maintainer: Joachim Fasting Stability: beta Homepage: http://github.com/vimus/libmpd-haskell#readme Bug-reports: http://github.com/vimus/libmpd-haskell/issues Tested-With: GHC ==8.0.1, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 Build-Type: Simple Cabal-Version: >= 1.10 Extra-Source-Files: README.md changelog.md tests/*.hs Source-Repository head type: git location: https://github.com/vimus/libmpd-haskell Library Default-Language: Haskell2010 Hs-Source-Dirs: src Build-Depends: -- Platform dependencies base >= 4.9 && < 5 , attoparsec >= 0.10.1 && < 1 , bytestring >= 0.9 && < 1 , containers >= 0.3 && < 1 , filepath >= 1 && < 2 , mtl >= 2.0 && < 3 , old-locale >= 1 && < 2 , text >= 0.11 && < 2 -- Additional dependencies , data-default-class >= 0.0.1 && < 1 , network >= 2.6.3.5 , safe-exceptions >= 0.1 && < 0.2 , utf8-string >= 0.3.1 && < 1.1 if impl(ghc >= 7.10.0) Build-Depends: time >= 1.5 else Build-Depends: time >= 1.1 && <1.5 Exposed-Modules: Network.MPD , Network.MPD.Applicative , Network.MPD.Applicative.ClientToClient , Network.MPD.Applicative.Connection , Network.MPD.Applicative.CurrentPlaylist , Network.MPD.Applicative.Database , Network.MPD.Applicative.Mount , Network.MPD.Applicative.Output , Network.MPD.Applicative.PlaybackControl , Network.MPD.Applicative.PlaybackOptions , Network.MPD.Applicative.Reflection , Network.MPD.Applicative.Status , Network.MPD.Applicative.Stickers , Network.MPD.Applicative.StoredPlaylists , Network.MPD.Commands.Extensions , Network.MPD.Core Other-Modules: Network.MPD.Core.Class , Network.MPD.Core.Error , Network.MPD.Commands , Network.MPD.Commands.Arg , Network.MPD.Commands.Parse , Network.MPD.Commands.Query , Network.MPD.Commands.Types , Network.MPD.Commands.ClientToClient , Network.MPD.Commands.Status , Network.MPD.Commands.PlaybackOptions , Network.MPD.Commands.PlaybackControl , Network.MPD.Commands.CurrentPlaylist , Network.MPD.Commands.StoredPlaylists , Network.MPD.Commands.Database , Network.MPD.Commands.Stickers , Network.MPD.Commands.Connection , Network.MPD.Commands.Output , Network.MPD.Commands.Reflection , Network.MPD.Commands.Mount , Network.MPD.Applicative.Util , Network.MPD.Applicative.Internal , Network.MPD.Util ghc-options: -Wall Test-Suite specs type: exitcode-stdio-1.0 Default-Language: Haskell2010 Main-Is: Main.hs Hs-Source-Dirs: src tests cpp-options: -DTEST -Wall -Werror ghc-options: -fno-warn-missing-signatures Build-Depends: -- Platform dependencies base , attoparsec , bytestring , containers , filepath , mtl , old-locale , text , time -- Additional dependencies , data-default-class , network , safe-exceptions , utf8-string -- Test dependencies , unix , QuickCheck >= 2.10 , hspec >= 1.3 libmpd-0.9.1.0/README.md0000644000000000000000000000466013543437501012606 0ustar0000000000000000# libmpd-haskell: a client library for MPD [![Hackage](https://budueba.com/hackage/libmpd)](http://hackage.haskell.org/package/libmpd) [![Build Status](https://secure.travis-ci.org/vimus/libmpd-haskell.png?branch=master)](http://travis-ci.org/vimus/libmpd-haskell) ## About libmpd-haskell is a pure [Haskell] client library for [MPD], the music playing daemon. [MPD]: http://www.musicpd.org [Haskell]: http://www.haskell.org ## Getting * [Latest release on Hackage] * `git clone git://github.com/vimus/libmpd-haskell.git` [Latest release on Hackage]: https://hackage.haskell.org/package/libmpd "libmpd-haskell on Hackage" ## Installation With [cabal-install], do `cd libmpd-haskell && cabal install` [cabal-install]: https://hackage.haskell.org/package/cabal-install ## Usage With GHCi: > :set -XOverloadedStrings > import Network.MPD > withMPD $ lsInfo "" Right [LsDirectory "Tool", LsDirectory "Tom Waits",...] > withMPD $ add "Tom Waits/Big Time" Right ["Tom Waits/Big Time/01 - 16 Shells from a Thirty-Ought-Six.mp3",...] ## MPD API compliance Any deviation from the latest version of the [MPD protocol reference] is a bug. ## Submitting bug reports See our [bug tracker]. Test cases are highly appreciated. ## Submitting patches To submit a patch, use `git format-patch` and email the resulting file(s) to one of the developers or upload it to the [bug tracker]. Alternatively you can create your own fork of the [GitHub repository] and send a pull request. Well-formatted patches are appreciated. New features should have a test case. ## See also * [vimus], an MPD client with vim-like keybindings [vimus]: https://github.com/vimus/vimus ## Resources * [API documentation] * [MPD protocol reference] * [Using GitHub] * \#vimus @ irc.freenode.net [bug tracker]: https://github.com/vimus/libmpd-haskell/issues [GitHub]: https://github.com [GitHub repository]: https://github.com/vimus/libmpd-haskell [API documentation]: https://hackage.haskell.org/packages/archive/libmpd/latest/doc/html/Network-MPD.html [MPD protocol reference]: http://www.musicpd.org/doc/protocol/ [Using GitHub]: https://help.github.com ## License libmpd-haskell is distributed under the [MIT license]. [MIT license]: http://opensource.org/licenses/MIT ## Contributors See [CONTRIBUTORS](https://github.com/vimus/libmpd-haskell/blob/master/CONTRIBUTORS) in the source distribution. Feel free to add yourself to this list if you deem it appropriate to do so. libmpd-0.9.1.0/changelog.md0000644000000000000000000001045513613477327013607 0ustar0000000000000000* v0.9.1.0 - Support partition in Network.MPD.Status - Ignore unknown key-value pairs in Network.MPD.status so that it breaks much less often. * v0.9.0.10 - Port it for newer network library * v0.9.0, 2014-09-21 - New commands: `deleteRange`, `moveRange`, `playlistInfoRange`, `searchAdd`, `searchAddpl`. - Fix `playlistId` and `list` - Add Mixramp commands - Support for MPD 0.17 - Support for missing metadata keys. - Sticker idle events - Subscription and message events - New applicative interface which allows combining arbitrary commands into command lists (sol). - Consistent typing for song positions (sol). - Command definitions closer to the MPD spec; compound commands have been moved to `N.M.C.Extensions`. - `Status.{stUpdatingDb,stTime,stBitrate,stVolume` are now `Maybe` - `MonadMPD.getHandle` has been removed - Re-connect and retry on `ResourceVanished` (e.g., when the connection times out). * v0.8.0, 2012-04-21 - Use bytestring for wire communication (sol) - Increased type safety (sol) - Improved memory usage (sol) - `lsinfo` supports playlists (nandykins) - `idle` now takes a list of subsystems (sol) - `currentSong` works when playback is stopped (sol) - Fixes failure on songs without associated paths (sol) - `LsResult` replaces `EntryType` (nandykins) - hspec based testing added to the test-suite - More extensive parser testing - `MPDError` now has an `Exception` instance - Lower bound on Cabal bumped to 1.10 * v0.7.2, 2012-02-13 - Release connections. Reported by Kanisterschleife on GitHub. - Some minor internal changes (sol) * v0.7.1, 2012-02-07 - Compatible with GHC 7.4.1 * v0.7.0, 2011-11-22 - Several fixes to the test harness (Simon Hengel) - Fixed issue with the (<$>) operator (Simon Hengel) - Type safe handling of song IDs (Simon Hengel) - Check MPD version on connect (now depends on MPD >= 0.15) (Simon Hengel) - Compatibility with GHC 7.2 (Daniel Wagner) * v0.6.0, 2011-04-01 - Reverted some changes from 0.5.0 that caused problems, most notably the parser improvements have been removed for now. - Support for GHC 7 - Removed support for building against the deprecated base 3 package - Added an `Enum` instance for `Metadata` - Removed the `old_base` flag * v0.5.0, 2010-09-08 - Moved extensions to Network.MPD.Commands.Extensions These might be removed in a later version - Non-blocking `idle` - The API is closer to the MPD spec, by untangling functionality - Better MPD API coverage - Improved parser implementation, now runs in constant space - Constructors of the `Subsystem` type have been renamed - Passwords can be changed using `setPassword` - The connection handle can be accessed via `getHandle` - The version of the MPD server is available via `getVersion` - Added support for connecting via unix sockets * v0.4.2, 2010-08-31 - Only depend on QuickCheck when building the test target * v0.4.1, 2010-03-26 - Fix building test and coverage targets * v0.4.0, 2010-03-26 - New maintainer: Joachim Fasting \ - Support QuickCheck 2 - Better MPD api support Should be mostly compatible with mpd 0.16 - Separated operations on current playlist from those on specific playlists - Fixed password sending - Several minor fixes and cleanups * v0.3.1, 2008-09-14 - Now reconnects if MPD closes the connection. * v0.3.0, 2008-05-06 - UTF-8 support (now depends on utf8-string package). - Fixed corruption by `show` of command parameters. - Tidied up `Query` interface. - Moved StringConn out of Network.MPD to the tests directory. * v0.2.1, 2008-04-14 - Cleaned up libmpd.cabal. * v0.2.0, 2008-04-14 - A connection stub for testing purposes. - QuickCheck tests for parsing. - Partial unit test coverage. - Many bug fixes. - Precise error handling. - Parsing improvements. - Code coverage generation. - Cabal 1.2 support. - Uniform command names. * v0.1.3, 2007-10-02 - Bugfixes. * v0.1.2, 2007-09-29 - Changed name to libmpd. * v0.1.1, 2007-09-28 - Missing files added to the source distribution. * v0.1, 2007-09-28 - Initial public release. libmpd-0.9.1.0/tests/TypeSpec.hs0000644000000000000000000000175513543437501014563 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module TypeSpec (main, spec) where import Test.Hspec import Test.Hspec.QuickCheck (prop) import qualified Test.QuickCheck as QC import Network.MPD.Commands.Types (Volume) main :: IO () main = hspec spec spec :: Spec spec = do describe "Volume arithmetic is closed over 0-100" $ do prop "for addition" prop_volume_add prop "for subtraction" prop_volume_sub prop "for multiplication" prop_volume_mul prop "for division" prop_volume_div instance QC.Arbitrary Volume where arbitrary = QC.elements [0..100] inRange :: Ord a => a -> a -> a -> Bool inRange l h x = l <= x && x <= h prop_volume_arith op cur new = inRange 0 100 ((cur :: Volume) `op` new) prop_volume_add = prop_volume_arith (+) prop_volume_sub = prop_volume_arith (-) prop_volume_mul = prop_volume_arith (*) prop_volume_div cur new = new /= 0 QC.==> prop_volume_arith div cur new libmpd-0.9.1.0/tests/StringConn.hs0000644000000000000000000000526213543437501015110 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} {-# OPTIONS_GHC -Wwarn #-} -- | -- Module : StringConn -- Copyright : (c) Ben Sinclair 2005-2009 -- License : MIT (see LICENSE) -- Stability : alpha -- -- A testing scaffold for MPD commands module StringConn where import Control.Applicative import Prelude hiding (exp) import Control.Monad.Error import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.State import Network.MPD.Core import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.UTF8 as UTF8 -- | An expected request. type Expect = String data StringMPDError = TooManyRequests | UnexpectedRequest Expect String deriving (Show, Eq) data Result a = Ok | BadResult (Response a) (Response a) -- expected, then actual | BadRequest StringMPDError deriving (Show, Eq) newtype StringMPD a = SMPD { runSMPD :: ErrorT MPDError (StateT [(Expect, Response String)] (ReaderT Password Identity)) a } deriving (Functor, Applicative, Monad, MonadError MPDError) instance MonadMPD StringMPD where getVersion = error "StringConn.getVersion: undefined" setPassword = error "StringConn.setPassword: undefined" open = return () close = return () getPassword = SMPD ask send request = SMPD $ do ~pairs@((expected_request,response):rest) <- get when (null pairs) (throwError $ Custom "too many requests") when (expected_request /= request) (throwError . Custom $ "unexpected request: " ++ show request ++ ", expected: " ++ show expected_request) put rest either throwError (return . B.lines . UTF8.fromString) response testMPD :: (Eq a) => [(Expect, Response String)] -> StringMPD a -> Response a testMPD pairs m = testMPDWithPassword pairs "" m -- | Run an action against a set of expected requests and responses, -- and an expected result. The result is Nothing if everything matched -- what was expected. If anything differed the result of the -- computation is returned along with pairs of expected and received -- requests. testMPDWithPassword :: (Eq a) => [(Expect, Response String)] -- ^ The expected requests and their -- ^ corresponding responses. -> Password -- ^ A password to be supplied. -> StringMPD a -- ^ The MPD action to run. -> Response a testMPDWithPassword pairs passwd m = runIdentity $ runReaderT (evalStateT (runErrorT $ runSMPD m) pairs) passwd libmpd-0.9.1.0/tests/TestUtil.hs0000644000000000000000000000101313543437501014567 0ustar0000000000000000module TestUtil ( with , withPassword , module StringConn , module Test.Hspec ) where import Network.MPD.Core import Network.MPD.Applicative import Test.Hspec import StringConn with :: Eq a => Command a -> [(Expect, Response String)] -> Response a with = flip testMPD . runCommand withPassword :: Eq a => Password -> [(Expect, Response String)] -> Command a -> Response a withPassword pwd ps m = testMPDWithPassword ps pwd (runCommand m) libmpd-0.9.1.0/tests/UtilSpec.hs0000644000000000000000000000562513543437501014557 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} module UtilSpec (main, spec) where import Arbitrary import TestUtil import Test.Hspec.QuickCheck (prop) import Test.QuickCheck import Data.List (sort) import Data.Maybe (fromJust, isJust) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 import Network.MPD.Util main :: IO () main = hspec spec spec :: Spec spec = do describe "splitGroups" $ do it "breaks an association list into sublists" $ do splitGroups ["1", "5"] [("1","a"),("2","b"), ("5","c"),("6","d"), ("1","z"),("2","y"),("3","x")] `shouldBe` [[("1","a"),("2","b")], [("5","c"),("6","d")], [("1","z"),("2","y"),("3","x")]] prop "is reversible" prop_splitGroups_rev prop "preserves input" prop_splitGroups_integrity describe "parseDate" $ do prop "simple year strings" prop_parseDate_simple prop "complex year strings" prop_parseDate_complex describe "toAssoc" $ do prop "is reversible" prop_toAssoc_rev describe "parseBool" $ do prop "parses boolean values" prop_parseBool prop "is reversible" prop_parseBool_rev describe "showBool" $ do prop "unparses boolean values" prop_showBool describe "parseNum" $ do prop "parses positive and negative integers" prop_parseNum prop_parseDate_simple :: YearString -> Bool prop_parseDate_simple (YS x) = isJust $ parseDate x prop_parseDate_complex :: DateString -> Bool prop_parseDate_complex (DS x) = isJust $ parseDate x prop_toAssoc_rev :: AssocString -> Bool prop_toAssoc_rev x = k == k' && v == v' where AS str k v = x (k',v') = toAssoc str prop_parseBool_rev :: BoolString -> Bool prop_parseBool_rev (BS x) = showBool (fromJust $ parseBool x) == x prop_parseBool :: BoolString -> Bool prop_parseBool (BS xs) = case parseBool xs of Nothing -> False Just True -> xs == "1" Just False -> xs == "0" prop_showBool :: Bool -> Bool prop_showBool True = showBool True == "1" prop_showBool x = showBool x == "0" prop_splitGroups_rev :: [(ByteString, ByteString)] -> Property prop_splitGroups_rev xs = not (null xs) ==> let wrappers = [fst $ head xs] r = splitGroups wrappers xs in r == splitGroups wrappers (concat r) prop_splitGroups_integrity :: [(ByteString, ByteString)] -> Property prop_splitGroups_integrity xs = not (null xs) ==> sort (concat $ splitGroups [fst $ head xs] xs) == sort xs prop_parseNum :: Integer -> Bool prop_parseNum x = case xs of '-':_ -> ((<= 0) `fmap` parseNum bs) == Just True _ -> ((>= 0) `fmap` parseNum bs) == Just True where xs = show x bs = UTF8.fromString xs libmpd-0.9.1.0/tests/Unparse.hs0000644000000000000000000000610513543437501014436 0ustar0000000000000000-- | Unparsing for MPD objects module Unparse (Unparse(..)) where import qualified Data.Map as M import Network.MPD.Commands.Types import Network.MPD.Util class Unparse parsed where unparse :: parsed -> String instance Unparse a => Unparse (Maybe a) where unparse Nothing = "" unparse (Just x) = unparse x instance Unparse Count where unparse x = unlines [ "songs: " ++ show (cSongs x) , "playtime: " ++ show (cPlaytime x) ] instance Unparse Device where unparse x = unlines [ "outputid: " ++ show (dOutputID x) , "outputname: " ++ dOutputName x , "outputenabled: " ++ showBool (dOutputEnabled x) ] instance Unparse Song where unparse s = let fs = concatMap toF . M.toList $ sgTags s id_ = maybe [] (\(Id n) -> ["Id: " ++ show n]) (sgId s) idx = maybe [] (\n -> ["Pos: " ++ show n]) (sgIndex s) lastModified = maybe [] (return . ("Last-Modified: " ++) . formatIso8601) (sgLastModified s) in unlines $ ["file: " ++ (toString . sgFilePath) s] ++ ["Time: " ++ (show . sgLength) s] ++ fs ++ lastModified ++ id_ ++ idx where toF (k, vs) = map (toF' k) vs toF' k v = show k ++ ": " ++ toString v instance Unparse Stats where unparse s = unlines [ "artists: " ++ show (stsArtists s) , "albums: " ++ show (stsAlbums s) , "songs: " ++ show (stsSongs s) , "uptime: " ++ show (stsUptime s) , "playtime: " ++ show (stsPlaytime s) , "db_playtime: " ++ show (stsDbPlaytime s) , "db_update: " ++ show (stsDbUpdate s) ] instance Unparse Volume where unparse (Volume x) = show x instance Unparse Status where unparse s = unlines $ [ "state: " ++ (case stState s of Playing -> "play" Paused -> "pause" _ -> "stop") , "volume: " ++ maybe "-1" unparse (stVolume s) , "volume: " ++ unparse (stVolume s) , "repeat: " ++ showBool (stRepeat s) , "random: " ++ showBool (stRandom s) , "playlist: " ++ show (stPlaylistVersion s) , "playlistlength: " ++ show (stPlaylistLength s) , "xfade: " ++ show (stXFadeWidth s) , "xfade: " ++ show (stXFadeWidth s) , "audio: " ++ (let (x, y, z) = stAudio s in show x ++ ":" ++ show y ++ ":" ++ show z) , "single: " ++ showBool (stSingle s) , "consume: " ++ showBool (stConsume s) ] ++ maybe [] (\n -> ["updating_db: " ++ show n]) (stUpdatingDb s) ++ maybe [] (\n -> ["song: " ++ show n]) (stSongPos s) ++ maybe [] (\n -> ["songid: " ++ show n]) (stSongID s) ++ maybe [] (\n -> ["error: " ++ show n]) (stError s) ++ maybe [] (\(x, y) -> ["time: " ++ show x ++ ":" ++ show y]) (stTime s) ++ maybe [] (\n -> ["bitrate: " ++ show n]) (stBitrate s) libmpd-0.9.1.0/tests/CommandSpec.hs0000644000000000000000000003164013543437501015214 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -- This module provides a way of verifying that the interface to the MPD -- commands is correct. It does so by capturing the data flow between the -- command and a dummy socket, checking the captured data against a set of -- predefined values that are known to be correct. Of course, this does not -- verify that the external behaviour is correct, it's simply a way of -- catching silly mistakes and subtle bugs in the interface itself, without -- having to actually send any requests to a real server. module CommandSpec (main, spec) where import Arbitrary () import StringConn import TestUtil import Unparse import Network.MPD.Core import Network.MPD.Commands import Network.MPD.Commands.Types import Network.MPD.Commands.Extensions import Prelude hiding (repeat) main :: IO () main = hspec spec spec :: Spec spec = do -- * Admin commands describe "enableOutput" $ do it "sends an enableoutput command" $ testEnableOutput describe "disableOutput" $ do it "sends an disableoutput command" $ testDisableOutput describe "outputs" $ do it "lists available outputs" $ testOutputs describe "update" $ do it "updates entire collection by default" $ do cmd [("update", Right "updating_db: 23\nOK")] (Right 23) (update Nothing) it "can update a specific path" $ do cmd [("update \"foo\"", Right "updating_db: 23\nOK")] (Right 23) (update $ Just "foo") describe "rescan" $ do it "returns entire collection by default" $ do cmd [("rescan", Right "updating_db: 23\nOK")] (Right 23) (rescan Nothing) it "can rescan a specific path" $ do cmd [("rescan \"foo\"", Right "updating_db: 23\nOK")] (Right 23) (rescan $ Just "foo") -- * Database commands {- XXX: incorrect; fixed in the applicative version describe "list" $ do it "returns a list of values for a given metadata type" $ testListAny it "can constrain listing to entries matching a query" $ testListQuery -} describe "listAll" $ do it "lists everything" $ testListAll describe "lsInfo" $ do it "lists information" $ testLsInfo describe "listAllInfo" $ do it "lists information" $ testListAllInfo describe "count" $ do it "returns a count of items matching a query" $ testCount -- * Playlist commands describe "playlistAdd" $ do it "adds a url to a stored playlist" $ testPlaylistAdd describe "playlistClear" $ do it "clears a stored playlist" $ testPlaylistClear describe "plChangesPosid" $ do it "does something ..." $ testPlChangesPosId {- XXX: doesn't work it "fails on weird input" $ testPlChangesPosIdWeird -} -- XXX: this is ill-defined {- describe "currentSong" $ do it "can handle cases where playback is stopped" $ testCurrentSong -} describe "playlistDelete" $ do it "deletes an item from a stored playlist" $ testPlaylistDelete describe "load" $ do it "loads a stored playlist" $ testLoad describe "playlistMove" $ do it "moves an item within a stored playlist" $ testMove2 describe "rm" $ do it "deletes a stored playlist" $ testRm describe "rename" $ do it "renames a stored playlist" $ testRename describe "save" $ do it "creates a stored playlist" $ testSave describe "shuffle" $ do it "enables shuffle mode" $ testShuffle describe "listPlaylist" $ do it "returns a listing of paths in a stored playlist" $ testListPlaylist -- * Playback commands describe "crossfade" $ do it "sets crossfade between songs" $ testCrossfade describe "play" $ do it "toggles playback" $ testPlay describe "pause" $ do it "pauses playback" $ testPause describe "stop" $ do it "stops playback" $ testStop describe "next" $ do it "starts playback of next song" $ testNext describe "previous" $ do it "play previous song" $ testPrevious describe "random" $ do it "toggles random playback" $ testRandom describe "repeat" $ do it "toggles repeating playback" $ testRepeat describe "setVolume" $ do it "sets playback volume" $ testSetVolume describe "consume" $ do it "toggles consume mode" $ testConsume describe "single" $ do it "toggles single mode" $ testSingle -- * Misc describe "clearError" $ do it "removes errors" $ testClearError describe "commands" $ do it "lists available commands" $ testCommands describe "notCommands" $ do it "lists unavailable commands" $ testNotCommands describe "tagTypes" $ do it "lists available tag types" $ testTagTypes describe "urlHandlers" $ do it "lists available url handlers" $ testUrlHandlers describe "password" $ do it "sends a password to the server" $ testPassword it "gives access to restricted commmands" $ testPasswordSucceeds it "returns failure on incorrect password" $ testPasswordFails describe "ping" $ do it "sends a ping command" $ testPing describe "stats" $ do it "gets database stats" $ testStats -- * Extensions describe "toggle" $ do it "starts playback if paused" $ testTogglePlay it "stops playback if playing" $ testToggleStop describe "addMany" $ do it "adds multiple paths in one go" $ testAddMany0 it "can also add to stored playlists" $ testAddMany1 describe "volume" $ do it "adjusts volume relative to current volume" $ testVolume cmd_ :: [(Expect, Response String)] -> StringMPD () -> Expectation cmd_ expect f = cmd expect (Right ()) f cmd :: (Eq a, Show a) => [(Expect, Response String)] -> Response a -> StringMPD a -> Expectation cmd expect resp f = testMPD expect f `shouldBe` resp -- -- Admin commands -- testEnableOutput = cmd_ [("enableoutput 1", Right "OK")] (enableOutput 1) testDisableOutput = cmd_ [("disableoutput 1", Right "OK")] (disableOutput 1) -- XXX: this should be generalized to arbitrary inputs testOutputs = do let obj1 = def { dOutputName = "SoundCard0", dOutputEnabled = True } obj2 = def { dOutputName = "SoundCard1", dOutputID = 1 } resp = concatMap unparse [obj1, obj2] ++ "OK" cmd [("outputs", Right resp)] (Right [obj1, obj2]) outputs -- -- Database commands -- {- XXX: this is incorrect -- XXX: generalize to arbitrary Metadata values testListAny = cmd [("list Title", Right "Title: Foo\nTitle: Bar\nOK")] (Right ["Foo", "Bar"]) (list Title anything) testListQuery = cmd [("list Title Artist \"Muzz\"", Right "Title: Foo\nOK")] (Right ["Foo"]) (list Title (Artist =? "Muzz")) -} testListAll = cmd [("listall \"\"", Right "directory: FooBand\n\ \directory: FooBand/album1\n\ \file: FooBand/album1/01 - songA.ogg\n\ \file: FooBand/album1/02 - songB.ogg\nOK")] (Right ["FooBand/album1/01 - songA.ogg" ,"FooBand/album1/02 - songB.ogg"]) (listAll "") -- XXX: generalize to arbitrary input testLsInfo = do let song = defaultSong "Bar.ogg" cmd [("lsinfo \"\"", Right $ "directory: Foo\n" ++ unparse song ++ "playlist: Quux\nOK")] (Right [LsDirectory "Foo", LsSong song, LsPlaylist "Quux"]) (lsInfo "") testListAllInfo = cmd [("listallinfo \"\"", Right "directory: Foo\ndirectory: Bar\nOK")] (Right [LsDirectory "Foo", LsDirectory "Bar"]) (listAllInfo "") -- XXX: generalize to arbitrary input testCount = do let obj = Count 1 60 resp = unparse obj ++ "OK" cmd [("count Title \"Foo\"", Right resp)] (Right obj) (count (Title =? "Foo")) -- -- Playlist commands -- testPlaylistAdd = cmd_ [("playlistadd \"foo\" \"bar\"", Right "OK")] (playlistAdd "foo" "bar") testPlaylistClear = cmd_ [("playlistclear \"foo\"", Right "OK")] (playlistClear "foo") testPlChangesPosId = cmd [("plchangesposid 10", Right "OK")] (Right []) (plChangesPosId 10) {- XXX: testPlChangesPosIdWeird = cmd [("plchangesposid 10", Right "cpos: foo\nId: bar\nOK")] (Left $ Unexpected "[(\"cpos\",\"foo\"),(\"Id\",\"bar\")]") (plChangesPosId 10) -} -- XXX: this is ill-defined {- testCurrentSong = do let obj = def { stState = Stopped, stPlaylistVersion = 253 } resp = unparse obj ++ "OK" cmd [("status", Right resp)] (Right Nothing) currentSong -} testPlaylistDelete = cmd_ [("playlistdelete \"foo\" 1", Right "OK")] (playlistDelete "foo" 1) testLoad = cmd_ [("load \"foo\"", Right "OK")] (load "foo") testMove2 = cmd_ [("playlistmove \"foo\" 23 2", Right "OK")] (playlistMove "foo" (Id 23) 2) testRm = cmd_ [("rm \"foo\"", Right "OK")] (rm "foo") testRename = cmd_ [("rename \"foo\" \"bar\"", Right "OK")] (rename "foo" "bar") testSave = cmd_ [("save \"foo\"", Right "OK")] (save "foo") testShuffle = cmd_ [("shuffle", Right "OK")] (shuffle Nothing) testListPlaylist = cmd [("listplaylist \"foo\"" ,Right "file: dir/Foo-bar.ogg\n\ \file: dir/Quux-quuz.ogg\n\ \OK")] (Right ["dir/Foo-bar.ogg", "dir/Quux-quuz.ogg"]) (listPlaylist "foo") -- -- Playback commands -- testCrossfade = cmd_ [("crossfade 0", Right "OK")] (crossfade 0) testPlay = cmd_ [("play", Right "OK")] (play Nothing) testPause = cmd_ [("pause 0", Right "OK")] (pause False) testStop = cmd_ [("stop", Right "OK")] stop testNext = cmd_ [("next", Right "OK")] next testPrevious = cmd_ [("previous", Right "OK")] previous testRandom = cmd_ [("random 0", Right "OK")] (random False) testRepeat = cmd_ [("repeat 0", Right "OK")] (repeat False) testSetVolume = cmd_ [("setvol 10", Right "OK")] (setVolume 10) testConsume = cmd_ [("consume 1", Right "OK")] (consume True) testSingle = cmd_ [("single 1", Right "OK")] (single True) -- -- Miscellaneous commands -- testClearError = cmd_ [("clearerror", Right "OK")] clearError testCommands = cmd [("commands", Right "command: foo\ncommand: bar")] (Right ["foo", "bar"]) commands testNotCommands = cmd [("notcommands", Right "command: foo\ncommand: bar")] (Right ["foo", "bar"]) notCommands testTagTypes = cmd [("tagtypes", Right "tagtype: foo\ntagtype: bar")] (Right ["foo", "bar"]) tagTypes testUrlHandlers = cmd [("urlhandlers", Right "urlhandler: foo\nurlhandler: bar")] (Right ["foo", "bar"]) urlHandlers testPassword = cmd_ [("password foo", Right "OK")] (password "foo") testPasswordSucceeds = testMPDWithPassword convo "foo" cmd_in `shouldBe` expected_resp where convo = [("lsinfo \"/\"", Right "ACK [4@0] {play} you don't have \ \permission for \"play\"") ,("password foo", Right "OK") ,("lsinfo \"/\"", Right "directory: /bar\nOK")] expected_resp = Right [LsDirectory "/bar"] cmd_in = lsInfo "/" testPasswordFails = testMPDWithPassword convo "foo" cmd_in `shouldBe` expected_resp where convo = [("play", Right "ACK [4@0] {play} you don't have \ \permission for \"play\"") ,("password foo", Right "ACK [3@0] {password} incorrect password")] expected_resp = Left $ ACK InvalidPassword " incorrect password" cmd_in = play Nothing testPing = cmd_ [("ping", Right "OK")] ping testStats = cmd [("stats", Right resp)] (Right obj) stats where obj = def { stsArtists = 1, stsAlbums = 1, stsSongs = 1 , stsUptime = 100, stsPlaytime = 100, stsDbUpdate = 10 , stsDbPlaytime = 100 } resp = unparse obj ++ "OK" -- -- Extensions\/shortcuts -- testTogglePlay = cmd_ [("status", Right resp) ,("pause 1", Right "OK")] toggle where resp = unparse def { stState = Playing } testToggleStop = cmd_ [("status", Right resp) ,("play", Right "OK")] toggle where resp = unparse def { stState = Stopped } {- this overlaps with testToggleStop, no? testTogglePause = cmd_ [("status", Right resp) ,("play", Right "OK")] toggle where resp = unparse def { stState = Paused } -} testAddMany0 = cmd_ [("add \"bar\"", Right "OK")] (addMany "" ["bar"]) testAddMany1 = cmd_ [("playlistadd \"foo\" \"bar\"", Right "OK")] (addMany "foo" ["bar"]) testVolume = cmd_ [("status", Right st), ("setvol 90", Right "OK")] (volume (-10)) where st = unparse def { stVolume = Just 100 } libmpd-0.9.1.0/tests/ParserSpec.hs0000644000000000000000000000423613543437501015073 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module ParserSpec (main, spec) where import Arbitrary () import Unparse import Test.Hspec import Test.Hspec.QuickCheck (prop) import Network.MPD.Commands.Parse import Network.MPD.Commands.Types import Network.MPD.Util hiding (read) import qualified Data.ByteString.UTF8 as UTF8 import Data.List import qualified Data.Map as M import Data.Time main :: IO () main = hspec spec spec :: Spec spec = do describe "parseIso8601" $ do prop "parses dates in ISO8601 format" prop_parseIso8601 describe "parseCount" $ do prop "parses counts" prop_parseCount describe "parseOutputs" $ do prop "parses outputs" prop_parseOutputs describe "parseSong" $ do prop "parses songs" prop_parseSong describe "parseStats" $ do prop "parses stats" prop_parseStats -- This property also ensures, that (instance Arbitrary UTCTime) is sound. -- Indeed, a bug in the instance declaration was the primary motivation to add -- this property. prop_parseIso8601 :: UTCTime -> Expectation prop_parseIso8601 t = Just t `shouldBe` (parseIso8601 . UTF8.fromString . formatIso8601) t prop_parseCount :: Count -> Expectation prop_parseCount c = Right c `shouldBe` (parseCount . map UTF8.fromString . lines . unparse) c prop_parseOutputs :: [Device] -> Expectation prop_parseOutputs ds = Right ds `shouldBe` (parseOutputs . map UTF8.fromString . lines . concatMap unparse) ds deriving instance Ord Value prop_parseSong :: Song -> Expectation prop_parseSong s = Right (sortTags s) `shouldBe` sortTags `fmap` (parseSong . toAssocList . map UTF8.fromString . lines . unparse) s where -- We consider lists of tag values equal if they contain the same elements. -- To ensure that two lists with the same elements are equal, we bring the -- elements in a deterministic order. sortTags song = song { sgTags = M.map sort $ sgTags song } prop_parseStats :: Stats -> Expectation prop_parseStats s = Right s `shouldBe` (parseStats . map UTF8.fromString . lines . unparse) s libmpd-0.9.1.0/tests/Arbitrary.hs0000644000000000000000000001035413543437501014761 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wwarn -fno-warn-orphans -fno-warn-missing-methods -XFlexibleInstances #-} -- | This module contains Arbitrary instances for various types. module Arbitrary ( AssocString(..) , BoolString(..) , YearString(..) , DateString(..) , MetadataMap(..) , positive, field ) where import Control.Applicative ((<$>), (<*>)) import Control.Monad (liftM2, liftM3, replicateM) import Data.Char (isSpace) import Data.List (intersperse) import qualified Data.Map as M import Data.Time import Test.QuickCheck import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen import Network.MPD.Commands.Types import Data.ByteString (ByteString) import qualified Data.ByteString.UTF8 as UTF8 instance Arbitrary ByteString where arbitrary = UTF8.fromString <$> listOf1 arbitraryPrintableChar -- No longer provided by QuickCheck 2 -- two :: Monad m => m a -> m (a, a) -- two m = liftM2 (,) m m three :: Monad m => m a -> m (a, a, a) three m = liftM3 (,,) m m m -- Generate a positive number. positive :: (Arbitrary a, Num a) => Gen a positive = abs <$> arbitrary possibly :: Gen a -> Gen (Maybe a) possibly m = arbitrary >>= bool (Just <$> m) (return Nothing) where bool thenE elseE b = if b then thenE else elseE -- MPD fields can't contain newlines and the parser skips initial spaces. field :: Gen String field = (filter (/= '\n') . dropWhile isSpace) <$> listOf1 arbitraryPrintableChar fieldBS :: Gen ByteString fieldBS = UTF8.fromString <$> field instance Arbitrary Value where arbitrary = Value <$> fieldBS newtype MetadataMap = MetadataMap { fromMetadataMap :: M.Map Metadata [Value] } deriving (Show) instance Arbitrary MetadataMap where arbitrary = do size <- choose (1, 1000) vals <- replicateM size (listOf1 arbitrary) keys <- replicateM size arbitrary return . MetadataMap $ M.fromList (zip keys vals) -- Orphan instances for built-in types instance Arbitrary Day where arbitrary = ModifiedJulianDay <$> arbitrary instance Arbitrary DiffTime where arbitrary = secondsToDiffTime <$> positive instance Arbitrary UTCTime where arbitrary = UTCTime <$> arbitrary <*> arbitrary -- an assoc. string is a string of the form "key: value", followed by -- the key and value separately. data AssocString = AS ByteString ByteString ByteString instance Show AssocString where show (AS str _ _) = UTF8.toString str instance Arbitrary AssocString where arbitrary = do key <- filter (/= ':') <$> arbitrary val <- dropWhile (== ' ') <$> arbitrary return $ AS (UTF8.fromString (key ++ ": " ++ val)) (UTF8.fromString key) (UTF8.fromString val) newtype BoolString = BS ByteString deriving Show instance Arbitrary BoolString where arbitrary = BS <$> elements ["1", "0"] -- Simple date representation, like "2004" and "1998". newtype YearString = YS ByteString deriving Show instance Arbitrary YearString where arbitrary = YS . UTF8.fromString . show <$> (positive :: Gen Integer) -- Complex date representations, like "2004-20-30". newtype DateString = DS ByteString deriving Show instance Arbitrary DateString where arbitrary = do (y,m,d) <- three (positive :: Gen Integer) return . DS . UTF8.fromString . concat . intersperse "-" $ map show [y,m,d] instance Arbitrary Count where arbitrary = liftM2 Count arbitrary arbitrary instance Arbitrary Device where arbitrary = liftM3 Device arbitrary field arbitrary instance Arbitrary Id where arbitrary = Id <$> arbitrary instance Arbitrary Song where arbitrary = Song <$> arbitrary <*> (fromMetadataMap <$> arbitrary) <*> possibly arbitrary <*> positive <*> possibly arbitrary <*> possibly positive instance Arbitrary Path where arbitrary = Path <$> fieldBS instance Arbitrary Stats where arbitrary = Stats <$> positive <*> positive <*> positive <*> positive <*> positive <*> positive <*> positive instance Arbitrary Metadata where arbitrary = elements [minBound .. maxBound] libmpd-0.9.1.0/tests/EnvSpec.hs0000644000000000000000000000522213543437501014363 0ustar0000000000000000module EnvSpec (main, spec) where import TestUtil import Network.MPD import System.Posix.Env hiding (getEnvDefault) main :: IO () main = hspec spec spec :: Spec spec = do describe "getEnvDefault" $ do it "returns the value of an environment variable" $ do setEnv "FOO" "foo" True r <- getEnvDefault "FOO" "bar" r `shouldBe` "foo" it "returns a given default value if that environment variable is not set" $ do unsetEnv "FOO" r <- getEnvDefault "FOO" "bar" r `shouldBe` "bar" describe "getConnectionSettings" $ do it "takes an optional argument, that overrides MPD_HOST" $ do setEnv "MPD_HOST" "user@example.com" True Right (host, _, pw) <- getConnectionSettings (Just "foo@bar") Nothing pw `shouldBe` "foo" host `shouldBe` "bar" it "takes an optional argument, that overrides MPD_PORT" $ do setEnv "MPD_PORT" "8080" True Right (_, port, _) <- getConnectionSettings Nothing (Just "23") port `shouldBe` 23 it "returns an error message, if MPD_PORT is not an int" $ do setEnv "MPD_PORT" "foo" True r <- getConnectionSettings Nothing Nothing r `shouldBe` Left "\"foo\" is not a valid port!" unsetEnv "MPD_PORT" describe "host" $ do it "is taken from MPD_HOST" $ do setEnv "MPD_HOST" "example.com" True Right (host, _, _) <- getConnectionSettings Nothing Nothing host `shouldBe` "example.com" it "is 'localhost' if MPD_HOST is not set" $ do unsetEnv "MPD_HOST" Right (host, _, _) <- getConnectionSettings Nothing Nothing host `shouldBe` "localhost" describe "port" $ do it "is taken from MPD_PORT" $ do setEnv "MPD_PORT" "8080" True Right (_, port, _) <- getConnectionSettings Nothing Nothing port `shouldBe` 8080 it "is 6600 if MPD_PORT is not set" $ do unsetEnv "MPD_PORT" Right (_, port, _) <- getConnectionSettings Nothing Nothing port `shouldBe` 6600 describe "password" $ do it "is taken from MPD_HOST if MPD_HOST is of the form password@host" $ do setEnv "MPD_HOST" "password@host" True Right (host, _, pw) <- getConnectionSettings Nothing Nothing host `shouldBe` "host" pw `shouldBe` "password" it "is '' if MPD_HOST is not of the form password@host" $ do setEnv "MPD_HOST" "example.com" True Right (_, _, pw) <- getConnectionSettings Nothing Nothing pw `shouldBe` "" it "is '' if MPD_HOST is not set" $ do unsetEnv "MPD_HOST" Right (_, _, pw) <- getConnectionSettings Nothing Nothing pw `shouldBe` ""