packages feed

libmpd 0.8.0.5 → 0.9.0

raw patch · 61 files changed

+3337/−2750 lines, 61 filesdep −HUnitdep ~attoparsecdep ~basedep ~containers

Dependencies removed: HUnit

Dependency ranges changed: attoparsec, base, containers, data-default, filepath, hspec, network, old-locale, text, utf8-string

Files

LICENSE view
@@ -1,510 +1,20 @@--                  GNU LESSER GENERAL PUBLIC LICENSE-                       Version 2.1, February 1999-- Copyright (C) 1991, 1999 Free Software Foundation, Inc.-	51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.--[This is the first released version of the Lesser GPL.  It also counts- as the successor of the GNU Library Public License, version 2, hence- the version number 2.1.]--                            Preamble--  The licenses for most software are designed to take away your-freedom to share and change it.  By contrast, the GNU General Public-Licenses are intended to guarantee your freedom to share and change-free software--to make sure the software is free for all its users.--  This license, the Lesser General Public License, applies to some-specially designated software packages--typically libraries--of the-Free Software Foundation and other authors who decide to use it.  You-can use it too, but we suggest you first think carefully about whether-this license or the ordinary General Public License is the better-strategy to use in any particular case, based on the explanations-below.--  When we speak of free software, we are referring to freedom of use,-not price.  Our General Public Licenses are designed to make sure that-you have the freedom to distribute copies of free software (and charge-for this service if you wish); that you receive source code or can get-it if you want it; that you can change the software and use pieces of-it in new free programs; and that you are informed that you can do-these things.--  To protect your rights, we need to make restrictions that forbid-distributors to deny you these rights or to ask you to surrender these-rights.  These restrictions translate to certain responsibilities for-you if you distribute copies of the library or if you modify it.--  For example, if you distribute copies of the library, whether gratis-or for a fee, you must give the recipients all the rights that we gave-you.  You must make sure that they, too, receive or can get the source-code.  If you link other code with the library, you must provide-complete object files to the recipients, so that they can relink them-with the library after making changes to the library and recompiling-it.  And you must show them these terms so they know their rights.--  We protect your rights with a two-step method: (1) we copyright the-library, and (2) we offer you this license, which gives you legal-permission to copy, distribute and/or modify the library.--  To protect each distributor, we want to make it very clear that-there is no warranty for the free library.  Also, if the library is-modified by someone else and passed on, the recipients should know-that what they have is not the original version, so that the original-author's reputation will not be affected by problems that might be-introduced by others.--  Finally, software patents pose a constant threat to the existence of-any free program.  We wish to make sure that a company cannot-effectively restrict the users of a free program by obtaining a-restrictive license from a patent holder.  Therefore, we insist that-any patent license obtained for a version of the library must be-consistent with the full freedom of use specified in this license.--  Most GNU software, including some libraries, is covered by the-ordinary GNU General Public License.  This license, the GNU Lesser-General Public License, applies to certain designated libraries, and-is quite different from the ordinary General Public License.  We use-this license for certain libraries in order to permit linking those-libraries into non-free programs.--  When a program is linked with a library, whether statically or using-a shared library, the combination of the two is legally speaking a-combined work, a derivative of the original library.  The ordinary-General Public License therefore permits such linking only if the-entire combination fits its criteria of freedom.  The Lesser General-Public License permits more lax criteria for linking other code with-the library.--  We call this license the "Lesser" General Public License because it-does Less to protect the user's freedom than the ordinary General-Public License.  It also provides other free software developers Less-of an advantage over competing non-free programs.  These disadvantages-are the reason we use the ordinary General Public License for many-libraries.  However, the Lesser license provides advantages in certain-special circumstances.--  For example, on rare occasions, there may be a special need to-encourage the widest possible use of a certain library, so that it-becomes a de-facto standard.  To achieve this, non-free programs must-be allowed to use the library.  A more frequent case is that a free-library does the same job as widely used non-free libraries.  In this-case, there is little to gain by limiting the free library to free-software only, so we use the Lesser General Public License.--  In other cases, permission to use a particular library in non-free-programs enables a greater number of people to use a large body of-free software.  For example, permission to use the GNU C Library in-non-free programs enables many more people to use the whole GNU-operating system, as well as its variant, the GNU/Linux operating-system.--  Although the Lesser General Public License is Less protective of the-users' freedom, it does ensure that the user of a program that is-linked with the Library has the freedom and the wherewithal to run-that program using a modified version of the Library.--  The precise terms and conditions for copying, distribution and-modification follow.  Pay close attention to the difference between a-"work based on the library" and a "work that uses the library".  The-former contains code derived from the library, whereas the latter must-be combined with the library in order to run.--                  GNU LESSER GENERAL PUBLIC LICENSE-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION--  0. This License Agreement applies to any software library or other-program which contains a notice placed by the copyright holder or-other authorized party saying it may be distributed under the terms of-this Lesser General Public License (also called "this License").-Each licensee is addressed as "you".--  A "library" means a collection of software functions and/or data-prepared so as to be conveniently linked with application programs-(which use some of those functions and data) to form executables.--  The "Library", below, refers to any such software library or work-which has been distributed under these terms.  A "work based on the-Library" means either the Library or any derivative work under-copyright law: that is to say, a work containing the Library or a-portion of it, either verbatim or with modifications and/or translated-straightforwardly into another language.  (Hereinafter, translation is-included without limitation in the term "modification".)--  "Source code" for a work means the preferred form of the work for-making modifications to it.  For a library, complete source code means-all the source code for all modules it contains, plus any associated-interface definition files, plus the scripts used to control-compilation and installation of the library.--  Activities other than copying, distribution and modification are not-covered by this License; they are outside its scope.  The act of-running a program using the Library is not restricted, and output from-such a program is covered only if its contents constitute a work based-on the Library (independent of the use of the Library in a tool for-writing it).  Whether that is true depends on what the Library does-and what the program that uses the Library does.--  1. You may copy and distribute verbatim copies of the Library's-complete source code as you receive it, in any medium, provided that-you conspicuously and appropriately publish on each copy an-appropriate copyright notice and disclaimer of warranty; keep intact-all the notices that refer to this License and to the absence of any-warranty; and distribute a copy of this License along with the-Library.--  You may charge a fee for the physical act of transferring a copy,-and you may at your option offer warranty protection in exchange for a-fee.--  2. You may modify your copy or copies of the Library or any portion-of it, thus forming a work based on the Library, and copy and-distribute such modifications or work under the terms of Section 1-above, provided that you also meet all of these conditions:--    a) The modified work must itself be a software library.--    b) You must cause the files modified to carry prominent notices-    stating that you changed the files and the date of any change.--    c) You must cause the whole of the work to be licensed at no-    charge to all third parties under the terms of this License.--    d) If a facility in the modified Library refers to a function or a-    table of data to be supplied by an application program that uses-    the facility, other than as an argument passed when the facility-    is invoked, then you must make a good faith effort to ensure that,-    in the event an application does not supply such function or-    table, the facility still operates, and performs whatever part of-    its purpose remains meaningful.--    (For example, a function in a library to compute square roots has-    a purpose that is entirely well-defined independent of the-    application.  Therefore, Subsection 2d requires that any-    application-supplied function or table used by this function must-    be optional: if the application does not supply it, the square-    root function must still compute square roots.)--These requirements apply to the modified work as a whole.  If-identifiable sections of that work are not derived from the Library,-and can be reasonably considered independent and separate works in-themselves, then this License, and its terms, do not apply to those-sections when you distribute them as separate works.  But when you-distribute the same sections as part of a whole which is a work based-on the Library, the distribution of the whole must be on the terms of-this License, whose permissions for other licensees extend to the-entire whole, and thus to each and every part regardless of who wrote-it.--Thus, it is not the intent of this section to claim rights or contest-your rights to work written entirely by you; rather, the intent is to-exercise the right to control the distribution of derivative or-collective works based on the Library.--In addition, mere aggregation of another work not based on the Library-with the Library (or with a work based on the Library) on a volume of-a storage or distribution medium does not bring the other work under-the scope of this License.--  3. You may opt to apply the terms of the ordinary GNU General Public-License instead of this License to a given copy of the Library.  To do-this, you must alter all the notices that refer to this License, so-that they refer to the ordinary GNU General Public License, version 2,-instead of to this License.  (If a newer version than version 2 of the-ordinary GNU General Public License has appeared, then you can specify-that version instead if you wish.)  Do not make any other change in-these notices.--  Once this change is made in a given copy, it is irreversible for-that copy, so the ordinary GNU General Public License applies to all-subsequent copies and derivative works made from that copy.--  This option is useful when you wish to copy part of the code of-the Library into a program that is not a library.--  4. You may copy and distribute the Library (or a portion or-derivative of it, under Section 2) in object code or executable form-under the terms of Sections 1 and 2 above provided that you accompany-it with the complete corresponding machine-readable source code, which-must be distributed under the terms of Sections 1 and 2 above on a-medium customarily used for software interchange.--  If distribution of object code is made by offering access to copy-from a designated place, then offering equivalent access to copy the-source code from the same place satisfies the requirement to-distribute the source code, even though third parties are not-compelled to copy the source along with the object code.--  5. A program that contains no derivative of any portion of the-Library, but is designed to work with the Library by being compiled or-linked with it, is called a "work that uses the Library".  Such a-work, in isolation, is not a derivative work of the Library, and-therefore falls outside the scope of this License.--  However, linking a "work that uses the Library" with the Library-creates an executable that is a derivative of the Library (because it-contains portions of the Library), rather than a "work that uses the-library".  The executable is therefore covered by this License.-Section 6 states terms for distribution of such executables.--  When a "work that uses the Library" uses material from a header file-that is part of the Library, the object code for the work may be a-derivative work of the Library even though the source code is not.-Whether this is true is especially significant if the work can be-linked without the Library, or if the work is itself a library.  The-threshold for this to be true is not precisely defined by law.--  If such an object file uses only numerical parameters, data-structure layouts and accessors, and small macros and small inline-functions (ten lines or less in length), then the use of the object-file is unrestricted, regardless of whether it is legally a derivative-work.  (Executables containing this object code plus portions of the-Library will still fall under Section 6.)--  Otherwise, if the work is a derivative of the Library, you may-distribute the object code for the work under the terms of Section 6.-Any executables containing that work also fall under Section 6,-whether or not they are linked directly with the Library itself.--  6. As an exception to the Sections above, you may also combine or-link a "work that uses the Library" with the Library to produce a-work containing portions of the Library, and distribute that work-under terms of your choice, provided that the terms permit-modification of the work for the customer's own use and reverse-engineering for debugging such modifications.--  You must give prominent notice with each copy of the work that the-Library is used in it and that the Library and its use are covered by-this License.  You must supply a copy of this License.  If the work-during execution displays copyright notices, you must include the-copyright notice for the Library among them, as well as a reference-directing the user to the copy of this License.  Also, you must do one-of these things:--    a) Accompany the work with the complete corresponding-    machine-readable source code for the Library including whatever-    changes were used in the work (which must be distributed under-    Sections 1 and 2 above); and, if the work is an executable linked-    with the Library, with the complete machine-readable "work that-    uses the Library", as object code and/or source code, so that the-    user can modify the Library and then relink to produce a modified-    executable containing the modified Library.  (It is understood-    that the user who changes the contents of definitions files in the-    Library will not necessarily be able to recompile the application-    to use the modified definitions.)--    b) Use a suitable shared library mechanism for linking with the-    Library.  A suitable mechanism is one that (1) uses at run time a-    copy of the library already present on the user's computer system,-    rather than copying library functions into the executable, and (2)-    will operate properly with a modified version of the library, if-    the user installs one, as long as the modified version is-    interface-compatible with the version that the work was made with.--    c) Accompany the work with a written offer, valid for at least-    three years, to give the same user the materials specified in-    Subsection 6a, above, for a charge no more than the cost of-    performing this distribution.--    d) If distribution of the work is made by offering access to copy-    from a designated place, offer equivalent access to copy the above-    specified materials from the same place.--    e) Verify that the user has already received a copy of these-    materials or that you have already sent this user a copy.--  For an executable, the required form of the "work that uses the-Library" must include any data and utility programs needed for-reproducing the executable from it.  However, as a special exception,-the materials to be distributed need not include anything that is-normally distributed (in either source or binary form) with the major-components (compiler, kernel, and so on) of the operating system on-which the executable runs, unless that component itself accompanies-the executable.--  It may happen that this requirement contradicts the license-restrictions of other proprietary libraries that do not normally-accompany the operating system.  Such a contradiction means you cannot-use both them and the Library together in an executable that you-distribute.--  7. You may place library facilities that are a work based on the-Library side-by-side in a single library together with other library-facilities not covered by this License, and distribute such a combined-library, provided that the separate distribution of the work based on-the Library and of the other library facilities is otherwise-permitted, and provided that you do these two things:--    a) Accompany the combined library with a copy of the same work-    based on the Library, uncombined with any other library-    facilities.  This must be distributed under the terms of the-    Sections above.--    b) Give prominent notice with the combined library of the fact-    that part of it is a work based on the Library, and explaining-    where to find the accompanying uncombined form of the same work.--  8. You may not copy, modify, sublicense, link with, or distribute-the Library except as expressly provided under this License.  Any-attempt otherwise to copy, modify, sublicense, link with, or-distribute the Library is void, and will automatically terminate your-rights under this License.  However, parties who have received copies,-or rights, from you under this License will not have their licenses-terminated so long as such parties remain in full compliance.--  9. You are not required to accept this License, since you have not-signed it.  However, nothing else grants you permission to modify or-distribute the Library or its derivative works.  These actions are-prohibited by law if you do not accept this License.  Therefore, by-modifying or distributing the Library (or any work based on the-Library), you indicate your acceptance of this License to do so, and-all its terms and conditions for copying, distributing or modifying-the Library or works based on it.--  10. Each time you redistribute the Library (or any work based on the-Library), the recipient automatically receives a license from the-original licensor to copy, distribute, link with or modify the Library-subject to these terms and conditions.  You may not impose any further-restrictions on the recipients' exercise of the rights granted herein.-You are not responsible for enforcing compliance by third parties with-this License.--  11. If, as a consequence of a court judgment or allegation of patent-infringement or for any other reason (not limited to patent issues),-conditions are imposed on you (whether by court order, agreement or-otherwise) that contradict the conditions of this License, they do not-excuse you from the conditions of this License.  If you cannot-distribute so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you-may not distribute the Library at all.  For example, if a patent-license would not permit royalty-free redistribution of the Library by-all those who receive copies directly or indirectly through you, then-the only way you could satisfy both it and this License would be to-refrain entirely from distribution of the Library.--If any portion of this section is held invalid or unenforceable under-any particular circumstance, the balance of the section is intended to-apply, and the section as a whole is intended to apply in other-circumstances.--It is not the purpose of this section to induce you to infringe any-patents or other property right claims or to contest validity of any-such claims; this section has the sole purpose of protecting the-integrity of the free software distribution system which is-implemented by public license practices.  Many people have made-generous contributions to the wide range of software distributed-through that system in reliance on consistent application of that-system; it is up to the author/donor to decide if he or she is willing-to distribute software through any other system and a licensee cannot-impose that choice.--This section is intended to make thoroughly clear what is believed to-be a consequence of the rest of this License.--  12. If the distribution and/or use of the Library is restricted in-certain countries either by patents or by copyrighted interfaces, the-original copyright holder who places the Library under this License-may add an explicit geographical distribution limitation excluding those-countries, so that distribution is permitted only in or among-countries not thus excluded.  In such case, this License incorporates-the limitation as if written in the body of this License.--  13. The Free Software Foundation may publish revised and/or new-versions of the Lesser General Public License from time to time.-Such new versions will be similar in spirit to the present version,-but may differ in detail to address new problems or concerns.--Each version is given a distinguishing version number.  If the Library-specifies a version number of this License which applies to it and-"any later version", you have the option of following the terms and-conditions either of that version or of any later version published by-the Free Software Foundation.  If the Library does not specify a-license version number, you may choose any version ever published by-the Free Software Foundation.--  14. If you wish to incorporate parts of the Library into other free-programs whose distribution conditions are incompatible with these,-write to the author to ask for permission.  For software which is-copyrighted by the Free Software Foundation, write to the Free-Software Foundation; we sometimes make exceptions for this.  Our-decision will be guided by the two goals of preserving the free status-of all derivatives of our free software and of promoting the sharing-and reuse of software generally.--                            NO WARRANTY--  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR-OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR-PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE-LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.--  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH-DAMAGES.--                     END OF TERMS AND CONDITIONS--           How to Apply These Terms to Your New Libraries--  If you develop a new library, and you want it to be of the greatest-possible use to the public, we recommend making it free software that-everyone can redistribute and change.  You can do so by permitting-redistribution under these terms (or, alternatively, under the terms-of the ordinary General Public License).--  To apply these terms, attach the following notices to the library.-It is safest to attach them to the start of each source file to most-effectively convey the exclusion of warranty; and each file should-have at least the "copyright" line and a pointer to where the full-notice is found.---    <one line to give the library's name and a brief idea of what it does.>-    Copyright (C) <year>  <name of author>--    This library is free software; you can redistribute it and/or-    modify it under the terms of the GNU Lesser General Public-    License as published by the Free Software Foundation; either-    version 2.1 of the License, or (at your option) any later version.--    This library is distributed in the hope that it will be useful,-    but WITHOUT ANY WARRANTY; without even the implied warranty of-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU-    Lesser General Public License for more details.--    You should have received a copy of the GNU Lesser General Public-    License along with this library; if not, write to the Free Software-    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA--Also add information on how to contact you by electronic and paper mail.--You should also get your employer (if you work as a programmer) or-your school, if any, to sign a "copyright disclaimer" for the library,-if necessary.  Here is a sample; alter the names:--  Yoyodyne, Inc., hereby disclaims all copyright interest in the-  library `Frob' (a library for tweaking knobs) written by James-  Random Hacker.--  <signature of Ty Coon>, 1 April 1990-  Ty Coon, President of Vice+Copyright (c) 2012,2014 Joachim Fasting -That's all there is to it!+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.
− NEWS 
@@ -1,99 +0,0 @@-* 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 <joachim.fasting@gmail.com>-	- 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.
− Network/MPD.hs 
@@ -1,87 +0,0 @@-{-# LANGUAGE CPP #-}--- | Module    : Network.MPD--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ An MPD client library. MPD is a daemon for playing music that is--- controlled over a network socket. Its site is at <http://www.musicpd.org/>.------ To use the library, do:--- --- > {-# LANGUAGE OverloadedStrings #-}--- > import qualified Network.MPD as MPD--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
− Network/MPD/Commands.hs 
@@ -1,523 +0,0 @@-{-# LANGUAGE PatternGuards, OverloadedStrings #-}---- | Module    : Network.MPD.Commands--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ Interface to the user commands supported by MPD.--module Network.MPD.Commands (-    -- * Command related data types-    module Network.MPD.Commands.Types,--    -- * Query interface-    module Network.MPD.Commands.Query,--    -- * Querying MPD's status-    clearError, currentSong, idle, noidle, status, stats,--    -- * Playback options-    consume, crossfade, random, repeat, setVolume, single, replayGainMode,-    replayGainStatus,--    -- * Controlling playback-    next, pause, play, playId, previous, seek, seekId, stop,--    -- * The current playlist-    add, add_, addId, clear, delete, deleteId, move, moveId, playlist, playlistId,-    playlistFind, playlistInfo, playlistSearch, plChanges, plChangesPosId, shuffle, swap,-    swapId,--    -- * Stored playlist-    listPlaylist, listPlaylistInfo, listPlaylists, load, playlistAdd,-    playlistAdd_, playlistClear, playlistDelete, playlistMove, rename, rm,-    save,--    -- * The music database-    count, find, findAdd, list, listAll, listAllInfo, lsInfo, search, update,-    rescan,--    -- * Stickers-    stickerGet, stickerSet, stickerDelete, stickerList, stickerFind,--    -- * Connection-    close, kill, password, ping,--    -- * Audio output devices-    disableOutput, enableOutput, outputs,--    -- * Reflection-    commands, notCommands, tagTypes, urlHandlers, decoders,-    ) where--import           Network.MPD.Commands.Arg-import           Network.MPD.Commands.Parse-import           Network.MPD.Commands.Query-import           Network.MPD.Commands.Types-import           Network.MPD.Commands.Util-import           Network.MPD.Core-import           Network.MPD.Util--import           Control.Monad (liftM)-import           Control.Monad.Error (throwError)-import           Prelude hiding (repeat)--import qualified Data.ByteString.UTF8 as UTF8-import           Data.ByteString (ByteString)------- Querying MPD's status------- | Clear the current error message in status.-clearError :: MonadMPD m => m ()-clearError = getResponse_ "clearerror"---- | Get the currently playing song.-currentSong :: (Functor m, MonadMPD m) => m (Maybe Song)-currentSong = getResponse "currentsong" >>= runParser parseMaybeSong . toAssocList---- | 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 subsystems =-    mapM f =<< toAssocList `liftM` getResponse ("idle" <$> foldr (<++>) (Args []) subsystems)-    where-        f ("changed", system) =-            case system of-                "database"        -> return DatabaseS-                "update"          -> return UpdateS-                "stored_playlist" -> return StoredPlaylistS-                "playlist"        -> return PlaylistS-                "player"          -> return PlayerS-                "mixer"           -> return MixerS-                "output"          -> return OutputS-                "options"         -> return OptionsS-                k                 -> fail ("Unknown subsystem: " ++ UTF8.toString k)-        f x                       =  fail ("idle: Unexpected " ++ show x)---- | Cancel 'idle'.-noidle :: MonadMPD m => m ()-noidle = getResponse_ "noidle"---- | Get server statistics.-stats :: MonadMPD m => m Stats-stats = getResponse "stats" >>= runParser parseStats---- | Get the server's status.-status :: MonadMPD m => m Status-status = getResponse "status" >>= runParser parseStatus------- Playback options------- | Set consume mode-consume :: MonadMPD m => Bool -> m ()-consume = getResponse_ . ("consume" <$>)---- | Set crossfading between songs.-crossfade :: MonadMPD m => Seconds -> m ()-crossfade secs = getResponse_ ("crossfade" <$> secs)---- | Set random playing.-random :: MonadMPD m => Bool -> m ()-random = getResponse_ . ("random" <$>)---- | Set repeating.-repeat :: MonadMPD m => Bool -> m ()-repeat = getResponse_ . ("repeat" <$>)---- | Set the volume (0-100 percent).-setVolume :: MonadMPD m => Int -> m ()-setVolume = getResponse_ . ("setvol" <$>)---- | Set single mode-single :: MonadMPD m => Bool -> m ()-single = getResponse_ . ("single" <$>)---- | Set the replay gain mode.-replayGainMode :: MonadMPD m => ReplayGainMode -> m ()-replayGainMode = getResponse_ . ("replay_gain_mode" <$>)---- | Get the replay gain options.-replayGainStatus :: MonadMPD m => m [String]-replayGainStatus = map UTF8.toString `liftM` getResponse "replay_gain_status"------- Controlling playback------- | Play the next song.-next :: MonadMPD m => m ()-next = getResponse_ "next"---- | Pause playing.-pause :: MonadMPD m => Bool -> m ()-pause = getResponse_ . ("pause" <$>)---- | Begin\/continue playing.-play :: MonadMPD m => Maybe Int -> m ()-play (Just pos) = getResponse_ ("play" <$> pos)-play _          = getResponse_  "play"---- | Play a file with given id.-playId :: MonadMPD m => Id -> m ()-playId id' = getResponse_ ("playid" <$> id')---- | Play the previous song.-previous :: MonadMPD m => m ()-previous = getResponse_ "previous"---- | Seek to some point in a song.-seek :: MonadMPD m => Int -> Seconds -> m ()-seek pos time = getResponse_ ("seek" <$> pos <++> time)---- | Seek to some point in a song (id version)-seekId :: MonadMPD m => Id -> Seconds -> m ()-seekId id' time = getResponse_ ("seekid" <$> id' <++> time)---- | Stop playing.-stop :: MonadMPD m => m ()-stop = getResponse_ "stop"------- The current playlist------- This might do better to throw an exception than silently return 0.--- | Like 'add', but returns a playlist id.-addId :: MonadMPD m => Path -> Maybe Integer -- ^ Optional playlist position-      -> m Id-addId p pos = liftM (parse parseNum Id (Id 0) . snd . head . toAssocList)-              $ getResponse1 ("addid" <$> p <++> pos)---- | Like 'add_' but returns a list of the files added.-add :: MonadMPD m => Path -> m [Path]-add x = add_ x >> listAll x---- | Add a song (or a whole directory) to the current playlist.-add_ :: MonadMPD m => Path -> m ()-add_ path = getResponse_ ("add" <$> path)---- | Clear the current playlist.-clear :: MonadMPD m => m ()-clear = getResponse_ "clear"---- | Remove a song from the current playlist.-delete :: MonadMPD m => Int -> m ()-delete pos = getResponse_ ("delete" <$> pos)---- | Remove a song from the current playlist.-deleteId :: MonadMPD m => Id -> m ()-deleteId id' = getResponse_ ("deleteid" <$> id')---- | Move a song to a given position in the current playlist.-move :: MonadMPD m => Int -> Int -> m ()-move pos to = getResponse_ ("move" <$> pos <++> to)---- | 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 -> Int -> m ()-moveId id' to = getResponse_ ("moveid" <$> id' <++> to)---- | 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 [(Int, 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---- | Search for songs in the current playlist with strict matching.-playlistFind :: MonadMPD m => Query -> m [Song]-playlistFind q = takeSongs =<< getResponse ("playlistfind" <$> q)---- | Retrieve metadata for songs in the current playlist.-playlistInfo :: MonadMPD m => Maybe (Int, Int) -> m [Song]-playlistInfo range = takeSongs =<< getResponse ("playlistinfo" <$> range)---- | 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 id' = takeSongs =<< getResponse ("playlistinfo" <$> id')---- | Search case-insensitively with partial matches for songs in the--- current playlist.-playlistSearch :: MonadMPD m => Query -> m [Song]-playlistSearch q = takeSongs =<< getResponse ("playlistsearch" <$> q)---- | Retrieve a list of changed songs currently in the playlist since--- a given playlist version.-plChanges :: MonadMPD m => Integer -> m [Song]-plChanges version = takeSongs =<< getResponse ("plchanges" <$> version)---- | Like 'plChanges' but only returns positions and ids.-plChangesPosId :: MonadMPD m => Integer -> m [(Int, Id)]-plChangesPosId plver =-    getResponse ("plchangesposid" <$> plver) >>=-    mapM f . splitGroups ["cpos"] . toAssocList-    where f xs | [("cpos", x), ("Id", y)] <- xs-               , Just (x', y') <- pair parseNum (x, y)-               = return (x', Id y')-               | otherwise = throwError . Unexpected $ show xs---- | Shuffle the playlist.-shuffle :: MonadMPD m => Maybe (Int, Int) -- ^ Optional range (start, end)-        -> m ()-shuffle range = getResponse_ ("shuffle" <$> range)---- | Swap the positions of two songs.-swap :: MonadMPD m => Int -> Int -> m ()-swap pos1 pos2 = getResponse_ ("swap" <$> pos1 <++> pos2)---- | Swap the positions of two songs (Id version-swapId :: MonadMPD m => Id -> Id -> m ()-swapId id1 id2 = getResponse_ ("swapid" <$> id1 <++> id2)------- Stored playlists------- | Retrieve a list of files in a given playlist.-listPlaylist :: MonadMPD m => PlaylistName -> m [Path]-listPlaylist plname =-    (map Path . takeValues) `liftM` getResponse ("listplaylist" <$> plname)---- | Retrieve metadata for files in a given playlist.-listPlaylistInfo :: MonadMPD m => PlaylistName -> m [Song]-listPlaylistInfo plname =-    takeSongs =<< getResponse ("listplaylistinfo" <$> plname)---- | Retreive a list of stored playlists.-listPlaylists :: MonadMPD m => m [PlaylistName]-listPlaylists = (map PlaylistName . go [] . toAssocList) `liftM` getResponse "listplaylists"-    where-        -- After each playlist name we get a timestamp-        go acc [] = acc-        go acc ((_, b):_:xs) = go (b : acc) xs-        go _ _ = error "listPlaylists: bug"---- | Load an existing playlist.-load :: MonadMPD m => PlaylistName -> m ()-load plname = getResponse_ ("load" <$> plname)---- | Like 'playlistAdd' but returns a list of the files added.-playlistAdd :: MonadMPD m => PlaylistName -> Path -> m [Path]-playlistAdd plname path = playlistAdd_ plname path >> listAll path---- | 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 path = getResponse_ ("playlistadd" <$> plname <++> path)---- | Clear a playlist. If the specified playlist does not exist, it will be--- created.-playlistClear :: MonadMPD m => PlaylistName -> m ()-playlistClear = getResponse_ . ("playlistclear" <$>)---- | Remove a song from a playlist.-playlistDelete :: MonadMPD m => PlaylistName-               -> Integer -- ^ Playlist position-               -> m ()-playlistDelete name pos = getResponse_ ("playlistdelete" <$> name <++> pos)---- | Move a song to a given position in the playlist specified.-playlistMove :: MonadMPD m => PlaylistName -> Integer -> Integer -> m ()-playlistMove name from to =-    getResponse_ ("playlistmove" <$> name <++> from <++> to)---- | Rename an existing playlist.-rename :: MonadMPD m-       => PlaylistName -- ^ Original playlist-       -> PlaylistName -- ^ New playlist name-       -> m ()-rename plname new = getResponse_ ("rename" <$> plname <++> new)---- | Delete existing playlist.-rm :: MonadMPD m => PlaylistName -> m ()-rm plname = getResponse_ ("rm" <$> plname)---- | Save the current playlist.-save :: MonadMPD m => PlaylistName -> m ()-save plname = getResponse_ ("save" <$> plname)------- The music database------- | Count the number of entries matching a query.-count :: MonadMPD m => Query -> m Count-count query = getResponse ("count" <$>  query) >>= runParser parseCount---- | Search the database for entries exactly matching a query.-find :: MonadMPD m => Query -> m [Song]-find query = getResponse ("find" <$> query) >>= takeSongs---- | Adds songs matching a query to the current playlist.-findAdd :: MonadMPD m => Query -> m ()-findAdd q = getResponse_ ("findadd" <$> q)---- | List all tags of the specified type.-list :: MonadMPD m-     => Metadata -- ^ Metadata to list-     -> Query -> m [Value]-list mtype query = (map Value . takeValues) `liftM` getResponse ("list" <$> mtype <++> query)----- | List the songs (without metadata) in a database directory recursively.-listAll :: MonadMPD m => Path -> m [Path]-listAll path = liftM (map (Path . snd) . filter ((== "file") . fst) . toAssocList)-                     (getResponse $ "listall" <$> path)---- Helper for lsInfo and listAllInfo.-lsInfo' :: MonadMPD m => Command -> Path -> m [LsResult]-lsInfo' cmd path = getResponse (cmd <$> path) >>= takeEntries---- | Recursive 'lsInfo'.-listAllInfo :: MonadMPD m => Path -> m [LsResult]-listAllInfo = lsInfo' "listallinfo"---- | Non-recursively list the contents of a database directory.-lsInfo :: MonadMPD m => Path -> m [LsResult]-lsInfo = lsInfo' "lsinfo"---- | Search the database using case insensitive matching.-search :: MonadMPD m => Query -> m [Song]-search query = getResponse ("search" <$> query) >>= takeSongs---- | Update the server's database.--- If no paths are given, all paths will be scanned.--- Unreadable or non-existent paths are silently ignored.-update :: MonadMPD m => [Path] -> m ()-update  [] = getResponse_ "update"-update [x] = getResponse_ ("update" <$> x)-update xs  = getResponses (map ("update" <$>) xs) >> return ()---- | Like 'update' but also rescans unmodified files.-rescan :: MonadMPD m => [Path] -> m ()-rescan []  = getResponse_ "rescan"-rescan [x] = getResponse_ ("rescan" <$> x)-rescan xs  = getResponses (map ("rescan" <$>) xs) >> return ()------- Stickers------- | Reads a sticker value for the specified object.-stickerGet :: MonadMPD m => ObjectType-           -> String -- ^ Object URI-           -> String -- ^ Sticker name-           -> m [String]-stickerGet typ uri name = (map UTF8.toString . takeValues) `liftM` getResponse ("sticker get" <$> typ <++> uri <++> name)---- | 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 value =-    getResponse_ ("sticker set" <$> typ <++> uri <++> name <++> value)---- | Delete a sticker value from the specified object.-stickerDelete :: MonadMPD m => ObjectType-              -> String -- ^ Object URI-              -> String -- ^ Sticker name-              -> m ()-stickerDelete typ uri name =-    getResponse_ ("sticker delete" <$> typ <++> uri <++> name)---- an internal helper function-decodePair :: (ByteString, ByteString) -> (String, String)-decodePair (x, y) = (UTF8.toString x, UTF8.toString y)---- | Lists the stickers for the specified object.-stickerList :: MonadMPD m => ObjectType-            -> String -- ^ Object URI-            -> m [(String, String)] -- ^ Sticker name\/sticker value-stickerList typ uri =-    (map decodePair . toAssocList) `liftM` getResponse ("sticker list" <$> typ <++> uri)---- | 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 name =-    (map decodePair . toAssocList) `liftM`-    getResponse ("sticker find" <$> typ <++> uri <++> name)------- Connection------- 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 = getResponse_ . ("password " ++)---- | Check that the server is still responding.-ping :: MonadMPD m => m ()-ping = getResponse_ "ping"------- Audio output devices------- | Turn off an output device.-disableOutput :: MonadMPD m => Int -> m ()-disableOutput = getResponse_ . ("disableoutput" <$>)---- | Turn on an output device.-enableOutput :: MonadMPD m => Int -> m ()-enableOutput = getResponse_ . ("enableoutput" <$>)---- | Retrieve information for all output devices.-outputs :: MonadMPD m => m [Device]-outputs = getResponse "outputs" >>= runParser parseOutputs------- Reflection------- | Retrieve a list of available commands.-commands :: MonadMPD m => m [String]-commands = (map UTF8.toString . takeValues) `liftM` getResponse "commands"---- | Retrieve a list of unavailable (due to access restrictions) commands.-notCommands :: MonadMPD m => m [String]-notCommands = (map UTF8.toString . takeValues) `liftM` getResponse "notcommands"---- | Retrieve a list of available song metadata.-tagTypes :: MonadMPD m => m [String]-tagTypes = (map UTF8.toString . takeValues) `liftM` (getResponse "tagtypes")---- | Retrieve a list of supported urlhandlers.-urlHandlers :: MonadMPD m => m [String]-urlHandlers = (map UTF8.toString . takeValues) `liftM` (getResponse "urlhandlers")---- | Retreive a list of decoder plugins with associated suffix and mime types.-decoders :: MonadMPD m => m [(String, [(String, String)])]-decoders = (takeDecoders . toAssocList) `liftM` getResponse "decoders"-    where-        takeDecoders [] = []-        takeDecoders ((_, p):xs) =-            let (info, rest) = break ((==) "plugin" . fst) xs-            in (UTF8.toString p, map decodePair info) : takeDecoders rest
− Network/MPD/Commands/Arg.hs 
@@ -1,73 +0,0 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, GeneralizedNewtypeDeriving #-}---- | Module    : Network.MPD.Commands.Arg--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ 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 ['"' : 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
− Network/MPD/Commands/Extensions.hs 
@@ -1,147 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | Module    : Network.MPD.Commands.Extensions--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ Extensions and shortcuts to the standard MPD command set.--module Network.MPD.Commands.Extensions where--import           Network.MPD.Core-import           Network.MPD.Commands-import           Network.MPD.Commands.Arg-import           Network.MPD.Commands.Util-import           Network.MPD.Util (read)--import           Prelude hiding (read)-import           Control.Monad (liftM)---- | Like 'update', but returns the update job id.-updateId :: MonadMPD m => [Path] -> m Integer-updateId paths = liftM (read . head . takeValues) cmd-  where cmd = case paths of-                []  -> getResponse  "update"-                [x] -> getResponse ("update" <$> x)-                xs  -> getResponses $ map ("update" <$>) xs---- | 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 _ [] = return ()-addMany "" [x] = add_ x-addMany plname [x] = playlistAdd_ plname x-addMany plname xs = getResponses (map cmd xs) >> return ()-    where cmd x = case plname of-                      "" -> "add" <$> x-                      pl -> "playlistadd" <$> pl <++> x---- | Delete a list of songs from a playlist.--- If there is a duplicate then no further songs will be deleted, so--- take care to avoid them (see 'prune' for this).-{- deleteMany :: MonadMPD m => PlaylistName -> [PLIndex] -> m ()-deleteMany _ [] = return ()-deleteMany plname [(Pos x)] = playlistDelete plname x-deleteMany "" xs = getResponses (map cmd xs) >> return ()-    where cmd (Pos x) = "delete"   <$> x-          cmd (ID x)  = "deleteid" <$> x-deleteMany plname xs = getResponses (map cmd xs) >> return ()-    where cmd (Pos x) = "playlistdelete" <$> plname <++> x-          cmd _       = ""---- | 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---- | Crop playlist.--- The bounds are inclusive.--- If 'Nothing' is passed the cropping will leave your playlist alone--- on that side.--- Using 'ID' will automatically find the absolute playlist position and use--- that as the cropping boundary.-crop :: MonadMPD m => Maybe PLIndex -> Maybe PLIndex -> m ()-crop x y = do-    pl <- playlistInfo Nothing-    let x' = case x of Just (Pos p) -> fromInteger p-                       Just (ID i)  -> fromMaybe 0 (findByID i pl)-                       Nothing      -> 0-        -- ensure that no songs are deleted twice with 'max'.-        ys = case y of Just (Pos p) -> drop (max (fromInteger p) x') pl-                       Just (ID i)  -> maybe [] (flip drop pl . max x' . (+1))-                                      (findByID i pl)-                       Nothing      -> []-    deleteMany "" . mapMaybe sgIndex $ take x' pl ++ ys-    where findByID i = findIndex ((==) i . (\(ID j) -> j) . fromJust . sgIndex)---- | Remove duplicate playlist entries.-prune :: MonadMPD m => m ()-prune = findDuplicates >>= deleteMany ""---- Find duplicate playlist entries.-findDuplicates :: MonadMPD m => m [PLIndex]-findDuplicates =-    liftM (map ((\(ID x) -> ID x) . fromJust . sgIndex) . flip dups ([],[])) $-        playlistInfo Nothing-    where dups [] (_, dup) = dup-          dups (x:xs) (ys, dup)-              | x `mSong` xs && not (x `mSong` ys) = dups xs (ys, x:dup)-              | otherwise                          = dups xs (x:ys, dup)-          mSong x = let m = sgFilePath x in any ((==) m . sgFilePath)---- | List directories non-recursively.-lsDirs :: MonadMPD m => Path -> m [Path]-lsDirs path =-    liftM (extractEntries (const Nothing,const Nothing, Just)) $-        takeEntries =<< getResponse ("lsinfo" <$> path)---- | List files non-recursively.-lsFiles :: MonadMPD m => Path -> m [Path]-lsFiles path =-    liftM (extractEntries (Just . sgFilePath, const Nothing, const Nothing)) $-        takeEntries =<< getResponse ("lsinfo" <$> path)---- | List all playlists.-lsPlaylists :: MonadMPD m => m [PlaylistName]-lsPlaylists = liftM (extractEntries (const Nothing, Just, const Nothing)) $-                    takeEntries =<< getResponse "lsinfo" -}---- | List the artists in the database.-listArtists :: MonadMPD m => m [Artist]-listArtists = (map Value . takeValues) `liftM` (getResponse "list artist")---- | List the albums in the database, optionally matching a given--- artist.-listAlbums :: MonadMPD m => Maybe Artist -> m [Album]-listAlbums artist = (map Value . takeValues) `liftM`-                    getResponse ("list album" <$> fmap (("artist" :: String) <++>) artist)---- | 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-    current <- (fromIntegral . stVolume) `liftM` status-    setVolume . round $ (fromIntegral n / (100 :: Double)) * current + current
− Network/MPD/Commands/Parse.hs 
@@ -1,183 +0,0 @@-{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}---- | Module    : Network.MPD.Commands.Parse--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ Parsers for MPD data types.--module Network.MPD.Commands.Parse where--import           Network.MPD.Commands.Types--import           Control.Arrow ((***))-import           Control.Monad.Error-import           Data.Maybe (fromMaybe)--import           Network.MPD.Util-import           Network.MPD.Core (MonadMPD, MPDError(Unexpected))--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 defaultCount . 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 defaultDevice)-             . 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                    = fail $ show x---- | Builds a 'Stats' instance from an assoc. list.-parseStats :: [ByteString] -> Either String Stats-parseStats = foldM f defaultStats . 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 = fail $ show x--parseMaybeSong :: [(ByteString, ByteString)] -> Either String (Maybe Song)-parseMaybeSong xs | null xs   = Right Nothing-                  | otherwise = Just `fmap` parseSong 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 "Artist" = Just Artist-        readMeta "Album" = Just Album-        readMeta "Title" = Just Title-        readMeta "Genre" = Just Genre-        readMeta "Name" = Just Name-        readMeta "Composer" = Just Composer-        readMeta "Performer" = Just Performer-        readMeta "Date" = Just Date-        readMeta "Track" = Just Track-        readMeta "Disc" = Just Disc-        readMeta "MUSICBRAINZ_ARTISTID" = Just MUSICBRAINZ_ARTISTID-        readMeta "MUSICBRAINZ_TRACKID" = Just MUSICBRAINZ_TRACKID-        readMeta _ = Nothing---- | Builds a 'Status' instance from an assoc. list.-parseStatus :: [ByteString] -> Either String Status-parseStatus = foldM f defaultStatus . toAssocList-    where f a ("state", x)-              = return $ parse state     (\x' -> a { stState = x' }) a x-          f a ("volume", x)-              = return $ parse parseNum  (\x' -> a { stVolume = x' }) a x-          f a ("repeat", x)-              = return $ parse parseBool (\x' -> a { stRepeat = x' }) a x-          f a ("random", x)-              = return $ parse parseBool (\x' -> a { stRandom = x' }) a x-          f a ("playlist", x)-              = return $ parse parseNum  (\x' -> a { stPlaylistVersion = x' }) a x-          f a ("playlistlength", x)-              = return $ parse parseNum  (\x' -> a { stPlaylistLength = x' }) a x-          f a ("xfade", x)-              = return $ parse parseNum  (\x' -> a { stXFadeWidth = x' }) a x-          f a ("mixrampdb", x)-              = return $ parse parseFrac (\x' -> a { stMixRampdB = x' }) a x-          f a ("mixrampdelay", x)-              = return $ parse parseFrac (\x' -> a { stMixRampDelay = x' }) a x-          f a ("song", x)-              = return $ parse parseNum  (\x' -> a { stSongPos = Just x' }) a x-          f a ("songid", x)-              = return $ parse parseNum  (\x' -> a { stSongID = Just $ Id x' }) a x-          f a ("time", x)-              = return $ parse time      (\x' -> a { stTime = x' }) a x-          f a ("elapsed", x)-              = return $ parse parseFrac (\x' -> a { stTime = (x', snd $ stTime a) }) a x-          f a ("bitrate", x)-              = return $ parse parseNum  (\x' -> a { stBitrate = x' }) a x-          f a ("audio", x)-              = return $ parse audio     (\x' -> a { stAudio = x' }) a x-          f a ("updating_db", x)-              = return $ parse parseNum  (\x' -> a { stUpdatingDb = x' }) a x-          f a ("error", x)-              = return a { stError = Just (UTF8.toString x) }-          f a ("single", x)-              = return $ parse parseBool (\x' -> a { stSingle = x' }) a x-          f a ("consume", x)-              = return $ parse parseBool (\x' -> a { stConsume = x' }) a x-          f a ("nextsong", x)-              = return $ parse parseNum  (\x' -> a { stNextSongPos = Just x' }) a x-          f a ("nextsongid", x)-              = return $ parse parseNum  (\x' -> a { stNextSongID = Just $ Id x' }) a x-          f _ x-              = fail $ show x--          state "play"  = Just Playing-          state "pause" = Just Paused-          state "stop"  = Just Stopped-          state _       = Nothing--          time s = case parseFrac *** parseNum $ breakChar ':' s of-                       (Just a, Just b) -> Just (a, b)-                       _                -> Nothing--          audio = parseTriple ':' parseNum---- | Run a parser and lift the result into the 'MPD' monad-runParser :: (MonadMPD m, MonadError MPDError m)-          => (input -> Either String a) -> input -> m a-runParser f = either (throwError . Unexpected) return . f---- | 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
− Network/MPD/Commands/Query.hs 
@@ -1,56 +0,0 @@--- | Module    : Network.MPD.Commands.Query--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ 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
− Network/MPD/Commands/Types.hs 
@@ -1,285 +0,0 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, GeneralizedNewtypeDeriving #-}--- | Module    : Network.MPD.Commands.Types--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ Various MPD data structures and types--module Network.MPD.Commands.Types where--import           Network.MPD.Commands.Arg (MPDArg(prep), Args(Args))--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 an 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-              -- NOTE: The commented constructors are not yet handled by the-              -- parser.  If you uncomment them, some test will fail.-              -- | ArtistSort-              | Album-              -- | AlbumArtist-              -- | AlbumArtistSort-              | Title-              | Track-              | Name-              | Genre-              | Date-              | Composer-              | Performer-              -- | Comment-              | Disc-              | MUSICBRAINZ_ARTISTID-              -- | MUSICBRAINZ_ALBUMID-              -- | MUSICBRAINZ_ALBUMARTISTID-              | MUSICBRAINZ_TRACKID-              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---- | 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-      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"]--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 }---- | 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 }---- | Represents a single song item.-data Song = Song-         { sgFilePath     :: Path-         -- | Map of available tags (multiple occurences 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 Int-         } deriving (Eq, Show)--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 }---- | Container for MPD status.-data Status =-    Status { stState :: State-             -- | A percentage (0-100)-           , stVolume          :: 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 Int-             -- | Current song's playlist ID.-           , stSongID          :: Maybe Id-             -- | Next song's position in the playlist.-           , stNextSongPos     :: Maybe Int-             -- | Next song's playlist ID.-           , stNextSongID      :: Maybe Id-             -- | Time elapsed\/total time.-           , stTime            :: (Double, Seconds)-             -- | Bitrate (in kilobytes per second) of playing song (if any).-           , stBitrate         :: 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      :: 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 = 0, stRepeat = False-           , stRandom = False, stPlaylistVersion = 0, stPlaylistLength = 0-           , stSongPos = Nothing, stSongID = Nothing, stTime = (0,0)-           , stNextSongPos = Nothing, stNextSongID = Nothing-           , stBitrate = 0, stXFadeWidth = 0, stMixRampdB = 0-           , stMixRampDelay = 0, stAudio = (0,0,0), stUpdatingDb = 0-           , stSingle = False, stConsume = False, stError = Nothing }
− Network/MPD/Commands/Util.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | Module    : Network.MPD.Commands.Util--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ Internal utilities for implementing MPD commands.--module Network.MPD.Commands.Util where--import           Network.MPD.Commands.Parse-import           Network.MPD.Commands.Types-import           Network.MPD.Core-import           Network.MPD.Util--import           Control.Monad.Error-import           Data.List (intersperse)-import           Data.Maybe (mapMaybe)--import           Data.ByteString.Char8 (ByteString)---- Run getResponse but discard the response.-getResponse_ :: MonadMPD m => String -> m ()-getResponse_ x = getResponse x >> return ()---- Get the lines of the daemon's response to a list of commands.-getResponses :: MonadMPD m => [String] -> m [ByteString]-getResponses cmds = getResponse . concat $ intersperse "\n" cmds'-    where cmds' = "command_list_begin" : cmds ++ ["command_list_end"]---- Helper that throws unexpected error if input is empty.-failOnEmpty :: MonadMPD m => [ByteString] -> m [ByteString]-failOnEmpty [] = throwError $ Unexpected "Non-empty response expected."-failOnEmpty xs = return xs---- A wrapper for getResponse that fails on non-empty responses.-getResponse1 :: MonadMPD m => String -> m [ByteString]-getResponse1 x = getResponse x >>= failOnEmpty---- Run 'toAssocList' and return only the values.-takeValues :: [ByteString] -> [ByteString]-takeValues = snd . unzip . toAssocList---- Separate the result of an lsinfo\/listallinfo call into directories,--- playlists, and songs.-takeEntries :: MonadMPD m => [ByteString] -> m [LsResult]-takeEntries = mapM toEntry . splitGroups groupHeads . toAssocList-    where-        toEntry xs@(("file",_):_)   = LsSong `liftM` runParser 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"]---- Extract a subset of songs, directories, and playlists.-extractEntries :: (Song -> Maybe a, PlaylistName -> Maybe a, Path -> Maybe a)-               -> [LsResult] -> [a]-extractEntries (fSong,fPlayList,fDir) = mapMaybe f-    where-        f (LsSong s) = fSong s-        f (LsPlaylist pl)  = fPlayList pl-        f (LsDirectory d)  = fDir d---- Build a list of song instances from a response.-takeSongs :: MonadMPD m => [ByteString] -> m [Song]-takeSongs = mapM (runParser parseSong)-          . splitGroups ["file"]-          . toAssocList
− Network/MPD/Core.hs 
@@ -1,249 +0,0 @@-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | Module    : Network.MPD.Core--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- 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, get, 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)-import qualified System.IO.UTF8 as U-import           Text.Printf (printf)--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-    getHandle      = MPD $ stHandle <$> get-    getPassword    = MPD $ stPassword <$> get-    setPassword pw = MPD $ modify (\st -> st { stPassword = pw })-    getVersion     = MPD $ stVersion <$> get---- | 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-    handle <- liftIO (safeConnectTo host port)-    modify (\st -> st { stHandle = handle })-    F.forM_ handle (const $ runMPD checkConn >>= flip 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-        get >>= F.mapM_ (liftIO . sendClose) . stHandle-        modify (\st -> st { stHandle = Nothing })-    where-        sendClose handle =-            (hPutStrLn handle "close" >> hReady handle >> hClose handle)-            `E.catch` whenEOF (return ())--        whenEOF result err-            | isEOFError err = result-            | otherwise      = ioError err--mpdSend :: String -> MPD [ByteString]-mpdSend str = send' `catchError` handler-    where-        handler TimedOut = mpdOpen >> send'-        handler err      = throwError err--        send' = MPD $ get >>= maybe (throwError NoMPD) go . stHandle--        go handle = do-            unless (null str) $-                liftIO $ U.hPutStrLn handle str >> hFlush handle-            liftIO ((Right <$> getLines handle []) `E.catch` (return . Left))-                >>= either (\err -> if isEOFError err then-                                        modify (\st -> st { stHandle = Nothing })-                                        >> throwError TimedOut-                                      else liftIO (ioError 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)-------- Other operations.-----ignore :: (Monad m) => m a -> m ()-ignore x = x >> return ()---- | Kill the server. Obviously, the connection is then invalid.-kill :: (MonadMPD m) => m ()-kill = ignore (send "kill") `catchError` cleanup-    where-        cleanup e = if e == TimedOut then close else throwError e---- | 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)
− Network/MPD/Core/Class.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}---- | Module    : Network.MPD.Core.Class--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ The MPD typeclass.--module Network.MPD.Core.Class where--import           System.IO (Handle)-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]-    -- | Get underlying Handle (or Nothing, if no connection is estabilished)-    getHandle :: m (Maybe Handle)-    -- | 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)
− Network/MPD/Core/Error.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}---- | Module    : Network.MPD.Core.Error--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ 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-              | TimedOut           -- ^ The connection timed out-              | 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 TimedOut       = "MPD connection timed out"-    show (Unexpected s) = "MPD returned an unexpected response: " ++ s-    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
− Network/MPD/Util.hs 
@@ -1,113 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | Module    : Network.MPD.Util--- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010--- License     : LGPL (see LICENSE)--- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>--- Stability   : alpha------ Utilities.--module Network.MPD.Util (-    parseDate, parseIso8601, formatIso8601, parseNum, parseFrac,-    parseBool, showBool, breakChar, parseTriple,-    toAssoc, toAssocList, splitGroups, read-    ) where--import           Data.Char (isDigit)-import           Data.Time.Format (ParseTime, parseTime, FormatTime, formatTime)-import           System.Locale (defaultTimeLocale)--import qualified Prelude-import           Prelude hiding        (break, take, drop, takeWhile, dropWhile, read, reads)-import           Data.ByteString.Char8 (break, take, drop, takeWhile, dropWhile, ByteString)-import qualified Data.ByteString.UTF8 as UTF8-import           Data.String---- | Like Prelude.read, but works with ByteString.-read :: Read a => ByteString -> a-read = Prelude.read . UTF8.toString---- | Like Prelude.reads, but works with ByteString.-reads :: Read a => ByteString -> [(a, String)]-reads = Prelude.reads . UTF8.toString---- Break a string by character, removing the separator.-breakChar :: Char -> ByteString -> (ByteString, ByteString)-breakChar c s = let (x, y) = break (== c) s in (x, drop 1 y)---- XXX: need a more robust date parser.--- Parse a date value.--- > parseDate "2008" = Just 2008--- > parseDate "2008-03-01" = Just 2008-parseDate :: ByteString -> Maybe Int-parseDate = parseNum . takeWhile isDigit---- 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 s = do-    [(x, "")] <- return (reads s)-    return x---- Parse C style floating point value, returning 'Nothing' on failure.-parseFrac :: (Fractional a, Read a) => ByteString -> Maybe a-parseFrac s =-    case s of-        "nan"  -> return $ Prelude.read "NaN"-        "inf"  -> return $ Prelude.read "Infinity"-        "-inf" -> return $ Prelude.read "-Infinity"-        _      -> do [(x, "")] <- return $ reads s-                     return x---- Inverts 'parseBool'.-showBool :: IsString a => Bool -> a--- FIXME: can we change the type to (Bool -> ByteString)?-showBool x = if x then "1" else "0"---- Parse a boolean response value.-parseBool :: ByteString -> Maybe Bool-parseBool s = case take 1 s of-                  "1" -> Just True-                  "0" -> Just False-                  _   -> Nothing---- 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 an key-value pair, separating at the first ':'.-toAssoc :: ByteString -> (ByteString, ByteString)-toAssoc x = (k, dropWhile (== ' ') $ drop 1 v)-    where-        (k,v) = break (== ':') x--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
README.md view
@@ -1,110 +1,70 @@ # libmpd-haskell: a client library for MPD  ## About-libmpd-haskell is a client library for [MPD] written in [Haskell] that-aims to provide a safe and flexible yet consistent and intuitive-interface to MPD's external API.+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]-* `git clone git://github.com/joachifm/libmpd-haskell.git`--[Latest release]: http://hackage.haskell.org/package/libmpd "libmpd-haskell on Hackage"+* [Latest release on Hackage]+* `git clone git://github.com/vimus/libmpd-haskell.git` -## Building-The preferred method of building libmpd-haskell is using [cabal-install], which-takes care of dependency resolution and other minutiae.+[Latest release on Hackage]: http://hackage.haskell.org/package/libmpd "libmpd-haskell on Hackage" -To install libmpd-haskell, simply run:+## Installation+With [cabal-install], do  `cd libmpd-haskell && cabal install`  [cabal-install]: http://hackage.haskell.org/package/cabal-install -## Running tests-To run the libmpd testsuite, do:--`cabal configure --enable-tests && cabal build && cabal test`--## Compiler support-We try to support the two last major versions of GHC, but only the latest-version (provided by the [haskell-platform]) is actually tested for.--[haskell-platform]: http://www.haskell.org/platform--## MPD API compliance-We try to comply with the latest version of the MPD protocol specification;-any deviation from this is a bug.- ## Usage With GHCi:      > :set -XOverloadedStrings     > import Network.MPD     > withMPD $ lsInfo ""-    Right [Left "Tool", Left "Tom Waits",...]+    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",...] -## Development--### Getting started-Create the clone thus:--`git clone git://github.com/joachifm/libmpd-haskell.git master`--To pull in new changes from upstream, use:--`git pull origin master`+## MPD API compliance+Any deviation from the latest version of the [MPD protocol reference]+is a bug. -To set up GIT hooks, see `hooks/README` in the source distribution.+## Submitting bug reports+See our [bug tracker]. Test cases are highly appreciated. -### Submitting patches+## 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 [repository] and send a pull-request.+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. -### Submitting bug reports-See our [bug tracker]. Test cases are highly appreciated.--### Resources+## Resources * [API documentation]-* [libmpd-haskell mailing list]-* [Protocol reference]+* [MPD protocol reference] * [Using GitHub]-* \#libmpd-haskell @ irc.freenode.net (defunct)+* \#vimus @ irc.freenode.net -[libmpd-haskell mailing list]: http://groups.google.com/group/libmpd-haskell-[bug tracker]: http://github.com/joachifm/libmpd-haskell/issues+[bug tracker]: http://github.com/vimus/libmpd-haskell/issues [GitHub]: http://www.github.com-[repository]: http://www.github.com/joachifm/libmpd-haskell-[API documentation]: http://hackage.haskell.org/packages/archive/libmpd/0.7.2/doc/html/Network-MPD.html-[Protocol reference]: http://www.musicpd.org/doc/protocol/+[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-LGPL version 2.1 (see LICENSE)--## Contributors (in order of appearance)-Ben Sinclair \<ben.d.sinclair@gmail.com\>--Joachim Fasting \<joachim.fasting@gmail.com\>--gwern0 \<gwern0@gmail.com\>--Daniel Schoepe \<daniel.schoepe@googlemail.com\>--Andrzej Rybczak \<electricityispower@gmail.com\>--Simon Hengel \<sol@typeful.net\>+libmpd-haskell is distributed under the [MIT license]. -Daniel Wagner \<daniel@wagner-home.com\>+[MIT license]: http://www.opensource.org/licenses/MIT -nandykins+## Contributors+See `CONTRIBUTORS` in the source distribution.+Feel free to add yourself to this list if you deem it appropriate+to do so.
+ changelog.md view
@@ -0,0 +1,118 @@+* 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 <joachim.fasting@gmail.com>+	- 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.cabal view
@@ -1,31 +1,29 @@ Name:               libmpd-Version:            0.8.0.5+Version:            0.9.0 Synopsis:           An MPD client library.-Description:        A client library for MPD, the Music Player Daemon-                    (<http://www.musicpd.org/>).+Description:        A client library for MPD, the Music Player Daemon. Category:           Network, Sound -License:            LGPL+License:            MIT License-file:       LICENSE-Copyright:          Ben Sinclair 2005-2009, Joachim Fasting 2014+Copyright:          Ben Sinclair 2005-2009, Joachim Fasting 2012-2014 Author:             Ben Sinclair  Maintainer:         Joachim Fasting <joachim.fasting@gmail.com> Stability:          beta-Homepage:           http://github.com/joachifm/libmpd-haskell#readme-Bug-reports:        http://github.com/joachifm/libmpd-haskell/issues+Homepage:           http://github.com/vimus/libmpd-haskell#readme+Bug-reports:        http://github.com/vimus/libmpd-haskell/issues -Tested-With:        GHC == 7.0.2+Tested-With:        GHC ==7.6.3, GHC ==7.8.3 Build-Type:         Simple Cabal-Version:      >= 1.10  Extra-Source-Files:     README.md-    NEWS+    changelog.md     tests/Arbitrary.hs     tests/CommandSpec.hs     tests/EnvSpec.hs-    tests/Defaults.hs     tests/ParserSpec.hs     tests/StringConn.hs     tests/TestUtil.hs@@ -35,27 +33,43 @@  Source-Repository head     type:       git-    location:   https://github.com/joachifm/libmpd-haskell+    location:   https://github.com/vimus/libmpd-haskell  Library     Default-Language:   Haskell2010 +    Hs-Source-Dirs:     src+     Build-Depends:+        -- Platform dependencies         base >= 4 && < 5-      , mtl >= 2.0 && < 3-      , network >= 2.1 && < 2.6-      , filepath >= 1.0 && < 1.4-      , utf8-string >= 0.3.1 && < 0.4-      , old-locale >= 1.0 && < 2.0-      , time >= 1.1 && < 2.0-      , containers >= 0.3 && < 0.6-      , data-default >= 0.4.0 && < 0.6+      , attoparsec >= 0.10.1 && < 1       , bytestring >= 0.9 && < 1-      , text >= 0.11-      , attoparsec >= 0.10.1 && < 0.13+      , containers >= 0.3 && < 1+      , filepath >= 1 && < 2+      , mtl >= 2.0 && < 3+      , old-locale >= 1 && < 2+      , text >= 0.11 && < 2+      , time >= 1.1 && < 2 +        -- Additional dependencies+      , data-default >= 0.4 && < 1+      , network >= 2.1 && < 3+      , utf8-string >= 0.3.1 && < 1+     Exposed-Modules:         Network.MPD+      , Network.MPD.Applicative+      , 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 @@ -67,7 +81,18 @@       , Network.MPD.Commands.Parse       , Network.MPD.Commands.Query       , Network.MPD.Commands.Types-      , Network.MPD.Commands.Util+      , 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-prof-options:   -auto-all -prof@@ -76,23 +101,29 @@ Test-Suite specs     type:               exitcode-stdio-1.0     Default-Language:   Haskell2010-    Main-Is:            tests/Main.hs-    Hs-Source-Dirs:     . tests-    cpp-options:        -DTEST+    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-      , utf8-string+      , attoparsec       , bytestring-      , old-locale-      , network+      , containers+      , filepath       , mtl+      , old-locale       , text-      , containers+      , time++        -- Additional dependencies       , data-default+      , network+      , utf8-string++        -- Test dependencies       , unix-      , time       , QuickCheck >= 2.1-      , hspec-      , HUnit+      , hspec >= 1.3
+ src/Network/MPD.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE CPP #-}++{- |+Module      : Network.MPD+Copyright   : (c) Joachim Fasting, Simon Hengel 2012+License     : MIT++Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>+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
+ src/Network/MPD/Applicative.hs view
@@ -0,0 +1,47 @@+module 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
+ src/Network/MPD/Applicative/Connection.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.Connection+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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"]
+ src/Network/MPD/Applicative/CurrentPlaylist.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.CurrentPlaylist+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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]
+ src/Network/MPD/Applicative/Database.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.Database+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Applicative/Internal.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++{- |+Module      : Network.MPD.Applicative.Internal+Copyright   : (c) Simon Hengel 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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"
+ src/Network/MPD/Applicative/Output.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.Output+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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"]
+ src/Network/MPD/Applicative/PlaybackControl.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.PlaybackControl+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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"]
+ src/Network/MPD/Applicative/PlaybackOptions.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.PlaybackOptions+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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]
+ src/Network/MPD/Applicative/Reflection.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.Reflection+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Applicative/Status.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.Status+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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) }+                "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)
+ src/Network/MPD/Applicative/Stickers.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.Stickers+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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]
+ src/Network/MPD/Applicative/StoredPlaylists.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.StoredPlaylists+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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]
+ src/Network/MPD/Applicative/Util.hs view
@@ -0,0 +1,34 @@+{-# 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)
+ src/Network/MPD/Commands.hs view
@@ -0,0 +1,68 @@+{- |+Module      : Network.MPD.Commands+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/Arg.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, GeneralizedNewtypeDeriving #-}++{- |+Module      : Network.MPD.Commands.Arg+Copyright   : (c) Joachim Fasting, Simon Hengel 2012+License     : MIT++Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>+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 ['"' : 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
+ src/Network/MPD/Commands/Connection.hs view
@@ -0,0 +1,31 @@+{- |+Module      : Network.MPD.Commands.Connection+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/CurrentPlaylist.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.CurrentPlaylist+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/Database.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.Database+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/Extensions.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.Extensions+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>+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
+ src/Network/MPD/Commands/Output.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.Output+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/Parse.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}++-- | Module    : Network.MPD.Commands.Parse+-- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010+-- License     : MIT (see LICENSE)+-- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>+-- 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 _ = 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
+ src/Network/MPD/Commands/PlaybackControl.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.PlaybackControl+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/PlaybackOptions.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.PlaybackOptions+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/Query.hs view
@@ -0,0 +1,60 @@+{- |+Module      : Network.MPD.Commands.Query+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>+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
+ src/Network/MPD/Commands/Reflection.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.Reflection+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/Status.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.Status+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/Stickers.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.Stickers+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/StoredPlaylists.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.StoredPlaylists+Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012+License     : MIT (see LICENSE)++Maintainer  : joachim.fasting@gmail.com+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
+ src/Network/MPD/Commands/Types.hs view
@@ -0,0 +1,337 @@+{-# 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 <joachim.fasting@gmail.com>+-- 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++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+              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
+ src/Network/MPD/Core.hs view
@@ -0,0 +1,253 @@+{-# 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 <joachim.fasting@gmail.com>+-- 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 qualified System.IO.UTF8 as U+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) $ U.hPutStrLn handle 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)
+ src/Network/MPD/Core/Class.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleContexts #-}++-- | Module    : Network.MPD.Core.Class+-- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010+-- License     : MIT (see LICENSE)+-- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>+-- 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)
+ src/Network/MPD/Core/Error.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE DeriveDataTypeable #-}++{- |+Module      : Network.MPD.Core.Error+Copyright   : (c) Joachim Fasting 2012+License     : MIT++Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>+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
+ src/Network/MPD/Util.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Module    : Network.MPD.Util+-- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010+-- License     : MIT (see LICENSE)+-- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>+-- 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)+import           System.Locale (defaultTimeLocale)++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
tests/Arbitrary.hs view
@@ -29,8 +29,8 @@   arbitrary = UTF8.fromString <$> arbitrary  -- No longer provided by QuickCheck 2-two :: Monad m => m a -> m (a, a)-two m = liftM2 (,) m m+-- 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
tests/CommandSpec.hs view
@@ -12,30 +12,26 @@ module CommandSpec (main, spec) where  import           Arbitrary ()-import           Defaults () import           StringConn import           TestUtil import           Unparse -import           Test.Hspec.Monadic-import           Test.Hspec.HUnit ()-+import           Network.MPD.Core import           Network.MPD.Commands+import           Network.MPD.Commands.Types import           Network.MPD.Commands.Extensions-import           Network.MPD.Core (MPDError(..), ACKType(..))  import           Prelude hiding (repeat)-import           Data.Default (Default(def))  main :: IO ()-main = hspecX spec+main = hspec spec -spec :: Specs+spec :: Spec spec = do     -- * Admin commands     describe "enableOutput" $ do         it "sends an enableoutput command" $ testEnableOutput-    +     describe "disableOutput" $ do         it "sends an disableoutput command" $ testDisableOutput @@ -43,15 +39,30 @@         it "lists available outputs" $ testOutputs      describe "update" $ do-        it "updates entire collection by default" $ testUpdate0-        it "can update single paths" $ testUpdate1-        it "can update multiple paths" $ testUpdateMany+        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@@ -66,28 +77,17 @@         it "returns a count of items matching a query" $ testCount      -- * Playlist commands--    describe "add" $ do-        it "adds a url to the current playlist" $ testAdd--    describe "add_" $ do-        it "adds a url to current playlist, returning nothing" $ testAdd_-     describe "playlistAdd" $ do         it "adds a url to a stored playlist" $ testPlaylistAdd -    describe "addId" $ do-        it "adds a url to a stored playlist, returning the pl index" $ testAddId-     describe "playlistClear" $ do         it "clears a stored playlist" $ testPlaylistClear -    describe "clear" $ do-        it "clears current play list" $ testClear-     describe "plChangesPosid" $ do         it "does something ..." $ testPlChangesPosId+{- XXX: doesn't work         it "fails on weird input" $ testPlChangesPosIdWeird+-}      -- XXX: this is ill-defined     {-@@ -160,11 +160,6 @@         it "gets database stats" $ testStats      -- * Extensions-    -    describe "updateId" $ do-        it "returns the job id" $ do-            testUpdateId0-            testUpdateId1     describe "toggle" $ do         it "starts playback if paused" $ testTogglePlay         it "stops playback if playing" $ testToggleStop@@ -173,10 +168,14 @@         it "can also add to stored playlists" $ testAddMany1     describe "volume" $ do         it "adjusts volume relative to current volume" $ testVolume-    -cmd_ expect f     = cmd expect (Right ()) f -cmd expect resp f = testMPD expect resp "" f `shouldBe` Ok ++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 --@@ -191,18 +190,13 @@         resp = concatMap unparse [obj1, obj2] ++ "OK"     cmd [("outputs", Right resp)] (Right [obj1, obj2]) outputs -testUpdate0 = cmd_ [("update", Right "updating_db: 1\nOK")] (update [])-testUpdate1 =-    cmd_ [("update \"foo\"", Right "updating_db: 1\nOK")] (update ["foo"]) -testUpdateMany =-    cmd_ [("command_list_begin\nupdate \"foo\"\nupdate \"bar\"\ncommand_list_end", Right "updating_db: 1\nOK")]-         (update ["foo","bar"])  -- -- 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"])@@ -211,6 +205,7 @@ testListQuery = cmd [("list Title Artist \"Muzz\"", Right "Title: Foo\nOK")]                     (Right ["Foo"])                     (list Title (Artist =? "Muzz"))+-}  testListAll =     cmd [("listall \"\"", Right "directory: FooBand\n\@@ -243,41 +238,25 @@ -- -- Playlist commands ----testAdd =-    cmd [("add \"foo\"", Right "OK"),-         ("listall \"foo\"", Right "file: Foo\nfile: Bar\nOK")]-        (Right ["Foo", "Bar"])-        (add "foo")--testAdd_ =-    cmd_ [("add \"foo\"", Right "OK")] (add_ "foo")- testPlaylistAdd =     cmd_ [("playlistadd \"foo\" \"bar\"", Right "OK")]-         (playlistAdd_ "foo" "bar")--testAddId =-    cmd [("addid \"dir/Foo-Bar.ogg\"", Right "Id: 20\nOK")]-        (Right $ Id 20)-        (addId "dir/Foo-Bar.ogg" Nothing)+         (playlistAdd "foo" "bar")  testPlaylistClear =     cmd_ [("playlistclear \"foo\"", Right "OK")]          (playlistClear "foo") -testClear =-    cmd_ [("clear", Right "OK")] clear- 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 {-@@ -293,7 +272,7 @@ testLoad =     cmd_ [("load \"foo\"", Right "OK")] (load "foo") -testMove2 = cmd_ [("playlistmove \"foo\" 1 2", Right "OK")] (playlistMove "foo" 1 2)+testMove2 = cmd_ [("playlistmove \"foo\" 23 2", Right "OK")] (playlistMove "foo" (Id 23) 2)  testRm = cmd_ [("rm \"foo\"", Right "OK")] (rm "foo") @@ -365,7 +344,7 @@ testPassword = cmd_ [("password foo", Right "OK")] (password "foo")  testPasswordSucceeds =-    testMPD convo expected_resp "foo" cmd_in `shouldBe` Ok+    testMPDWithPassword convo "foo" cmd_in `shouldBe` expected_resp     where         convo = [("lsinfo \"/\"", Right "ACK [4@0] {play} you don't have \                                         \permission for \"play\"")@@ -375,7 +354,7 @@         cmd_in = lsInfo "/"  testPasswordFails =-    testMPD convo expected_resp "foo" cmd_in `shouldBe` Ok+    testMPDWithPassword convo "foo" cmd_in `shouldBe` expected_resp     where         convo = [("play", Right "ACK [4@0] {play} you don't have \                                 \permission for \"play\"")@@ -397,14 +376,6 @@ -- Extensions\/shortcuts -- -testUpdateId0 = cmd [("update", Right "updating_db: 1")]-                (Right 1)-                (updateId [])--testUpdateId1 = cmd [("update \"foo\"", Right "updating_db: 1")]-                (Right 1)-                (updateId ["foo"])- testTogglePlay = cmd_                [("status", Right resp)                ,("pause 1", Right "OK")]@@ -432,4 +403,4 @@                (addMany "foo" ["bar"])  testVolume = cmd_ [("status", Right st), ("setvol 90", Right "OK")] (volume (-10))-    where st = unparse def { stVolume = 100 }+    where st = unparse def { stVolume = Just 100 }
− tests/Defaults.hs 
@@ -1,21 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Defaults where--import           Data.Default-import           Network.MPD.Commands.Types--instance Default Count where-    def = defaultCount--instance Default Device where-    def = defaultDevice---- XXX: note Song has no sensible default value--- XXX: or does it?--instance Default Stats where-    def = defaultStats--instance Default Status where-    def = defaultStatus
tests/EnvSpec.hs view
@@ -1,15 +1,14 @@ module EnvSpec (main, spec) where  import           TestUtil-import           Test.Hspec.Monadic  import           Network.MPD import           System.Posix.Env hiding (getEnvDefault)  main :: IO ()-main = hspecX spec+main = hspec spec -spec :: Specs+spec :: Spec spec = do   describe "getEnvDefault" $ do     it "returns the value of an environment variable" $ do
tests/Main.hs view
@@ -1,14 +1,1 @@-module Main (main) where--import qualified CommandSpec-import qualified EnvSpec-import qualified ParserSpec-import qualified UtilSpec-import           Test.Hspec.Monadic (describe, hspecX)--main :: IO ()-main = hspecX $ do-    describe "CommandSpec" CommandSpec.spec-    describe "EnvSpec" EnvSpec.spec-    describe "ParserSpec" ParserSpec.spec-    describe "UtilSpec" UtilSpec.spec+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
tests/ParserSpec.hs view
@@ -4,11 +4,9 @@ module ParserSpec (main, spec) where  import           Arbitrary ()-import           Defaults () import           Unparse -import           Test.Hspec.Monadic-import           Test.Hspec.HUnit ()+import           Test.Hspec import           Test.Hspec.QuickCheck (prop)  import           Network.MPD.Commands.Parse@@ -21,9 +19,9 @@ import           Data.Time  main :: IO ()-main = hspecX spec+main = hspec spec -spec :: Specs+spec :: Spec spec = do     describe "parseIso8601" $ do         prop "parses dates in ISO8601 format" prop_parseIso8601
tests/StringConn.hs view
@@ -3,7 +3,7 @@  -- | Module    : StringConn -- Copyright   : (c) Ben Sinclair 2005-2009--- License     : LGPL (see LICENSE)+-- License     : MIT (see LICENSE) -- Maintainer  : bsinclai@turing.une.edu.au -- Stability   : alpha --@@ -35,26 +35,14 @@     | BadRequest StringMPDError       deriving (Show, Eq) -newtype MatchError = MErr (Either StringMPDError MPDError)-instance Error MatchError where-    strMsg = MErr . Right . strMsg- newtype StringMPD a =-    SMPD { runSMPD :: ErrorT MatchError+    SMPD { runSMPD :: ErrorT MPDError                       (StateT [(Expect, Response String)]                        (ReaderT Password Identity)) a-         } deriving (Functor, Monad)--instance MonadError MPDError StringMPD where-    throwError = SMPD . throwError . MErr . Right-    catchError m f = SMPD $ catchError (runSMPD m) handler-        where-            handler err@(MErr (Left _)) = throwError err-            handler (MErr (Right err))  = runSMPD (f err)+         } deriving (Functor, Monad, MonadError MPDError)  instance MonadMPD StringMPD where     getVersion  = error "StringConn.getVersion: undefined"-    getHandle   = error "StringConn.getHandle: undefined"     setPassword = error "StringConn.setPassword: undefined"      open  = return ()@@ -64,33 +52,24 @@         SMPD $ do             ~pairs@((expected_request,response):rest) <- get             when (null pairs)-                 (throwError . MErr $ Left TooManyRequests)+                 (throwError $ Custom "too many requests")             when (expected_request /= request)-                 (throwError . MErr . Left-                             $ UnexpectedRequest expected_request request)+                 (throwError . Custom $ "unexpected request: " ++ show request ++ ", expected: " ++ show expected_request)             put rest-            either (throwError . MErr . Right) (return . B.lines . UTF8.fromString) response+            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.-testMPD :: (Eq a)+testMPDWithPassword :: (Eq a)         => [(Expect, Response String)] -- ^ The expected requests and their                                        -- ^ corresponding responses.-        -> Response a                  -- ^ The expected final result.         -> Password                    -- ^ A password to be supplied.         -> StringMPD a                 -- ^ The MPD action to run.-        -> Result a-testMPD pairs expected passwd m =-    let result = runIdentity-               $ runReaderT (evalStateT (runErrorT $ runSMPD m) pairs) passwd-    in case result of-           Right r-               | Right r == expected -> Ok-               | otherwise           -> BadResult expected (Right r)-           Left (MErr (Right r))-               | Left r == expected -> Ok-               | otherwise          -> BadResult expected (Left r)-           Left (MErr (Left e)) -> BadRequest e+        -> Response a+testMPDWithPassword pairs passwd m = runIdentity $ runReaderT (evalStateT (runErrorT $ runSMPD m) pairs) passwd
tests/TestUtil.hs view
@@ -1,7 +1,21 @@-module TestUtil (shouldBe) where+module TestUtil (+  with+, withPassword+, module StringConn+, module Test.Hspec+) where -import           Test.Hspec.HUnit ()-import           Test.HUnit+import           Network.MPD.Core+import           Network.MPD.Applicative -shouldBe :: (Eq a, Show a) => a -> a -> Assertion-shouldBe = (@?=)+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)
tests/Unparse.hs view
@@ -9,6 +9,10 @@ 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)@@ -54,22 +58,21 @@         [ "state: " ++ (case stState s of Playing -> "play"                                           Paused  -> "pause"                                           _       -> "stop")-        , "volume: " ++ show (stVolume s)+        , "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)-        , "time: " ++ (let (x, y) = stTime s in show x ++ ":" ++ show y)-        , "bitrate: " ++ show (stBitrate s)         , "xfade: " ++ show (stXFadeWidth s)-         , "audio: " ++ (let (x, y, z) = stAudio s in show x ++ ":" ++ show y ++                                        ":" ++ show z)-        , "updating_db: " ++ show (stUpdatingDb s)-        , "error: " ++ show (stError s)         , "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)
tests/UtilSpec.hs view
@@ -6,8 +6,6 @@ import           Arbitrary import           TestUtil -import           Test.Hspec.Monadic-import           Test.Hspec.HUnit () import           Test.Hspec.QuickCheck (prop) import           Test.QuickCheck @@ -19,9 +17,9 @@ import           Network.MPD.Util  main :: IO ()-main = hspecX spec+main = hspec spec -spec :: Specs+spec :: Spec spec = do     describe "splitGroups" $ do         it "breaks an association list into sublists" $ do