diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,8 @@ +* 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. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,510 @@ + + 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. + + + + Copyright (C) + + 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. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + + diff --git a/Network/MPD.hs b/Network/MPD.hs new file mode 100644 --- /dev/null +++ b/Network/MPD.hs @@ -0,0 +1,73 @@ +{- + libmpd for Haskell, an MPD client library. + Copyright (C) 2005-2007 Ben Sinclair + + 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 +-} + +-- | Module : Network.MPD +-- Copyright : (c) Ben Sinclair 2005-2007 +-- License : LGPL +-- Maintainer : bsinclai@turing.une.edu.au +-- Stability : alpha +-- Portability : Haskell 98 +-- +-- MPD client library. + +module Network.MPD ( + -- * Basic data types + MPD, MPDError(..), ACKType(..), Response, + module Network.MPD.Commands, + -- * Connections + withMPD, withMPDEx, + -- * Misc. + kill, throwMPD, catchMPD + ) where + +import Network.MPD.Commands +import Network.MPD.Prim + +import Control.Monad (liftM) +import Data.Maybe (listToMaybe) +import Data.IORef (newIORef, atomicModifyIORef) +import System.Environment (getEnv) +import System.IO +import System.IO.Error (isDoesNotExistError, ioError) + +-- | Run an MPD action using 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\" then the +-- password will be supplied as well. +withMPD :: MPD a -> IO (Response a) +withMPD m = do + port <- liftM read (getEnvDefault "MPD_PORT" "6600") + (pw,host) <- liftM (break (== '@')) (getEnvDefault "MPD_HOST" "localhost") + let (host',pw') = if null host then (pw,host) else (drop 1 host,pw) + pwGen <- mkPasswordGen [pw'] + withMPDEx host' port pwGen m + where + getEnvDefault x dflt = + catch (getEnv x) (\e -> if isDoesNotExistError e + then return dflt else ioError e) + +-- | Create an action that produces passwords for a connection. You +-- can pass these to 'withMPDEx' and it will use them to get passwords +-- to send to the server until one works or it runs out of them. +-- +-- > do gen <- mkPasswordGen ["password1", "password2"] +-- > withMPDEx "localhost" 6600 gen (update []) +mkPasswordGen :: [String] -> IO (IO (Maybe String)) +mkPasswordGen = liftM f . newIORef + where f = flip atomicModifyIORef $ \xs -> (drop 1 xs, listToMaybe xs) diff --git a/Network/MPD/Commands.hs b/Network/MPD/Commands.hs new file mode 100644 --- /dev/null +++ b/Network/MPD/Commands.hs @@ -0,0 +1,789 @@ +{- + libmpd for Haskell, an MPD client library. + Copyright (C) 2005-2007 Ben Sinclair + + 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 +-} + +-- | Module : Network.MPD.Commands +-- Copyright : (c) Ben Sinclair 2005-2007 +-- License : LGPL +-- Maintainer : bsinclai@turing.une.edu.au +-- Stability : alpha +-- Portability : Haskell 98 +-- +-- Interface to the user commands supported by MPD. + +module Network.MPD.Commands ( + -- * Command related data types + State(..), Status(..), Stats(..), + Device(..), + Query(..), Meta(..), + Artist, Album, Title, Seconds, PLIndex(..), + Song(..), Count(..), + + -- * Admin commands + disableoutput, enableoutput, outputs, update, + + -- * Database commands + find, list, listAll, listAllinfo, lsinfo, search, count, + + -- * Playlist commands + -- $playlist + add, add_, addid, clear, currentSong, delete, load, move, + playlistinfo, listplaylist, listplaylistinfo, playlist, plchanges, + plchangesposid, playlistfind, playlistsearch, rm, rename, save, shuffle, + swap, + + -- * Playback commands + crossfade, next, pause, play, previous, random, repeat, seek, setVolume, + volume, stop, + + -- * Miscellaneous commands + clearerror, close, commands, notcommands, tagtypes, urlhandlers, password, + ping, reconnect, stats, status, + + -- * Extensions\/shortcuts + addMany, deleteMany, crop, prune, lsdirs, lsfiles, lsplaylists, findArtist, + findAlbum, findTitle, listArtists, listAlbums, listAlbum, searchArtist, + searchAlbum, searchTitle, getPlaylist, toggle, updateid + ) where + +import Network.MPD.Prim + +import Control.Monad (liftM, unless) +import Prelude hiding (repeat) +import Data.List (findIndex) +import Data.Maybe + +-- +-- Data types +-- + +type Artist = String +type Album = String +type Title = String +type Seconds = Integer + +-- | Available metadata types\/scope modifiers, used for searching the +-- database for entries with certain metadata values. +data Meta = Artist | Album | Title | Track | Name | Genre | Date + | Composer | Performer | Disc | Any | Filename + +instance Show Meta where + show Artist = "Artist" + show Album = "Album" + show Title = "Title" + show Track = "Track" + show Name = "Name" + show Genre = "Genre" + show Date = "Date" + show Composer = "Composer" + show Performer = "Performer" + show Disc = "Disc" + show Any = "Any" + show Filename = "Filename" + +-- | A query is composed of a scope modifier and a query string. +data Query = Query Meta String -- ^ Simple query. + | MultiQuery [Query] -- ^ Query with multiple conditions. + +instance Show Query where + show (Query meta query) = show meta ++ " " ++ show query + show (MultiQuery xs) = show xs + showList xs _ = unwords $ map show xs + +-- | Represents a song's playlist index. +data PLIndex = Pos Integer -- ^ A playlist position index (starting from 0) + | ID Integer -- ^ A playlist ID number that more robustly + -- identifies a song. + deriving Show + +-- | Represents the different playback states. +data State = Playing + | Stopped + | Paused + deriving (Show, Eq) + +-- | 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 + , stPlaylistLength :: Integer + -- | Current song's position in the playlist. + , stSongPos :: Maybe PLIndex + -- | Current song's playlist ID. + , stSongID :: Maybe PLIndex + -- | Time elapsed\/total time. + , stTime :: (Seconds, Seconds) + -- | Bitrate (in kilobytes per second) of playing song (if any). + , stBitrate :: Int + -- | Crossfade time. + , stXFadeWidth :: Seconds + -- | 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 + -- | Last error message (if any). + , stError :: String } + deriving Show + +-- | 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 Show + +-- | Represents a single song item. +data Song = + Song { sgArtist, sgAlbum, sgTitle, sgFilePath, sgGenre, sgName, sgComposer + , sgPerformer :: String + , sgLength :: Seconds -- ^ Length in seconds + , sgDate :: Int -- ^ Year + , sgTrack :: (Int, Int) -- ^ Track number\/total tracks + , sgDisc :: (Int, Int) -- ^ Position in set\/total in set + , sgIndex :: Maybe PLIndex } + deriving Show + +-- Avoid the need for writing a proper 'elem' for use in 'prune'. +instance Eq Song where + (==) x y = sgFilePath x == sgFilePath y + +-- | 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 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 Show + +class Parsable a where + parse :: [String] -> a + +parseResponse :: (Parsable a) => String -> MPD a +parseResponse = liftM parse . getResponse + +instance Parsable () where + parse = const () + +instance Parsable [String] where + parse = takeValues + +-- +-- Admin commands +-- + +-- | Turn off an output device. +disableoutput :: Int -> MPD () +disableoutput = parseResponse . ("disableoutput " ++) . show + +-- | Turn on an output device. +enableoutput :: Int -> MPD () +enableoutput = getResponse_ . ("enableoutput " ++) . show + +-- | Retrieve information for all output devices. +outputs :: MPD [Device] +outputs = liftM (map takeDevInfo . splitGroups . kvise) + (getResponse "outputs") + where + takeDevInfo xs = Device { + dOutputID = takeNum "outputid" xs, + dOutputName = takeString "outputname" xs, + dOutputEnabled = takeBool "outputenabled" xs + } + +-- | Update the server's database. +update :: [String] -- ^ Optionally specify a list of paths + -> MPD () +update [] = getResponse_ "update" +update [x] = getResponse_ ("update " ++ show x) +update xs = getResponses (map (("update " ++) . show) xs) >> return () + +-- +-- Database commands +-- + +-- | List all metadata of metadata (sic). +list :: Meta -- ^ Metadata to list + -> Maybe Query -> MPD [String] +list mtype query = liftM takeValues (getResponse cmd) + where cmd = "list " ++ show mtype ++ maybe "" ((" "++) . show) query + +-- | Non-recursively list the contents of a database directory. +lsinfo :: Maybe String -- ^ Optionally specify a path. + -> MPD [Either String Song] +lsinfo path = do + (dirs,_,songs) <- liftM takeEntries + (getResponse ("lsinfo " ++ maybe "" show path)) + return (map Left dirs ++ map Right songs) + +-- | List the songs (without metadata) in a database directory recursively. +listAll :: Maybe String -> MPD [String] +listAll path = liftM (map snd . filter ((== "file") . fst) . kvise) + (getResponse ("listall " ++ maybe "" show path)) + +-- | Recursive 'lsinfo'. +listAllinfo :: Maybe String -- ^ Optionally specify a path + -> MPD [Either String Song] +listAllinfo path = do + (dirs,_,songs) <- liftM takeEntries + (getResponse ("listallinfo " ++ maybe "" show path)) + return (map Left dirs ++ map Right songs) + +-- | Search the database for entries exactly matching a query. +find :: Query -> MPD [Song] +find query = liftM takeSongs (getResponse ("find " ++ show query)) + +-- | Search the database using case insensitive matching. +search :: Query -> MPD [Song] +search query = liftM takeSongs (getResponse ("search " ++ show query)) + +-- | Count the number of entries matching a query. +count :: Query -> MPD Count +count query = liftM (takeCountInfo . kvise) + (getResponse ("count " ++ show query)) + where takeCountInfo xs = Count { cSongs = takeNum "songs" xs, + cPlaytime = takeNum "playtime" xs } + +-- +-- Playlist commands +-- +-- $playlist +-- Unless otherwise noted all playlist commands operate on the current +-- playlist. + +-- | Like 'add', but returns a playlist id. +addid :: String -> MPD Integer +addid x = + liftM (read . snd . head . kvise) (getResponse ("addid " ++ show x)) + +-- | Like 'add_' but returns a list of the files added. +add :: Maybe String -> String -> MPD [String] +add plname x = add_ plname x >> listAll (Just x) + +-- | Add a song (or a whole directory) to a playlist. +-- Adds to current if no playlist is specified. +-- Will create a new playlist if the one specified does not already exist. +add_ :: Maybe String -- ^ Optionally specify a playlist to operate on + -> String -> MPD () +add_ Nothing = getResponse_ . ("add " ++) . show +add_ (Just plname) = getResponse_ . + (("playlistadd " ++ show plname ++ " ") ++) . show + +-- | Clear a playlist. Clears current playlist if no playlist is specified. +-- If the specified playlist does not exist, it will be created. +clear :: Maybe String -- ^ Optional name of a playlist to clear. + -> MPD () +clear = getResponse_ . maybe "clear" (("playlistclear " ++) . show) + +-- | Remove a song from a playlist. +-- If no playlist is specified, current playlist is used. +-- Note that a playlist position ('Pos') is required when operating on +-- playlists other than the current. +delete :: Maybe String -- ^ Optionally specify a playlist to operate on + -> PLIndex -> MPD () +delete Nothing (Pos x) = getResponse_ ("delete " ++ show x) +delete Nothing (ID x) = getResponse_ ("deleteid " ++ show x) +delete (Just plname) (Pos x) = + getResponse_ ("playlistdelete " ++ show plname ++ " " ++ show x) +delete _ _ = fail "'delete' within a playlist doesn't accept a playlist ID" + +-- | Load an existing playlist. +load :: String -> MPD () +load = getResponse_ . ("load " ++) . show + +-- | Move a song to a given position. +-- Note that a playlist position ('Pos') is required when operating on +-- playlists other than the current. +move :: Maybe String -- ^ Optionally specify a playlist to operate on + -> PLIndex -> Integer -> MPD () +move Nothing (Pos from) to = + getResponse_ ("move " ++ show from ++ " " ++ show to) +move Nothing (ID from) to = + getResponse_ ("moveid " ++ show from ++ " " ++ show to) +move (Just plname) (Pos from) to = + getResponse_ ("playlistmove " ++ show plname ++ " " ++ show from ++ + " " ++ show to) +move _ _ _ = fail "'move' within a playlist doesn't accept a playlist ID" + +-- | Delete existing playlist. +rm :: String -> MPD () +rm = getResponse_ . ("rm " ++) . show + +-- | Rename an existing playlist. +rename :: String -- ^ Name of playlist to be renamed + -> String -- ^ New playlist name + -> MPD () +rename plname new = + getResponse_ ("rename " ++ show plname ++ " " ++ show new) + +-- | Save the current playlist. +save :: String -> MPD () +save = getResponse_ . ("save " ++) . show + +-- | Swap the positions of two songs. +-- Note that the positions must be of the same type, i.e. mixing 'Pos' and 'ID' +-- will result in a no-op. +swap :: PLIndex -> PLIndex -> MPD () +swap (Pos x) (Pos y) = getResponse_ ("swap " ++ show x ++ " " ++ show y) +swap (ID x) (ID y) = getResponse_ ("swapid " ++ show x ++ " " ++ show y) +swap _ _ = fail "'swap' cannot mix position and ID arguments" + +-- | Shuffle the playlist. +shuffle :: MPD () +shuffle = getResponse_ "shuffle" + +-- | Retrieve metadata for songs in the current playlist. +playlistinfo :: Maybe PLIndex -- ^ Optional playlist index. + -> MPD [Song] +playlistinfo x = liftM takeSongs (getResponse cmd) + where cmd = case x of + Just (Pos x') -> "playlistinfo " ++ show x' + Just (ID x') -> "playlistid " ++ show x' + Nothing -> "playlistinfo" + +-- | Retrieve metadata for files in a given playlist. +listplaylistinfo :: String -> MPD [Song] +listplaylistinfo = liftM takeSongs . getResponse . + ("listplaylistinfo " ++) . show + +-- | Retrieve a list of files in a given playlist. +listplaylist :: String -> MPD [String] +listplaylist = liftM takeValues . getResponse . ("listplaylist " ++) . show + +-- | 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. +playlist :: MPD [(PLIndex, String)] +playlist = liftM (map f) (getResponse "playlist") + where f s = let (pos, name) = break (== ':') s + in (Pos $ read pos, drop 1 name) + +-- | Retrieve a list of changed songs currently in the playlist since +-- a given playlist version. +plchanges :: Integer -> MPD [Song] +plchanges = liftM takeSongs . getResponse . ("plchanges " ++) . show + +-- | Like 'plchanges' but only returns positions and ids. +plchangesposid :: Integer -> MPD [(PLIndex, PLIndex)] +plchangesposid plver = + liftM (map takePosid . splitGroups . kvise) (getResponse cmd) + where cmd = "plchangesposid " ++ show plver + takePosid xs = (Pos $ takeNum "cpos" xs, ID $ takeNum "Id" xs) + +-- | Search for songs in the current playlist with strict matching. +playlistfind :: Query -> MPD [Song] +playlistfind = liftM takeSongs . getResponse . ("playlistfind " ++) . show + +-- | Search case-insensitively with partial matches for songs in the +-- current playlist. +playlistsearch :: Query -> MPD [Song] +playlistsearch = liftM takeSongs . getResponse . ("playlistsearch " ++) . show + +-- | Get the currently playing song. +currentSong :: MPD (Maybe Song) +currentSong = do + currStatus <- status + if stState currStatus == Stopped + then return Nothing + else do ls <- liftM kvise (getResponse "currentsong") + return $ if null ls then Nothing + else Just (takeSongInfo ls) + +-- +-- Playback commands +-- + +-- | Set crossfading between songs. +crossfade :: Seconds -> MPD () +crossfade = getResponse_ . ("crossfade " ++) . show + +-- | Begin\/continue playing. +play :: Maybe PLIndex -> MPD () +play Nothing = getResponse_ "play" +play (Just (Pos x)) = getResponse_ ("play " ++ show x) +play (Just (ID x)) = getResponse_ ("playid " ++ show x) + +-- | Pause playing. +pause :: Bool -> MPD () +pause = getResponse_ . ("pause " ++) . showBool + +-- | Stop playing. +stop :: MPD () +stop = getResponse_ "stop" + +-- | Play the next song. +next :: MPD () +next = getResponse_ "next" + +-- | Play the previous song. +previous :: MPD () +previous = getResponse_ "previous" + +-- | Seek to some point in a song. +-- Seeks in current song if no position is given. +seek :: Maybe PLIndex -> Seconds -> MPD () +seek (Just (Pos x)) time = + getResponse_ ("seek " ++ show x ++ " " ++ show time) +seek (Just (ID x)) time = + getResponse_ ("seekid " ++ show x ++ " " ++ show time) +seek Nothing time = do + st <- status + unless (stState st == Stopped) (seek (stSongID st) time) + +-- | Set random playing. +random :: Bool -> MPD () +random = getResponse_ . ("random " ++) . showBool + +-- | Set repeating. +repeat :: Bool -> MPD () +repeat = getResponse_ . ("repeat " ++) . showBool + +-- | Set the volume. +setVolume :: Int -> MPD () +setVolume = getResponse_ . ("setvol " ++) . show + +-- | 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. +-- Note that this command is only included for completeness sake ; it's +-- deprecated and may disappear at any time. +volume :: Int -> MPD () +volume = getResponse_ . ("volume " ++) . show + +-- +-- Miscellaneous commands +-- + +-- | Clear the current error message in status. +clearerror :: MPD () +clearerror = getResponse_ "clearerror" + +-- | Retrieve a list of available commands. +commands :: MPD [String] +commands = liftM takeValues (getResponse "commands") + +-- | Retrieve a list of unavailable commands. +notcommands :: MPD [String] +notcommands = liftM takeValues (getResponse "notcommands") + +-- | Retrieve a list of available song metadata. +tagtypes :: MPD [String] +tagtypes = liftM takeValues (getResponse "tagtypes") + +-- | Retrieve a list of supported urlhandlers. +urlhandlers :: MPD [String] +urlhandlers = liftM takeValues (getResponse "urlhandlers") + +-- XXX should the password be quoted? +-- | Send password to server to authenticate session. +-- Password is sent as plain text. +password :: String -> MPD () +password = getResponse_ . ("password " ++) + +-- | Check that the server is still responding. +ping :: MPD () +ping = getResponse_ "ping" + +-- | Get server statistics. +stats :: MPD Stats +stats = liftM (parseStats . kvise) (getResponse "stats") + where parseStats xs = + Stats { stsArtists = takeNum "artists" xs, + stsAlbums = takeNum "albums" xs, + stsSongs = takeNum "songs" xs, + stsUptime = takeNum "uptime" xs, + stsPlaytime = takeNum "playtime" xs, + stsDbPlaytime = takeNum "db_playtime" xs, + stsDbUpdate = takeNum "db_update" xs } + +-- | Get the server's status. +status :: MPD Status +status = liftM (parseStatus . kvise) (getResponse "status") + where parseStatus xs = + Status { stState = maybe Stopped parseState $ lookup "state" xs, + stVolume = takeNum "volume" xs, + stRepeat = takeBool "repeat" xs, + stRandom = takeBool "random" xs, + stPlaylistVersion = takeNum "playlist" xs, + stPlaylistLength = takeNum "playlistlength" xs, + stXFadeWidth = takeNum "xfade" xs, + stSongPos = takeIndex Pos "song" xs, + stSongID = takeIndex ID "songid" xs, + stTime = maybe (0,0) parseTime $ lookup "time" xs, + stBitrate = takeNum "bitrate" xs, + stAudio = maybe (0,0,0) parseAudio $ lookup "audio" xs, + stUpdatingDb = takeNum "updating_db" xs, + stError = takeString "error" xs + } + parseState x = case x of "play" -> Playing + "pause" -> Paused + _ -> Stopped + parseTime x = let (y,_:z) = break (== ':') x in (read y, read z) + parseAudio x = + let (u,_:u') = break (== ':') x; (v,_:w) = break (== ':') u' in + (read u, read v, read w) + +-- +-- Extensions\/shortcuts. +-- + +-- | Like 'update', but returns the update job id. +updateid :: [String] -> MPD 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 :: MPD () +toggle = do + st <- status + 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 :: Maybe String -> [String] -> MPD () +addMany _ [] = return () +addMany plname [x] = add_ plname x +addMany plname xs = getResponses (map (cmd ++) xs) >> return () + where cmd = maybe ("add ") (\pl -> "playlistadd " ++ show pl ++ " ") plname + +-- | 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 :: Maybe String -> [PLIndex] -> MPD () +deleteMany _ [] = return () +deleteMany plname [x] = delete plname x +deleteMany (Just plname) xs = getResponses (map cmd xs) >> return () + where cmd (Pos x) = "playlistdelete " ++ show plname ++ " " ++ show x + cmd _ = "" +deleteMany Nothing xs = getResponses (map cmd xs) >> return () + where cmd (Pos x) = "delete " ++ show x + cmd (ID x) = "deleteid " ++ show x + +-- | Crop playlist. +-- The bounds are inclusive. +-- If 'Nothing' or 'ID' is passed the cropping will leave your playlist alone +-- on that side. +crop :: Maybe PLIndex -> Maybe PLIndex -> MPD () +crop x y = do + pl <- playlistinfo Nothing + let x' = case x of Just (Pos p) -> fromInteger p + Just (ID i) -> maybe 0 id (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 Nothing . mapMaybe sgIndex $ take x' pl ++ ys + where findByID i = findIndex ((==) i . (\(ID j) -> j) . fromJust . sgIndex) + +-- | Remove duplicate playlist entries. +prune :: MPD () +prune = findDuplicates >>= deleteMany Nothing + +-- Find duplicate playlist entries. +findDuplicates :: MPD [PLIndex] +findDuplicates = + liftM (map ((\(ID x) -> ID x) . fromJust . sgIndex) . flip dups ([],[])) $ + playlistinfo Nothing + where dups [] (_, dup) = dup + dups (x:xs) (ys, dup) + | x `elem` xs && x `notElem` ys = dups xs (ys, x:dup) + | otherwise = dups xs (x:ys, dup) + +-- | List directories non-recursively. +lsdirs :: Maybe String -- ^ optional path. + -> MPD [String] +lsdirs path = liftM ((\(x,_,_) -> x) . takeEntries) + (getResponse ("lsinfo " ++ maybe "" show path)) + +-- | List files non-recursively. +lsfiles :: Maybe String -- ^ optional path. + -> MPD [String] +lsfiles path = liftM (map sgFilePath . (\(_,_,x) -> x) . takeEntries) + (getResponse ("lsinfo " ++ maybe "" show path)) + +-- | List all playlists. +lsplaylists :: MPD [String] +lsplaylists = liftM ((\(_,x,_) -> x) . takeEntries) (getResponse "lsinfo") + +-- | Search the database for songs relating to an artist. +findArtist :: Artist -> MPD [Song] +findArtist = find . Query Artist + +-- | Search the database for songs relating to an album. +findAlbum :: Album -> MPD [Song] +findAlbum = find . Query Album + +-- | Search the database for songs relating to a song title. +findTitle :: Title -> MPD [Song] +findTitle = find . Query Title + +-- | List the artists in the database. +listArtists :: MPD [Artist] +listArtists = liftM takeValues (getResponse "list artist") + +-- | List the albums in the database, optionally matching a given +-- artist. +listAlbums :: Maybe Artist -> MPD [Album] +listAlbums artist = liftM takeValues (getResponse ("list album" ++ + maybe "" ((" artist " ++) . show) artist)) + +-- | List the songs in an album of some artist. +listAlbum :: Artist -> Album -> MPD [Song] +listAlbum artist album = find (MultiQuery [Query Artist artist + ,Query Album album]) + +-- | Search the database for songs relating to an artist using 'search'. +searchArtist :: Artist -> MPD [Song] +searchArtist = search . Query Artist + +-- | Search the database for songs relating to an album using 'search'. +searchAlbum :: Album -> MPD [Song] +searchAlbum = search . Query Album + +-- | Search the database for songs relating to a song title. +searchTitle :: Title -> MPD [Song] +searchTitle = search . Query Title + +-- | Retrieve the current playlist. +-- Equivalent to 'playlistinfo Nothing'. +getPlaylist :: MPD [Song] +getPlaylist = playlistinfo Nothing + +-- +-- Miscellaneous functions. +-- + +-- Run getResponse but discard the response. +getResponse_ :: String -> MPD () +getResponse_ x = getResponse x >> return () + +-- Get the lines of the daemon's response to a list of commands. +getResponses :: [String] -> MPD [String] +getResponses cmds = getResponse . + unlines $ "command_list_begin" : cmds ++ ["command_list_end"] + +-- Break up a list of strings into an assoc. list, separating at +-- the first ':'. +kvise :: [String] -> [(String, String)] +kvise = map f + where f x = let (k,v) = break (== ':') x in + (k,dropWhile (== ' ') $ drop 1 v) + +-- Takes an assoc. list with recurring keys, and groups each cycle of +-- keys with their values together. The first key of each cycle needs +-- to be present in every cycle for it to work, but the rest don't +-- affect anything. +-- +-- > splitGroups [(1,'a'),(2,'b'),(1,'c'),(2,'d')] == +-- > [[(1,'a'),(2,'b')],[(1,'c'),(2,'d')]] +splitGroups :: Eq a => [(a, b)] -> [[(a, b)]] +splitGroups [] = [] +splitGroups (x:xs) = ((x:us):splitGroups vs) + where (us,vs) = break (\y -> fst x == fst y) xs + +-- Run 'kvise' and return only the values. +takeValues :: [String] -> [String] +takeValues = snd . unzip . kvise + +-- Separate the result of an lsinfo\/listallinfo call into directories, +-- playlists, and songs. +takeEntries :: [String] -> ([String], [String], [Song]) +takeEntries s = + (dirs, playlists, map takeSongInfo . splitGroups $ reverse filedata) + where (dirs, playlists, filedata) = foldl split ([], [], []) $ kvise s + split (ds, pls, ss) x@(k, v) | k == "directory" = (v:ds, pls, ss) + | k == "playlist" = (ds, v:pls, ss) + | otherwise = (ds, pls, x:ss) + +-- Build a list of song instances from a response. +takeSongs :: [String] -> [Song] +takeSongs = map takeSongInfo . splitGroups . kvise + +-- Builds a song instance from an assoc. list. +takeSongInfo :: [(String,String)] -> Song +takeSongInfo xs = + Song { + sgArtist = takeString "Artist" xs, + sgAlbum = takeString "Album" xs, + sgTitle = takeString "Title" xs, + sgGenre = takeString "Genre" xs, + sgName = takeString "Name" xs, + sgComposer = takeString "Composer" xs, + sgPerformer = takeString "Performer" xs, + sgDate = takeNum "Date" xs, + sgTrack = maybe (0, 0) parseTrack $ lookup "Track" xs, + sgDisc = maybe (0, 0) parseTrack $ lookup "Disc" xs, + sgFilePath = takeString "file" xs, + sgLength = takeNum "Time" xs, + sgIndex = takeIndex ID "Id" xs + } + where parseTrack x = let (trck, tot) = break (== '/') x + in (read trck, parseNum (drop 1 tot)) + +-- Helpers for retrieving values from an assoc. list. +takeString :: String -> [(String, String)] -> String +takeString v = fromMaybe "" . lookup v + +takeIndex :: (Integer -> PLIndex) -> String -> [(String, String)] + -> Maybe PLIndex +takeIndex c v = maybe Nothing (Just . c . parseNum) . lookup v + +takeNum :: (Read a, Num a) => String -> [(String, String)] -> a +takeNum v = maybe 0 parseNum . lookup v + +takeBool :: String -> [(String, String)] -> Bool +takeBool v = maybe False parseBool . lookup v + +-- Parse a numeric value, returning 0 on failure. +parseNum :: (Read a, Num a) => String -> a +parseNum = fromMaybe 0 . maybeReads + where maybeReads s = do ; [(x, "")] <- return (reads s) ; return x + +-- Inverts 'parseBool'. +showBool :: Bool -> String +showBool x = if x then "1" else "0" + +-- Parse a boolean response value. +parseBool :: String -> Bool +parseBool = (== "1") . take 1 diff --git a/Network/MPD/Prim.hs b/Network/MPD/Prim.hs new file mode 100644 --- /dev/null +++ b/Network/MPD/Prim.hs @@ -0,0 +1,269 @@ +{- + libmpd for Haskell, an MPD client library. + Copyright (C) 2005-2007 Ben Sinclair + + 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 +-} + +-- | Module : Network.MPD.Prim +-- Copyright : (c) Ben Sinclair 2005-2007 +-- License : LGPL +-- Maintainer : bsinclai@turing.une.edu.au +-- Stability : alpha +-- Portability : Haskell 98 +-- +-- Core functionality. + +module Network.MPD.Prim ( + -- * Data types + MPD, MPDError(..), ACKType(..), Response, + + -- * Running an action + withMPDEx, + + -- * Errors + throwMPD, catchMPD, + + -- * Interacting + getResponse, close, reconnect, kill, + ) where + +import Control.Monad (liftM, unless) +import Control.Exception (finally) +import Control.Monad.Trans +import Prelude hiding (repeat) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.List (isPrefixOf) +import Data.Maybe +import Network +import System.IO +import System.IO.Error (isEOFError) + +-- +-- Data types. +-- + +-- | A connection to an MPD server. +-- don't export the field names. +data Connection = Conn { connHostName :: String + , connPortNum :: Integer + , connHandle :: IORef (Maybe Handle) + , connGetPass :: IO (Maybe String) + } + +-- | 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 + | Custom String -- ^ Used for misc. errors + | ACK ACKType String -- ^ ACK type and a message from the + -- server. + +instance Show MPDError where + show NoMPD = "Could not connect to MPD" + show TimedOut = "MPD connection timed out" + show (Custom s) = s + show (ACK _ s) = s + +-- | 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) + +-- | A response is either an ACK or some result. +type Response a = Either MPDError a + +-- Export the type name but not the constructor or the field. +-- +-- This is basically a state and an error monad combined. It's just +-- nice if we can have a few custom functions that fiddle with the +-- internals. +newtype MPD a = MPD { runMPD :: Connection -> IO (Response a) } + +instance Functor MPD where + fmap f m = MPD $ \conn -> either Left (Right . f) `liftM` runMPD m conn + +instance Monad MPD where + return a = MPD $ \_ -> return (Right a) + m >>= f = MPD $ \conn -> runMPD m conn >>= + either (return . Left) (flip runMPD conn . f) + fail err = MPD $ \_ -> return . Left $ Custom err + +instance MonadIO MPD where + liftIO m = MPD $ \_ -> liftM Right m + +-- | Throw an exception. +throwMPD :: MPDError -> MPD () +throwMPD e = MPD $ \_ -> return (Left e) + +-- | Catch an exception from an action. +catchMPD :: MPD a -> (MPDError -> MPD a) -> MPD a +catchMPD m h = MPD $ \conn -> + runMPD m conn >>= either (flip runMPD conn . h) (return . Right) + +-- +-- Basic connection functions +-- + +-- | Run an MPD action against a server. +withMPDEx :: String -- ^ Host name. + -> Integer -- ^ Port number. + -> IO (Maybe String) -- ^ An action that supplies passwords. + -> MPD a -- ^ The action to run. + -> IO (Response a) +withMPDEx host port getpw m = do + hRef <- newIORef Nothing + connect host port hRef + readIORef hRef >>= maybe (return $ Left NoMPD) + (\_ -> finally (runMPD m $ Conn host port hRef getpw) (closeIO hRef)) + +-- Connect to an MPD server. +connect :: String -> Integer -- host and port + -> IORef (Maybe Handle) -> IO () +connect host port hRef = + withSocketsDo $ do + closeIO hRef + handle <- safeConnectTo host port + writeIORef hRef handle + maybe (return ()) (\h -> checkConn h >>= flip unless (closeIO hRef)) + handle + +safeConnectTo :: String -> Integer -> IO (Maybe Handle) +safeConnectTo host port = + catch (liftM Just $ connectTo host (PortNumber $ fromInteger port)) + (const $ return Nothing) + +-- Check that an MPD daemon is at the other end of a connection. +checkConn :: Handle -> IO Bool +checkConn h = isPrefixOf "OK MPD" `liftM` hGetLine h + +-- Close a connection. +closeIO :: IORef (Maybe Handle) -> IO () +closeIO hRef = do + readIORef hRef >>= maybe (return ()) + (\h -> hPutStrLn h "close" >> hClose h) + writeIORef hRef Nothing + +-- | Refresh a connection. +reconnect :: MPD () +reconnect = MPD $ \(Conn host port hRef _) -> do + connect host port hRef + liftM (maybe (Left NoMPD) (const $ Right ())) (readIORef hRef) + +-- | Kill the server. Obviously, the connection is then invalid. +kill :: MPD () +kill = getResponse "kill" `catchMPD` cleanup >> return () + where cleanup TimedOut = MPD $ \conn -> do + readIORef (connHandle conn) >>= maybe (return ()) hClose + writeIORef (connHandle conn) Nothing + return (Right []) + cleanup x = throwMPD x >> return [] + +-- | Close an MPD connection. +close :: MPD () +close = MPD $ \conn -> closeIO (connHandle conn) >> return (Right ()) + +-- | Send a command to the MPD and return the result. +getResponse :: String -> MPD [String] +getResponse cmd = MPD $ \conn -> respRead (sendCmd conn) reader (givePW conn) + where sendCmd conn = + readIORef (connHandle conn) >>= + maybe (return $ Left NoMPD) + (\h -> hPutStrLn h cmd >> hFlush h >> return (Right h)) + reader h = getLineTO h >>= return . (either Left parseResponse) + givePW conn cont (ACK Auth _) = tryPassword conn cont + givePW _ _ ack = return (Left ack) + +-- Get a line of text, handling a timed-out connection. +getLineTO :: Handle -> IO (Response String) +getLineTO h = catch (liftM Right $ hGetLine h) + (\err -> if isEOFError err then return $ Left TimedOut + else ioError err) + +-- Send a password to MPD and run an action on success. +tryPassword :: Connection -> IO (Response a) -> IO (Response a) +tryPassword conn cont = + readIORef (connHandle conn) >>= maybe (return $ Left NoMPD) get + where + get h = connGetPass conn >>= + maybe (return . Left $ ACK Auth "Password required") (send h) + send h pw = do hPutStrLn h ("password " ++ pw) >> hFlush h + result <- hGetLine h + case result of "OK" -> cont + _ -> tryPassword conn cont + +-- XXX suggestions for names welcome. +-- +-- Run a setup action before a recurrent reader. If the reader returns +-- Nothing it has finished reading. If an error is returned a handler +-- is called with an action that, when invoked, will run the setup +-- action again and continue. +respRead :: IO (Either e a) -- setup + -> (a -> IO (Either e (Maybe b))) -- reader + -> (IO (Either e [b]) -> e -> IO (Either e [b])) -- handler + -> IO (Either e [b]) +respRead sup rdr onErr = start [] + where start acc = sup >>= either (return . Left) (\x -> readAll x acc) + readAll x acc = + rdr x >>= either (onErr (start acc)) + (maybe result (\y -> readAll x (y:acc))) + where result = return $ Right (reverse acc) + +-- Consume response and return a Response. +parseResponse :: String -> Response (Maybe String) +parseResponse s | isPrefixOf "ACK" s = Left $ parseAck s + | isPrefixOf "OK" s = Right Nothing + | otherwise = Right $ Just s + +parseAck :: String -> MPDError +parseAck s = ACK ack 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 :: String -> (String, String, String) +splitAck s = (code, cmd, msg) + where (code, notCode) = between (== '[') (== '@') s + (cmd, notCmd) = between (== '{') (== '}') notCode + msg = drop 1 . snd $ break (== ' ') notCmd + + -- take whatever is between 'f' and 'g'. + between f g xs = let (_, y) = break f xs + in break g (drop 1 y) diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,43 @@ + + libmpd-haskell : An MPD client library for Haskell + ------------------------------------------------------ + +Dependencies: + The Glasgow Haskell Compiler >= 6.4 http://haskell.org/ghc + Cabal > 1.0 http://haskell.org/cabal + network http://hackage.haskell.org/cgi-bin/hackage-scripts/package/network + mtl http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl + +Building: + $ chmod +x configure Setup.lhs + $ ./Setup.lhs configure --prefix=${HOME} + $ ./Setup.lhs build + $ ./Setup.lhs install --user + + This assumes you have Cabal installed. Cabal is installed by + default with newer GHCs. + +Use: + Import the MPD module and specify the mpd package (-package mpd) + when compiling, or add it to the `Build-Depends' list in your + `_.cabal' file. + +Limitations: + Most of the API is complete, but some parts, most notably parsing, are + not yet as good as they could be. + +Platforms: + libmpd-haskell has been confirmed to work on: + Linux/x86 + Seems to work on Windows XP as well, but there is no MPD support for + that platform. + +Latest Sources: + darcs get http://turing.une.edu.au/~bsinclai/code/libmpd-haskell + +License: + LGPL + +Authors: + Ben Sinclair + Joachim Fasting diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,5 @@ +#!/usr/bin/env runhaskell +> module Main where +> import Distribution.Simple +> main :: IO () +> main = defaultMain diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,4 @@ +TODO: + - improve parsing performance + - find a way to retrieve the name of the currently loaded + playlist (if any). should return "current" by default. diff --git a/libmpd.cabal b/libmpd.cabal new file mode 100644 --- /dev/null +++ b/libmpd.cabal @@ -0,0 +1,19 @@ +Name: libmpd +Version: 0.1.2 +License: LGPL +License-file: LICENSE +Copyright: Ben Sinclair 2005-2007 +Author: Ben Sinclair +Maintainer: bsinclai@turing.une.edu.au +Stability: alpha +Homepage: http://turing.une.edu.au/~bsinclai/code/libmpd-haskell.html +Synopsis: An MPD client library. +Description: A client library for MPD, the Music Player Daemon. +Category: Network, Sound +Tested-With: GHC == 6.5, GHC == 6.6.1, Hugs == 2006.9 +Build-Depends: base, network, mtl +Extra-Source-Files: TODO README ChangeLog +Exposed-Modules: Network.MPD +Other-Modules: Network.MPD.Prim, Network.MPD.Commands +ghc-options: -Wall -O2 +ghc-prof-options: -auto-all -prof