libmpd-0.9.0.7/0000755000000000000000000000000013141446536011331 5ustar0000000000000000libmpd-0.9.0.7/LICENSE0000644000000000000000000000253113141446536012337 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.0.7/Setup.lhs0000644000000000000000000000011413141446536013135 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain libmpd-0.9.0.7/libmpd.cabal0000644000000000000000000000745513141446536013577 0ustar0000000000000000Name: libmpd Version: 0.9.0.7 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 ==7.6.3, GHC ==7.8.4, GHC ==7.10.1, GHC ==8.0.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 && < 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.1 && < 3 , utf8-string >= 0.3.1 && < 1.1 if impl(ghc >= 7.10.0) Build-Depends: time >= 1.5 && <1.9 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.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.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 , utf8-string -- Test dependencies , unix , QuickCheck >= 2.1 , hspec >= 1.3 libmpd-0.9.0.7/README.md0000644000000000000000000000405313141446536012612 0ustar0000000000000000# libmpd-haskell: a client library for MPD ## 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]: http://hackage.haskell.org/package/libmpd "libmpd-haskell on Hackage" ## Installation With [cabal-install], do `cd libmpd-haskell && cabal install` [cabal-install]: http://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. ## Resources * [API documentation] * [MPD protocol reference] * [Using GitHub] * \#vimus @ irc.freenode.net [bug tracker]: http://github.com/vimus/libmpd-haskell/issues [GitHub]: http://www.github.com [GitHub repository]: http://www.github.com/vimus/libmpd-haskell [API documentation]: http://hackage.haskell.org/packages/archive/libmpd/latest/doc/html/Network-MPD.html [MPD protocol reference]: http://www.musicpd.org/doc/protocol/ [Using GitHub]: http://help.github.com ## License libmpd-haskell is distributed under the [MIT license]. [MIT license]: http://www.opensource.org/licenses/MIT ## Contributors See `CONTRIBUTORS` in the source distribution. Feel free to add yourself to this list if you deem it appropriate to do so. libmpd-0.9.0.7/changelog.md0000644000000000000000000001014013141446536013576 0ustar0000000000000000* 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.0.7/src/0000755000000000000000000000000013141446536012120 5ustar0000000000000000libmpd-0.9.0.7/src/Network/0000755000000000000000000000000013141446536013551 5ustar0000000000000000libmpd-0.9.0.7/src/Network/MPD.hs0000644000000000000000000000606713141446536014536 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.0.7/src/Network/MPD/0000755000000000000000000000000013141446536014171 5ustar0000000000000000libmpd-0.9.0.7/src/Network/MPD/Applicative.hs0000644000000000000000000000230413141446536016765 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 ) where import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Connection import Network.MPD.Applicative.CurrentPlaylist import Network.MPD.Applicative.Database 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.0.7/src/Network/MPD/Core.hs0000644000000000000000000002106013141446536015414 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings #-} {-# 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.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 Network (PortID(..), withSocketsDo, connectTo) 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 mHandle <- liftIO (safeConnectTo host port) modify (\st -> st { stHandle = mHandle }) F.forM_ mHandle $ \_ -> runMPD checkConn >>= (`unless` runMPD close) where safeConnectTo host@('/':_) _ = (Just <$> connectTo "" (UnixSocket host)) `E.catch` (\(_ :: E.SomeException) -> return Nothing) safeConnectTo host port = (Just <$> connectTo host (PortNumber $ fromInteger port)) `E.catch` (\(_ :: E.SomeException) -> return Nothing) checkConn = do [msg] <- send "" 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) `E.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.0.7/src/Network/MPD/Commands.hs0000644000000000000000000000351113141446536016266 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 , Decibels , State(..) , Subsystem(..) , ReplayGainMode(..) , Count(..) , LsResult(..) , Device(..) , Song(..) , Position , 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 ) 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 libmpd-0.9.0.7/src/Network/MPD/Util.hs0000644000000000000000000001012613141446536015442 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.0.7/src/Network/MPD/Applicative/0000755000000000000000000000000013141446536016432 5ustar0000000000000000libmpd-0.9.0.7/src/Network/MPD/Applicative/ClientToClient.hs0000644000000000000000000000402113141446536021643 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.0.7/src/Network/MPD/Applicative/Connection.hs0000644000000000000000000000121513141446536021064 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.0.7/src/Network/MPD/Applicative/CurrentPlaylist.hs0000644000000000000000000001133013141446536022130 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 , shuffle , swap , swapId ) 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 "" -- | 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] libmpd-0.9.0.7/src/Network/MPD/Applicative/Database.hs0000644000000000000000000000720313141446536020474 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" -- | 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.0.7/src/Network/MPD/Applicative/Output.hs0000644000000000000000000000164713141446536020276 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 , 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] -- | Get information about all available output devices. outputs :: Command [Device] outputs = Command (liftParser parseOutputs) ["outputs"] libmpd-0.9.0.7/src/Network/MPD/Applicative/PlaybackControl.hs0000644000000000000000000000305013141446536022053 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 -> Seconds -> Command () seek pos time = Command emptyResponse ["seek" <@> pos <++> time] -- | Seek to time in the song with the given id. seekId :: Id -> Seconds -> Command () seekId id' time = Command emptyResponse ["seekid" <@> id' <++> time] -- | Stop playback. stop :: Command () stop = Command emptyResponse ["stop"] libmpd-0.9.0.7/src/Network/MPD/Applicative/PlaybackOptions.hs0000644000000000000000000000457213141446536022100 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 in percent. setVolume :: Int -> 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.0.7/src/Network/MPD/Applicative/Reflection.hs0000644000000000000000000000423213141446536021061 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.0.7/src/Network/MPD/Applicative/Status.hs0000644000000000000000000001373313141446536020260 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 ((, round 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) } _ -> unexpectedPair 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 *** parseNum $ 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 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 (n::Int) libmpd-0.9.0.7/src/Network/MPD/Applicative/Stickers.hs0000644000000000000000000000425213141446536020560 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.0.7/src/Network/MPD/Applicative/StoredPlaylists.hs0000644000000000000000000000550613141446536022141 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.0.7/src/Network/MPD/Applicative/Util.hs0000644000000000000000000000241713141446536017707 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.0.7/src/Network/MPD/Applicative/Internal.hs0000644000000000000000000000570613141446536020552 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {- | 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 -- | 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 fail = Parser . const . Left return a = Parser $ \input -> Right (a, input) p1 >>= p2 = Parser $ \input -> runParser p1 input >>= uncurry (runParser . p2) 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.0.7/src/Network/MPD/Commands/0000755000000000000000000000000013141446536015732 5ustar0000000000000000libmpd-0.9.0.7/src/Network/MPD/Commands/Extensions.hs0000644000000000000000000000741613141446536020435 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.0.7/src/Network/MPD/Commands/Arg.hs0000644000000000000000000000474413141446536017010 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.0.7/src/Network/MPD/Commands/Parse.hs0000644000000000000000000001307513141446536017346 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.0.7/src/Network/MPD/Commands/Query.hs0000644000000000000000000000304613141446536017376 0ustar0000000000000000{- | 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 -- | 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) 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.0.7/src/Network/MPD/Commands/Types.hs0000644000000000000000000002531313141446536017376 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 , Decibels , State(..) , Subsystem(..) , ReplayGainMode(..) , Count(..) , LsResult(..) , Device(..) , Song(..) , Position , Id(..) , sgGetTag , sgAddTag , 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.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 Seconds = Integer type Decibels = Integer -- | Represents the different playback states. data State = Playing | Stopped | Paused deriving (Show, Eq) -- | 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, 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, 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 -- | 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 = M.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 -- | Container for MPD status. data Status = Status { stState :: State -- | A percentage (0-100). -- -- 'Nothing' indicates that the output lacks mixer support. , stVolume :: Maybe Int , 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 (Double, Seconds) -- | 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 } 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 } instance Default Status where def = defaultStatus libmpd-0.9.0.7/src/Network/MPD/Commands/ClientToClient.hs0000644000000000000000000000245313141446536021152 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.0.7/src/Network/MPD/Commands/Status.hs0000644000000000000000000000310313141446536017546 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.0.7/src/Network/MPD/Commands/PlaybackOptions.hs0000644000000000000000000000310213141446536021364 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 (0-100 percent). setVolume :: MonadMPD m => Int -> 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.0.7/src/Network/MPD/Commands/PlaybackControl.hs0000644000000000000000000000264713141446536021366 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 -> Seconds -> m () seek pos = A.runCommand . A.seek pos -- | Seek to some point in a song (id version) seekId :: MonadMPD m => Id -> Seconds -> m () seekId id' = A.runCommand . A.seekId id' -- | Stop playing. stop :: MonadMPD m => m () stop = A.runCommand A.stop libmpd-0.9.0.7/src/Network/MPD/Commands/CurrentPlaylist.hs0000644000000000000000000001022313141446536021430 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 , shuffle , swap , swapId ) 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 -- | 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 libmpd-0.9.0.7/src/Network/MPD/Commands/StoredPlaylists.hs0000644000000000000000000000470513141446536021441 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.0.7/src/Network/MPD/Commands/Database.hs0000644000000000000000000000425313141446536017776 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 , 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 -- | 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.0.7/src/Network/MPD/Commands/Stickers.hs0000644000000000000000000000371513141446536020063 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.0.7/src/Network/MPD/Commands/Connection.hs0000644000000000000000000000155413141446536020372 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.0.7/src/Network/MPD/Commands/Output.hs0000644000000000000000000000165013141446536017570 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 , 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 -- | Retrieve information for all output devices. outputs :: MonadMPD m => m [Device] outputs = A.runCommand A.outputs libmpd-0.9.0.7/src/Network/MPD/Commands/Reflection.hs0000644000000000000000000000256213141446536020365 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.0.7/src/Network/MPD/Core/0000755000000000000000000000000013141446536015061 5ustar0000000000000000libmpd-0.9.0.7/src/Network/MPD/Core/Class.hs0000644000000000000000000000216413141446536016465 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.0.7/src/Network/MPD/Core/Error.hs0000644000000000000000000000525313141446536016513 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.0.7/tests/0000755000000000000000000000000013141446536012473 5ustar0000000000000000libmpd-0.9.0.7/tests/Arbitrary.hs0000644000000000000000000001016113141446536014765 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 Network.MPD.Commands.Types import Data.ByteString (ByteString) import qualified Data.ByteString.UTF8 as UTF8 instance Arbitrary ByteString where arbitrary = UTF8.fromString <$> arbitrary -- 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) <$> arbitrary 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.0.7/tests/CommandSpec.hs0000644000000000000000000003164013141446536015224 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.0.7/tests/EnvSpec.hs0000644000000000000000000000522213141446536014373 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` "" libmpd-0.9.0.7/tests/Main.hs0000644000000000000000000000005413141446536013712 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} libmpd-0.9.0.7/tests/ParserSpec.hs0000644000000000000000000000412313141446536015076 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 -> Bool prop_parseIso8601 t = Just t == (parseIso8601 . UTF8.fromString . formatIso8601) t prop_parseCount :: Count -> Bool prop_parseCount c = Right c == (parseCount . map UTF8.fromString . lines . unparse) c prop_parseOutputs :: [Device] -> Bool prop_parseOutputs ds = Right ds == (parseOutputs . map UTF8.fromString . lines . concatMap unparse) ds deriving instance Ord Value prop_parseSong :: Song -> Bool prop_parseSong s = Right (sortTags s) == 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 -> Bool prop_parseStats s = Right s == (parseStats . map UTF8.fromString . lines . unparse) s libmpd-0.9.0.7/tests/TestUtil.hs0000644000000000000000000000101313141446536014577 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.0.7/tests/UtilSpec.hs0000644000000000000000000000562513141446536014567 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.0.7/tests/StringConn.hs0000644000000000000000000000533113141446536015115 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} {-# OPTIONS_GHC -Wwarn #-} -- | Module : StringConn -- Copyright : (c) Ben Sinclair 2005-2009 -- License : MIT (see LICENSE) -- Maintainer : bsinclai@turing.une.edu.au -- 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.0.7/tests/Unparse.hs0000644000000000000000000000572613141446536014456 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 Status where unparse s = unlines $ [ "state: " ++ (case stState s of Playing -> "play" Paused -> "pause" _ -> "stop") , "volume: " ++ maybe "-1" show (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)