packages feed

midi (empty) → 0.0.4

raw patch · 14 files changed

+2443/−0 lines, 14 filesdep +QuickCheckdep +basedep +event-listsetup-changed

Dependencies added: QuickCheck, base, event-list, mtl, non-negative

Files

+ LICENSE view
@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, 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+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If 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 convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU 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+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state 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 program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program 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 General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ midi.cabal view
@@ -0,0 +1,39 @@+Name:             midi+Version:          0.0.4+License:          GPL+License-File:     LICENSE+Author:           Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>+Homepage:         http://darcs.haskell.org/midi/+Category:         Sound+Build-Type:       Simple+Build-Depends:    event-list==0.0.5, non-negative==0.0.1, base>=1.0, mtl, QuickCheck+-- From the Monad Template Library we only need the State monad.+-- If your compiler does not support functional dependencies,+-- it would be easy to replace that by mapAccumL+-- or wait for a divided MTL package which is on the way:+-- http://darcs.haskell.org/packages/mtl-split/Control/Monad/Trans/State.hs+Synopsis:         Handling of MIDI messages and files+Description:+   MIDI is the Musical Instrument Digital Interface.+   The package contains definition of MIDI messages,+   reading and writing MIDI files.+   It contains no sending and receiving of MIDI messages. Cf. alsa-midi package.+   For music composition with MIDI output, see Haskore.+GHC-Options:      -Wall+Tested-With:      GHC==6.4.1+Hs-Source-Dirs:   src+Exposed-Modules:+  Sound.MIDI.Event+  Sound.MIDI.File+  Sound.MIDI.File.Load+  Sound.MIDI.File.Save+  -- exports ByteString data type+  Sound.MIDI.General+  Sound.MIDI.IO+Other-Modules:+  Sound.MIDI.Bit+  Sound.MIDI.Parser+  Sound.MIDI.ParserState+  Sound.MIDI.String+  Sound.MIDI.Utility
+ src/Sound/MIDI/Bit.hs view
@@ -0,0 +1,99 @@+{- |+Bit manipulation.++Taken from Haskore.++Bit operations work with numbers on the level of ones and zeros.+These functions should be called something like \"pseudo-bit-operations\".+They do not reach into the ones and zeros,+but they do duplicate the effects using regular math.+Note that these bitops, though convenient,+are no more efficient than the high-level arithmetic that does the same thing.+(This is different than in other languages such as C.)+-}++module Sound.MIDI.Bit where++import Sound.MIDI.Utility (toMaybe, swap)+import Data.Word(Word8)+import qualified Data.List as List+import qualified Data.Bits as Bits++{- |+Shift bitwise to the left and right.+-}++shiftL, shiftR :: Bits.Bits a => Int -> a -> a+shiftL = flip Bits.shiftL+shiftR = flip Bits.shiftR++{- |+The call @toBase n x@ takes a given number x and "chops it up,"+returning its digits in base b.  Its output is in the form of a+big-endian list of ints.  divMod is used because it gives the correct+rounding for negative numbers.  Ex. toBytes 1000 -> toBase 256 1000 ->+(256*3) + 232 -> [ 3 , 232 ]+-}++toBase :: Integral a => a -> a -> [a]+toBase b =+   reverse . List.unfoldr (\n -> toMaybe (n>0) (swap (divMod n b)))++toBits, toOctal, toHex, toBytes :: Integral a => a -> [a]+toBytes = toBase 256+toHex   = toBase 16+toOctal = toBase 8+toBits  = toBase 2++{- |+Get only n of the least significant bytes of x.  If it takes less than+n digits to express x, then fill the extra digits with zeros.+-}++someBytes :: Integral a => Int -> a -> [Word8]+someBytes n =+   reverse . take n . map fromIntegral .+   List.unfoldr (Just . swap . flip divMod (2^(8::Int)))++{- |+The fromBase function converts a list of digits in another base into a+single base-10 number.++fromBase b [x,y,z] = x*b^2 + y*b^1 + z*b^0+-}++fromBase :: Integral a => a -> [a] -> a+fromBase base xs = foldl (\a x -> base*a+x) 0 xs++fromBits, fromOctal, fromHex, fromBytes :: Integral a => [a] -> a+fromBytes = fromBase 256+fromHex   = fromBase 16+fromOctal = fromBase 8+fromBits  = fromBase 2+++{- |+Like 'replicate' but for big numbers.+It chops the list into blocks of tractable sizes (e.g. @maxBound::Int@).+-}+replicateBig :: Integer -> Integer -> a -> [a]+replicateBig base x c =+   let loopSizes = map fromInteger (toBase base x)+       b = fromInteger base+   in  foldl (\cs n -> concat (replicate b cs) ++ replicate n c) [] loopSizes++++{- |+@trunc b n@ takes the b least significant bits of n.+-}++trunc :: Integral a => Int -> a -> a+trunc b n = n `mod` (2^b)++{- |+@splitAt b n@ splits a number into a tuple: (before bit b, after bit b).+-}++splitAt :: Integral a => Int -> a -> (a, a)+splitAt b n = n `divMod` (2^b)
+ src/Sound/MIDI/Event.hs view
@@ -0,0 +1,320 @@+{- |+Datatype for MIDI events as they can be sent to a synthesizer.+That is, no timing is handled here.++Taken from Haskore.+-}++module Sound.MIDI.Event(+   T(..),+   Pitch, Program,+   Channel, Controller(..), ControllerValue, PitchBendRange, Pressure, Velocity,+   isNote, isNoteOn, isNoteOff, zeroKey,+   maximumVelocity, normalVelocity, toFloatVelocity,+   toFloatController,++   bankSelect, modulation, breathControl, footControl, portamentoTime,+   dataEntry, mainVolume, balance, panorama, expression,+   generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4,+   vectorX, vectorY,++   fromPitch,     toPitch,+   fromVelocity,  toVelocity,+   fromProgram,   toProgram,+   fromChannel,   toChannel,+   increasePitch, subtractPitch,+  ) where++++{- * MIDI Events -}++newtype Pitch       = Pitch    {fromPitch    :: Int} deriving (Show, Eq, Ord)+newtype Velocity    = Velocity {fromVelocity :: Int} deriving (Show, Eq, Ord)+newtype Program     = Program  {fromProgram  :: Int} deriving (Show, Eq, Ord)+newtype Channel     = Channel  {fromChannel  :: Int} deriving (Show, Eq, Ord)++toPitch :: Int -> Pitch+toPitch = checkRange "Pitch" Pitch++toVelocity :: Int -> Velocity+toVelocity = checkRange "Velocity" Velocity++toProgram :: Int -> Program+toProgram = checkRange "Program" Program++toChannel :: Int -> Channel+toChannel = checkRange "Channel" Channel++checkRange :: (Bounded a, Ord a, Show a) =>+   String -> (Int -> a) -> Int -> a+checkRange typ f x =+   let y = f x+   in  if minBound <= y && y <= maxBound+         then y+         else error (typ ++ ": value " ++ show x ++ " outside range " +++                     show ((minBound, maxBound) `asTypeOf` (y,y)))++instance Enum Program where+   toEnum   = toProgram+   fromEnum = fromProgram++instance Enum Channel where+   toEnum   = toChannel+   fromEnum = fromChannel++instance Enum Pitch where+   toEnum   = toPitch+   fromEnum = fromPitch++-- typical methods of a type class for affine spaces+increasePitch :: Int -> Pitch -> Pitch+increasePitch d = toPitch . (d+) . fromPitch++subtractPitch :: Pitch -> Pitch -> Int+subtractPitch (Pitch p0) (Pitch p1) = p1-p0+++instance Bounded Pitch where+   minBound = Pitch   0+   maxBound = Pitch 127++instance Bounded Velocity where+   minBound = Velocity   0+   maxBound = Velocity 127++instance Bounded Program where+   minBound = Program   0+   maxBound = Program 127++instance Bounded Channel where+   minBound = Channel  0+   maxBound = Channel 15+++{- |+A MIDI problem is that one cannot uniquely map+a MIDI key to a frequency.+The frequency depends on the instrument.+I don't know if the deviations are defined for General MIDI.+If this applies one could add transposition information+to the use patch map.+For now I have chosen a value that leads to the right frequency+for some piano sound in my setup.+-}++zeroKey :: Pitch+zeroKey = toPitch 48++{- |+The velocity of an ordinary key stroke and+the maximum possible velocity.+-}++normalVelocity, maximumVelocity :: Num quant => quant+   -- Velocity+normalVelocity  =  64+maximumVelocity = 127++{- |+64 is given as default value by the MIDI specification+and thus we map it to 1.+-}+toFloatVelocity :: (Integral a, Fractional b) => a -> b+toFloatVelocity x = fromIntegral x / normalVelocity++maximumControllerValue :: Num quant => quant+maximumControllerValue = 127++toFloatController :: (Integral a, Fractional b) => a -> b+toFloatController x = fromIntegral x / maximumControllerValue++++type PitchBendRange  = Int+type Pressure        = Int+type ControllerValue = Int++data T =+     NoteOff       Pitch Velocity+   | NoteOn        Pitch Velocity+   | PolyAfter     Pitch Pressure+   | ProgramChange Program+   | Control       Controller ControllerValue+   | PitchBend     PitchBendRange+   | MonoAfter     Pressure+     deriving (Show, Eq, Ord)+++isNote :: T -> Bool+isNote (NoteOn  _ _) = True+isNote (NoteOff _ _) = True+isNote _             = False++isNoteOn :: T -> Bool+isNoteOn (NoteOn  _ _) = True+isNoteOn _             = False++isNoteOff :: T -> Bool+isNoteOff (NoteOff _ _) = True+isNoteOff _             = False+++{- |+Types of predefined MIDI controllers.+-}+data Controller =+     {-  00 00 -} BankSelectMSB+   | {-  01 01 -} ModulationMSB+   | {-  02 02 -} BreathControlMSB+   | {-  03 03 -} Controller03+   | {-  04 04 -} FootControlMSB+   | {-  05 05 -} PortamentoTimeMSB+   | {-  06 06 -} DataEntryMSB+   | {-  07 07 -} MainVolumeMSB+   | {-  08 08 -} BalanceMSB+   | {-  09 09 -} Controller09+   | {-  10 0A -} PanoramaMSB+   | {-  11 0B -} ExpressionMSB+   | {-  12 0C -} Controller0C+   | {-  13 0D -} Controller0D+   | {-  14 0E -} Controller0E+   | {-  15 0F -} Controller0F+   | {-  16 10 -} GeneralPurpose1MSB+   | {-  17 11 -} GeneralPurpose2MSB+   | {-  18 12 -} GeneralPurpose3MSB+   | {-  19 13 -} GeneralPurpose4MSB+   | {-  20 14 -} Controller14+   | {-  21 15 -} Controller15+   | {-  22 16 -} Controller16+   | {-  23 17 -} Controller17+   | {-  24 18 -} Controller18+   | {-  25 19 -} Controller19+   | {-  26 1A -} Controller1A+   | {-  27 1B -} Controller1B+   | {-  28 1C -} Controller1C+   | {-  29 1D -} Controller1D+   | {-  30 1E -} Controller1E+   | {-  31 1F -} Controller1F+   | {-  32 20 -} BankSelectLSB+   | {-  33 21 -} ModulationLSB+   | {-  34 22 -} BreathControlLSB+   | {-  35 23 -} Controller23+   | {-  36 24 -} FootControlLSB+   | {-  37 25 -} PortamentoTimeLSB+   | {-  38 26 -} DataEntryLSB+   | {-  39 27 -} MainVolumeLSB+   | {-  40 28 -} BalanceLSB+   | {-  41 29 -} Controller29+   | {-  42 2A -} PanoramaLSB+   | {-  43 2B -} ExpressionLSB+   | {-  44 2C -} Controller2C+   | {-  45 2D -} Controller2D+   | {-  46 2E -} Controller2E+   | {-  47 2F -} Controller2F+   | {-  48 30 -} GeneralPurpose1LSB+   | {-  49 31 -} GeneralPurpose2LSB+   | {-  50 32 -} GeneralPurpose3LSB+   | {-  51 33 -} GeneralPurpose4LSB+   | {-  52 34 -} Controller34+   | {-  53 35 -} Controller35+   | {-  54 36 -} Controller36+   | {-  55 37 -} Controller37+   | {-  56 38 -} Controller38+   | {-  57 39 -} Controller39+   | {-  58 3A -} Controller3A+   | {-  59 3B -} Controller3B+   | {-  60 3C -} Controller3C+   | {-  61 3D -} Controller3D+   | {-  62 3E -} Controller3E+   | {-  63 3F -} Controller3F+   {- Continuous 7 bit (switches: 0-3f=off, 40-7f=on) -}+   | {-  64 40 -} Sustain+   | {-  65 41 -} Porta+   | {-  66 42 -} Sustenuto+   | {-  67 43 -} SoftPedal+   | {-  68 44 -} Controller44+   | {-  69 45 -} Hold2+   | {-  70 46 -} Controller46+   | {-  71 47 -} Controller47+   | {-  72 48 -} Controller48+   | {-  73 49 -} Controller49+   | {-  74 4A -} Controller4A+   | {-  75 4B -} Controller4B+   | {-  76 4C -} Controller4C+   | {-  77 4D -} Controller4D+   | {-  78 4E -} Controller4E+   | {-  79 4F -} Controller4F+   | {-  80 50 -} GeneralPurpose5+   | {-  81 51 -} GeneralPurpose6+   | {-  82 52 -} GeneralPurpose7+   | {-  83 53 -} GeneralPurpose8+   | {-  84 54 -} Controller54+   | {-  85 55 -} Controller55+   | {-  86 56 -} Controller56+   | {-  87 57 -} Controller57+   | {-  88 58 -} Controller58+   | {-  89 59 -} Controller59+   | {-  90 5A -} Controller5A+   | {-  91 5B -} ExtDepth+   | {-  92 5C -} TremoloDepth+   | {-  93 5D -} ChorusDepth+   | {-  94 5E -} CelesteDepth+   | {-  95 5F -} PhaserDepth+   {- Parameters -}+   | {-  96 60 -} DataIncrement+   | {-  97 61 -} DataDecrement+   | {-  98 62 -} NonRegisteredParameterLSB+   | {-  99 63 -} NonRegisteredParameterMSB+   | {- 100 64 -} RegisteredParameterLSB+   | {- 101 65 -} RegisteredParameterMSB+   | {- 102 66 -} Controller66+   | {- 103 67 -} Controller67+   | {- 104 68 -} Controller68+   | {- 105 69 -} Controller69+   | {- 106 6A -} Controller6A+   | {- 107 6B -} Controller6B+   | {- 108 6C -} Controller6C+   | {- 109 6D -} Controller6D+   | {- 110 6E -} Controller6E+   | {- 111 6F -} Controller6F+   | {- 112 70 -} Controller70+   | {- 113 71 -} Controller71+   | {- 114 72 -} Controller72+   | {- 115 73 -} Controller73+   | {- 116 74 -} Controller74+   | {- 117 75 -} Controller75+   | {- 118 76 -} Controller76+   | {- 119 77 -} Controller77+   | {- 120 78 -} Controller78+   | {- 121 79 -} Controller79+   | {- 122 7A -} Controller7A+   | {- 123 7B -} Controller7B+   | {- 124 7C -} Controller7C+   | {- 125 7D -} Controller7D+   | {- 126 7E -} Controller7E+   | {- 127 7F -} Controller7F+       deriving (Show, Eq, Ord, Enum)++bankSelect, modulation, breathControl, footControl, portamentoTime,+   dataEntry, mainVolume, balance, panorama, expression,+   generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4,+   vectorX, vectorY :: Controller+bankSelect      = BankSelectMSB+modulation      = ModulationMSB+breathControl   = BreathControlMSB+footControl     = FootControlMSB+portamentoTime  = PortamentoTimeMSB+dataEntry       = DataEntryMSB+mainVolume      = MainVolumeMSB+balance         = BalanceMSB+panorama        = PanoramaMSB+expression      = ExpressionMSB+generalPurpose1 = GeneralPurpose1MSB+generalPurpose2 = GeneralPurpose2MSB+generalPurpose3 = GeneralPurpose3MSB+generalPurpose4 = GeneralPurpose4MSB++vectorX = generalPurpose1+vectorY = generalPurpose2+
+ src/Sound/MIDI/File.hs view
@@ -0,0 +1,243 @@+{- |+MIDI-File Datatype++Taken from Haskore.+-}++module Sound.MIDI.File(+   T(..), Division(..), Track, Type(..),+   SchedEvent, Event(..), ElapsedTime,+   Tempo, SMPTEHours, SMPTEMins, SMPTESecs, SMPTEFrames, SMPTEBits,+   MetaEvent(..),+   maybeMIDIEvent, maybeMetaEvent,+   Key(..), Mode(..),+   defltST, defltDurT, empty,++   showLines, changeVelocity, getTracks, resampleTime,+   showEvent, showTime,+   sortEvents, progChangeBeforeSetTempo,+  ) where++import qualified Sound.MIDI.Event as MIDIEvent+-- import Sound.MIDI.Event (T(NoteOn, NoteOff))+import qualified Data.EventList.Relative.TimeBody as EventList+import qualified Numeric.NonNegative.Wrapper as NonNeg++import Sound.MIDI.IO(ByteString)+import Sound.MIDI.String (rightS, concatS)+import Data.Ix(Ix)+import Data.List(groupBy, sort)+import Data.Maybe(fromMaybe)++{- |+The datatypes for MIDI Files and MIDI Events+-}++data T = Cons Type Division [Track] deriving (Show, Eq)++data Type     = Mixed | Parallel | Serial+     deriving (Show,Eq,Enum)+data Division = Ticks Tempo | SMPTE Int Int+     deriving (Show,Eq)++type Track       = EventList.T ElapsedTime Event+type SchedEvent  = (ElapsedTime, Event)+type ElapsedTime = NonNeg.Integer++data Event =+     MIDIEvent MIDIEvent.Channel MIDIEvent.T+   | MetaEvent MetaEvent+   | SysExStart ByteString         -- F0+   | SysExCont  ByteString         -- F7+     deriving (Show,Eq,Ord)+++maybeMIDIEvent :: Event -> Maybe (MIDIEvent.Channel, MIDIEvent.T)+maybeMIDIEvent (MIDIEvent ch ev) = Just (ch,ev)+maybeMIDIEvent _ = Nothing++maybeMetaEvent :: Event -> Maybe MetaEvent+maybeMetaEvent (MetaEvent mev) = Just mev+maybeMetaEvent _ = Nothing+++{- * Meta Events -}++type Tempo       = NonNeg.Int+type SMPTEHours  = Int+type SMPTEMins   = Int+type SMPTESecs   = Int+type SMPTEFrames = Int+type SMPTEBits   = Int++data MetaEvent =+     SequenceNum Int+   | TextEvent String+   | Copyright String+   | TrackName String+   | InstrName String+   | Lyric String+   | Marker String+   | CuePoint String+   | MIDIPrefix MIDIEvent.Channel+   | EndOfTrack+   | SetTempo Tempo+   | SMPTEOffset SMPTEHours SMPTEMins SMPTESecs SMPTEFrames SMPTEBits+   | TimeSig Int Int Int Int+   | KeySig Key Mode+   | SequencerSpecific ByteString+   | Unknown Int ByteString+     deriving (Show, Eq, Ord)++{- |+The following enumerated type lists all the keys in order of their key+signatures from flats to sharps.+(@Cf@ = 7 flats, @Gf@ = 6 flats ... @F@ = 1 flat, @C@ = 0 flats\/sharps,+@G@ = 1 sharp, ... @Cs@ = 7 sharps.)+Useful for transposition.+-}++data Key = KeyCf | KeyGf | KeyDf | KeyAf | KeyEf | KeyBf | KeyF+         | KeyC  | KeyG  | KeyD  | KeyA  | KeyE  | KeyB  | KeyFs | KeyCs+             deriving (Show, Eq, Ord, Ix, Enum)++{- |+The Key Signature specifies a mode, either major or minor.+-}++data Mode = Major | Minor+            deriving (Show, Eq, Ord, Enum)++{- |+Default duration of a whole note, in seconds; and the default SetTempo+value, in microseconds per quarter note.  Both express the default of+120 beats per minute.+-}++defltDurT :: ElapsedTime+defltDurT = 2+defltST :: Tempo+defltST = div 1000000 (fromIntegral defltDurT)++{- |+An empty MIDI file.+-}++empty :: T+empty = Cons Mixed (Ticks 0) [EventList.empty]+++{- * Debugging -}++{- |+Show the 'T' with one event per line,+suited for comparing MIDIFiles with @diff@.+Can this be replaced by 'Sound.MIDI.Load.showFile'?+-}+showLines :: T -> String+showLines (Cons mfType division tracks) =+   let showTrack track =+          unlines+             ("    (" :+              map+                 (\event -> "      " ++ show event ++ " :")+                 (EventList.toPairList track) +++              "    []) :" :+              [])+   in  "MIDIFile.Cons " ++ show mfType ++ " (" ++ show division ++ ") (\n" +++       concatMap showTrack tracks +++       "  [])"++showTime :: ElapsedTime -> ShowS+showTime t =+   rightS 10 (shows t) . showString " : "++showEvent :: Event -> ShowS+showEvent (MIDIEvent ch e) =+   showString "MIDIEvent " . shows ch . showString " " . shows e+showEvent (MetaEvent e) =+   showString "MetaEvent " . shows e+showEvent (SysExStart s) =+   showString "SysExStart " . concatS (map shows s)+showEvent (SysExCont s) =+   showString "SysExCont "  . concatS (map shows s)+++{- |+A hack that changes the velocities by a rational factor.+-}++changeVelocity :: Double -> T -> T+changeVelocity r (Cons mfType division tracks) =+   let multVel vel = MIDIEvent.toVelocity $+          round (r * fromIntegral (MIDIEvent.fromVelocity vel))+       procMIDIEvent (MIDIEvent.NoteOn  pitch vel) = MIDIEvent.NoteOn  pitch (multVel vel)+       procMIDIEvent (MIDIEvent.NoteOff pitch vel) = MIDIEvent.NoteOff pitch (multVel vel)+       procMIDIEvent me = me+       procEvent (MIDIEvent chan ev) = MIDIEvent chan (procMIDIEvent ev)+       procEvent ev = ev+   in  Cons mfType division (map (EventList.mapBody procEvent) tracks)++{- |+Change the time base.+-}++resampleTime :: Double -> T -> T+resampleTime r (Cons mfType division tracks) =+   let divTime  time = round (fromIntegral time / r)+       newTempo tmp  = round (fromIntegral tmp  * r)+       procEvent ev =+          case ev of+             MetaEvent (SetTempo tmp) ->+                MetaEvent (SetTempo (newTempo tmp))+             _ -> ev+   in  Cons mfType division+          (map (EventList.mapBody procEvent . EventList.mapTime divTime) tracks)++getTracks :: T -> [Track]+getTracks (Cons _ _ trks) = trks++{- |+Sort MIDI note events lexicographically.+This is to make MIDI files unique+and robust against changes in the computation.+In principle Performance.merge should handle this+but due to rounding errors in Float+the order of note events still depends on some internal issues.+The sample rate of MIDI events should be coarse enough+to assert unique results.+-}++sortEvents :: T -> T+sortEvents (Cons mfType division tracks) =+   let coincideNote (MIDIEvent _ x0) (MIDIEvent _ x1) =+          MIDIEvent.isNote x0 && MIDIEvent.isNote x1+       coincideNote _ _ = False+       sortTrack =+          EventList.flatten . EventList.mapBody sort .+          EventList.mapCoincident (groupBy coincideNote)+   in  Cons mfType division (map sortTrack tracks)++{- |+Old versions of "Haskore.Interface.MIDI.Write"+wrote 'MIDIEvent.ProgramChange' and 'SetTempo'+once at the beginning of a file in that order.+The current version supports multiple 'MIDIEvent.ProgramChange's in a track and+thus a 'MIDIEvent.ProgramChange' is set immediately before a note.+Because of this a 'MIDIEvent.ProgramChange' is now always after a 'SetTempo'.+For checking equivalence with old MIDI files we can switch this back.+-}++progChangeBeforeSetTempo :: T -> T+progChangeBeforeSetTempo (Cons mfType division tracks) =+   let sortTrack evs =+          do ((t0,st@(MetaEvent (SetTempo _))), rest0)+                   <- EventList.viewL evs+             ((t1,pc@(MIDIEvent _ (MIDIEvent.ProgramChange _))), rest1)+                   <- EventList.viewL rest0+             return $+                EventList.cons t0 pc $+                EventList.cons 0  st $+                EventList.delay t1 rest1+   in  Cons mfType division+          (map (\track -> fromMaybe track (sortTrack track)) tracks)
+ src/Sound/MIDI/File/Load.hs view
@@ -0,0 +1,470 @@+{- |+Loading MIDI Files++This module loads and parses a MIDI File.+It can convert it into a 'MIDIFile.T' data type object or+simply print out the contents of the file.+-}++{-+The MIDI file format is quite similar to the Interchange File Format (IFF)+of Electronic Arts.+But it seems to be not sensible+to re-use functionality from the @iff@ package.+-}+module Sound.MIDI.File.Load (fromFile, fromStream, maybeFromStream, showFile)+ where++import           Sound.MIDI.File+import qualified Sound.MIDI.File as MIDIFile+import qualified Sound.MIDI.Event as MIDIEvent+import qualified Data.EventList.Relative.TimeBody as EventList+import qualified Numeric.NonNegative.Wrapper as NonNeg++import Sound.MIDI.IO (ByteString, readBinaryFile, stringCharFromByte)+import qualified Sound.MIDI.Bit as Bit+import Data.Bits (testBit, clearBit)+import Data.Word (Word8)+import Data.Maybe (mapMaybe, fromMaybe)+import           Sound.MIDI.String (unlinesS)+import qualified Sound.MIDI.Parser as Parser+import qualified Sound.MIDI.ParserState as ParserState+import qualified Control.Monad.State as State+import Control.Monad (replicateM, liftM, liftM2)+import Control.Monad.State (StateT(StateT, runStateT), evalStateT, lift)++{- |+The main load function.+-}+fromFile :: FilePath -> IO MIDIFile.T+fromFile = liftM fromStream . readBinaryFile++fromStream :: ByteString -> MIDIFile.T+fromStream contents =+   case maybeFromStream contents of+      Right (mf,[]) -> mf+      Right _       -> error "Garbage left over." -- return mf+      Left msg      -> error ("MIDI.Load.fromStream: " ++ msg)+      -- error "Error reading midi file: unfamiliar format or file corrupt."++maybeFromStream :: ByteString -> Either String (MIDIFile.T, ByteString)+maybeFromStream = evalParser parse++evalParser :: ByteParser a -> ByteString -> Either String (a, ByteString)+evalParser = runStateT+++{- |+A MIDI file is made of /chunks/, each of which is either a /header chunk/+or a /track chunk/.  To be correct, it must consist of one header chunk+followed by any number of track chunks, but for robustness's sake we ignore+any non-header chunks that come before a header chunk.  The header tells us+the number of tracks to come, which is passed to 'getTracks'.+-}+parse :: ByteParser MIDIFile.T+parse =+   getChunk >>= \ chunk ->+      case chunk of+         Header (format, nTracks, division) ->+            liftM+               (MIDIFile.Cons format division .+                map removeEndOfTrack .+                mapMaybe trackFromChunk)+               (replicateM (NonNeg.toNumber nTracks) getChunk)+         _ -> parse++{- |+Check if a chunk contains a track.+Like 'parse', if a chunk is not a track chunk, it is just ignored.+-}+trackFromChunk :: Chunk -> Maybe Track+trackFromChunk (Track t) = Just t+trackFromChunk  _        = Nothing++{- |+There are two ways to mark the end of the track:+The end of the event list and the meta event 'EndOfTrack'.+Thus the end marker is redundant and we remove a 'EndOfTrack'+at the end of the track+and complain about all 'EndOfTrack's within the event list.+-}+removeEndOfTrack :: Track -> Track+removeEndOfTrack xs =+   fromMaybe+      (error "Empty track, missing EndOfTrack")+      (do (initEvents, lastEvent) <- EventList.viewR xs+          let (eots, track) =+                 EventList.partition isEndOfTrack initEvents+          if EventList.null eots+            then return ()+            else error "EndOfTrack inside a track"+          if isEndOfTrack (snd lastEvent)+            then return ()+            else error "Track does not end with EndOfTrack"+          return track)++isEndOfTrack :: Event -> Bool+isEndOfTrack ev =+   case ev of+      MetaEvent EndOfTrack -> True+      _ -> False++{-+removeEndOfTrack :: Track -> Track+removeEndOfTrack =+   maybe+      (error "Track does not end with EndOfTrack")+      (\(ev,evs) ->+          case snd ev of+             MetaEvent EndOfTrack ->+                if EventList.null evs+                  then evs+                  else error "EndOfTrack inside a track"+             _ -> uncurry EventList.cons ev (removeEndOfTrack evs)) .+      EventList.viewL+-}++{- |+Parse a chunk, whether a header chunk, a track chunk, or otherwise.+A chunk consists of a four-byte type code+(a header is @MThd@; a track is @MTrk@),+four bytes for the size of the coming data,+and the data itself.+-}+getChunk :: ByteParser Chunk+getChunk =+   do+      (ty, body) <- getPlainChunk+      case ty of+        "MThd" ->+           return $ Header $+              case evalParser getHeader body of+                 Right (hd,[]) -> hd+                 Right (_,_)   -> error "header chunk too large"+                 Left msg      -> error ("getChunk header: " ++ msg)+        "MTrk" ->+           return $ Track $+           either (\msg -> error ("getChunk track: " ++ msg)) id $+           evalStateT (evalStateT getTrack initReadEvent) body+        _ -> return (AlienChunk ty body)++data Chunk =+     Header (MIDIFile.Type, NonNeg.Int, Division)+   | Track Track+   | AlienChunk String ByteString+  deriving Eq++{- |+Parse a Header Chunk.  A header consists of a format (0, 1, or 2),+the number of track chunks to come, and the smallest time division+to be used in reading the rest of the file.+-}+getHeader :: ByteParser (MIDIFile.Type, NonNeg.Int, Division)+getHeader =+   do+      format   <- liftM toEnum get2+      nTracks  <- liftM (NonNeg.fromNumberMsg "MIDI.Load.getHeader") get2+      division <- getDivision+      return (format, nTracks, division)++{- |+The division is implemented thus: the most significant bit is 0 if it's+in ticks per quarter note; 1 if it's an SMPTE value.+-}+getDivision :: ByteParser Division+getDivision =+   do+      x <- get1+      y <- get1+      return (if x < 128+                then Ticks (NonNeg.fromNumberMsg "MIDI.Load.getDivision" (x*256+y))+                else SMPTE (256-x) y)++{- |+A track is a series of events.  Parse a track, stopping when the size+is zero.+-}+getTrack :: TrackParser MIDIFile.Track+getTrack =+   liftM+      EventList.fromPairList+      (ParserState.zeroOrMore getSchedEvent)++{- |+Each event is preceded by the delta time: the time in ticks between the+last event and the current event.  Parse a time and an event, ignoring+System Exclusive messages.+-}+getSchedEvent :: TrackParser MIDIFile.SchedEvent+getSchedEvent  =  liftM2 (,) (lift getVar) getEvent++{- |+Parse an event.  Note that in the case of a regular MIDI Event, the tag is+the status, and we read the first byte of data before we call 'getMIDIEvent'.+In the case of a MIDIEvent with running status, we find out the status from+the parser (it's been nice enough to keep track of it for us), and the tag+that we've already gotten is the first byte of data.+-}+getEvent :: TrackParser MIDIFile.Event+getEvent =+   do+      tag <- lift get1+      case tag of+        240 -> liftM SysExStart $ lift (getBigN =<< getVar)+        247 -> liftM SysExCont  $ lift (getBigN =<< getVar)+        255 -> lift $+           do+              code <- get1+              size <- getVar+              liftM MetaEvent (getMetaEvent code size)+        x -> if x>127+               then let parseEv = decodeStatus tag+                    in  putEventParser parseEv >> lift (get1 >>= parseEvent parseEv)+               else -- running status+                    lift . flip parseEvent tag =<< getEventParser++{- |+Simpler version of 'getTrack', used in the Show functions.+-}+getPlainTrack :: TrackParser MIDIFile.Track+getPlainTrack =+   liftM+      EventList.fromPairList+      (ParserState.oneOrMore getSchedEvent)+++newtype EventParser =+   EventParser {parseEvent :: Int -> ByteParser MIDIFile.Event}++{- |+Find out the status (MIDIEvent type and channel) given a byte of data.+-}+decodeStatus :: Int -> EventParser+decodeStatus tag =+   let (code, channel) = Bit.splitAt 4 tag+   in  EventParser (getMIDIEvent code (MIDIEvent.toChannel channel))++{- |+Parse a MIDI Event.+Note that since getting the first byte is a little complex+(there are issues with running status),+it has already been handled for us by 'getEvent'.+-}+getMIDIEvent :: Int -> MIDIEvent.Channel -> Int -> ByteParser MIDIFile.Event+getMIDIEvent code channel firstData =+   let pitch  = MIDIEvent.toPitch firstData+       getVel = liftM MIDIEvent.toVelocity get1+       getME =+          case code of+            08 -> liftM (MIDIEvent.NoteOff   pitch) getVel+            09 -> liftM (MIDIEvent.NoteOn    pitch) getVel+            10 -> liftM (MIDIEvent.PolyAfter pitch) get1+            11 -> liftM (MIDIEvent.Control (toEnum firstData)) get1+            12 -> return (MIDIEvent.ProgramChange (MIDIEvent.toProgram firstData))+            13 -> return (MIDIEvent.MonoAfter  firstData)+            14 -> liftM (\msb -> MIDIEvent.PitchBend (firstData+128*msb)) get1+            _  -> fail ("invalid MIDIEvent code:" ++ show code)+   in  liftM (MIDIEvent channel) getME++{- |+Parse a MetaEvent.+-}+getMetaEvent :: Int -> NonNeg.Integer -> ByteParser MetaEvent+getMetaEvent code size =+   case code of+      000 -> liftM SequenceNum get2+      001 -> getText size TextEvent+      002 -> getText size Copyright+      003 -> getText size TrackName+      004 -> getText size InstrName+      005 -> getText size Lyric+      006 -> getText size Marker+      007 -> getText size CuePoint++      032 -> liftM (MIDIPrefix . MIDIEvent.toChannel) get1+      047 -> return EndOfTrack+      081 -> liftM (SetTempo . NonNeg.fromNumberMsg "MIDI.Load.getMetaEvent") get3++      084 -> do {hrs    <- get1 ; mins <- get1 ; secs <- get1;+                 frames <- get1 ; bits <- get1 ;+                 return (SMPTEOffset hrs mins secs frames bits)}++      088 -> do+                n <- get1+                d <- get1+                c <- get1+                b <- get1+                return (TimeSig n d c b)++      089 -> do+                sf <- get1+                mi <- get1+                return (KeySig (toKeyName sf) (toEnum mi))++      127 -> liftM SequencerSpecific (getBigN size)++      _   -> liftM (Unknown code) (getBigN size)++getText :: NonNeg.Integer -> (String -> MetaEvent) -> ByteParser MetaEvent+getText size c  =  liftM c (getString size)++toKeyName :: Int -> Key+toKeyName sf = toEnum (mod (sf+7) 15)++{- |+'getByte' gets a single byte from the input.+-}+getByte :: ByteParser Word8+getByte = StateT $ maybe (Left "reached end of file") Right . viewL++viewL :: [a] -> Maybe (a, [a])+viewL xs =+   case xs of+      []     -> Nothing+      (c:cs) -> Just (c,cs)++{- |+@getN n@ returns n characters (bytes) from the input.+-}+getN :: NonNeg.Int -> ByteParser ByteString+getN n = replicateM (NonNeg.toNumber n) getByte++getString :: NonNeg.Integer -> ByteParser String+getString n = liftM stringCharFromByte (getBigN n)++getBigN :: NonNeg.Integer -> ByteParser ByteString+getBigN n =+   sequence $+   Bit.replicateBig+      (succ (fromIntegral (maxBound :: NonNeg.Int)))+      (NonNeg.toNumber n)+      getByte+++{- |+'get1', 'get2', 'get3', and 'get4' take 1-, 2-, 3-, or+4-byte numbers from the input (respectively), convert the base-256 data+into a single number, and return.+-}+get1 :: ByteParser Int+get1 = liftM fromIntegral getByte++getNByteInt :: NonNeg.Int -> ByteParser Int+getNByteInt n =+   liftM Bit.fromBytes (replicateM (NonNeg.toNumber n) get1)++get2, get3, get4 :: ByteParser Int+get2 = getNByteInt 2+get3 = getNByteInt 3+get4 = getNByteInt 4++{- |+/Variable-length quantities/ are used often in MIDI notation.+They are represented in the following way:+Each byte (containing 8 bits) uses the 7 least significant bits to store information.+The most significant bit is used to signal whether or not more information is coming.+If it's @1@, another byte is coming.+If it's @0@, that byte is the last one.+'getVar' gets a variable-length quantity from the input.+-}+getVar :: ByteParser NonNeg.Integer+getVar =+   liftM (Bit.fromBase (2^(7::Int)) . map fromIntegral) getVarBytes++{- |+The returned list contains only bytes with the most significant bit cleared.+These are digits of a 128-ary number.+-}+getVarBytes :: ByteParser [Word8]+getVarBytes =+   do+      digit <- getByte+      if flip testBit 7 digit            -- if it's the last byte+        then liftM (flip clearBit 7 digit :) getVarBytes+        else return [digit]++{- |+Functions to show the decoded contents of a MIDI file in an easy-to-read format.+-}+showFile :: FilePath -> IO ()+showFile fileName = putStr . showChunks =<< readBinaryFile fileName++showChunks :: ByteString -> String+showChunks mf = showMR getChunks (unlinesS . map pp) mf ""+ where+  pp :: (String, ByteString) -> ShowS+  pp ("MThd",contents) =+    showString "Header: " .+    showMR getHeader shows contents+  pp ("MTrk",contents) =+    showString "Track:\n" .+    showMR (evalStateT getPlainTrack initReadEvent)+        (\track str ->+            EventList.foldr+               MIDIFile.showTime+               (\e -> MIDIFile.showEvent e . showString "\n")+               str track)+        contents+  pp (ty,contents) =+    showString "Chunk: " .+    showString ty .+    showString " " .+    shows contents .+    showString "\n"++showMR :: ByteParser a -> (a->ShowS) -> ByteString -> ShowS+showMR m pp contents =+  case evalParser m contents of+    Left msg ->+       showString "Parse failed: " . showString (msg++"\n") . shows contents+    Right (a,[]  ) -> pp a+    Right (a,junk) -> pp a . showString "Junk: " . shows junk+++{- |+These two functions, the 'getPlainChunk' and 'getChunks' parsers,+do not combine directly into a single master parser.+Rather, they should be used to chop parts of a midi file+up into chunks of bytes which can be outputted separately.++Chop a MIDI file into chunks returning:++* list of /chunk-type/-contents pairs; and+* leftover slop (should be empty in correctly formatted file)++-}+getChunks :: ByteParser [(String, ByteString)]+getChunks = Parser.zeroOrMore getPlainChunk++getPlainChunk :: ByteParser (String, ByteString)+getPlainChunk =+   liftM2 (,)+      (getString 4)  -- chunk type: header or track+      (getN . NonNeg.fromNumberMsg "getPlainChunk" =<< get4)+                  -- chunk body+++type ByteParser a = Parser.T ByteString a++{- |+The 'TrackParser' monad parses a track of a MIDI File.+In MIDI, a shortcut is used for long strings of similar MIDI events:+If a stream of consecutive events all have the same type and channel,+the type and channel can be omitted for all but the first event.+To implement this /feature/,+the parser must keep track of the type and channel of the most recent MIDI Event.+This is done by setting a 'EventParser' parser,+which parses the data bytes according to the currently active event type.+-}+type TrackParser a = ParserState.T EventParser ByteString a+++putEventParser  :: EventParser -> TrackParser ()+putEventParser = State.put++getEventParser :: TrackParser EventParser+getEventParser = State.get++initReadEvent :: EventParser+initReadEvent =+   EventParser (const (return (error "At beginning, no event type set so far")))
+ src/Sound/MIDI/File/Save.hs view
@@ -0,0 +1,209 @@+{- |+Save MIDI data to files.++The functions in this module allow 'Sound.MIDI.File.T's+to be made into Standard MIDI files (@*.mid@)+that can be read and played by music programs such as Cakewalk.+-}++module Sound.MIDI.File.Save (toFile, toStream, toOpenStream) where++import           Sound.MIDI.File+import qualified Sound.MIDI.File   as MIDIFile+import qualified Sound.MIDI.Event as MIDIEvent+import qualified Data.EventList.Relative.TimeBody as EventList+import qualified Numeric.NonNegative.Wrapper as NonNeg++import qualified Sound.MIDI.Bit as Bit+import Data.Bits ((.|.))+import Sound.MIDI.IO (ByteString, writeBinaryFile, stringByteFromChar)+import Control.Monad.Writer (Writer, tell, execWriter)+import Data.Ix (Ix, index)+import Data.List (genericLength)++{- |+The function 'toFile' is the main function+for writing 'MIDIFile.T' values to an actual file;+its first argument is the filename:+-}++toFile :: FilePath -> MIDIFile.T -> IO ()+toFile fn mf = writeBinaryFile fn (toStream mf)++{- |+MIDI files are first converted to a monadic string computation+using the function 'outMF',+and then \"executed\" using 'execWriter'.+-}++toStream, toOpenStream :: MIDIFile.T -> ByteString+toStream     = execWriter . outMF outChunk+toOpenStream = execWriter . outMF outOpenChunk++outMF :: OutChunk -> MIDIFile.T -> MIDIWriter ()+outMF outChk (MIDIFile.Cons mft divisn trks) =+  do+    outChunk "MThd" (do+                       outInt 2 (fromEnum mft) -- format (type 0, 1 or 2)+                       outInt 2 (length trks)  -- number of tracks to come+                       outputDivision divisn)  -- time unit+    mapM_ (outputTrack outChk) trks++outputDivision :: Division -> MIDIWriter ()+outputDivision (Ticks nticks) =+   outInt 2 (NonNeg.toNumber nticks)+outputDivision (SMPTE mode nticks) =+   do+      outInt 1 (256-mode)+      outInt 1 nticks++outputTrack :: OutChunk -> Track -> MIDIWriter ()+outputTrack outChk trk =+   outChk "MTrk" $+   EventList.mapM_ outVar outputEvent $+   EventList.snoc trk 0 (MetaEvent EndOfTrack)++{- |+The following functions encode various 'MIDIFile.T' elements+into the raw data of a standard MIDI file.+-}++outputEvent :: MIDIFile.Event -> MIDIWriter ()+outputEvent e =+   case e of+      MIDIEvent ch mevent -> outputMIDIEvent ch mevent+      MetaEvent mevent    -> outputMetaEvent mevent+      _                   -> error ("don't know, how to write a "++show e++".")++outputMIDIEvent :: MIDIEvent.Channel -> MIDIEvent.T -> MIDIWriter ()+outputMIDIEvent c e =+   let outC = outChan c+   in  case e of+          (MIDIEvent.NoteOff    p  v)  -> outC  8 [MIDIEvent.fromPitch p, MIDIEvent.fromVelocity v]+          (MIDIEvent.NoteOn     p  v)  -> outC  9 [MIDIEvent.fromPitch p, MIDIEvent.fromVelocity v]+          (MIDIEvent.PolyAfter  p  pr) -> outC 10 [MIDIEvent.fromPitch p, pr]+          (MIDIEvent.Control    cn cv) -> outC 11 [fromEnum cn, cv]+          (MIDIEvent.ProgramChange pn) -> outC 12 [MIDIEvent.fromProgram pn]+          (MIDIEvent.MonoAfter  pr)    -> outC 13 [pr]+          (MIDIEvent.PitchBend  pb)    ->+             let (hi,lo) = Bit.splitAt 7 pb in outC 14 [lo,hi] -- little-endian!!++-- output a channel event+outChan :: MIDIEvent.Channel -> Int -> [Int] -> MIDIWriter ()+outChan chan code bytes =+   do outInt 1 (16*code + MIDIEvent.fromChannel chan)+      mapM_ (outInt 1) bytes+++outMetaByteStr :: Int -> ByteString -> MIDIWriter ()+outMetaByteStr code bytes =+   do+      outInt 1 255+      outInt 1 code+      outVar (genericLength bytes)+      outByteStr bytes++outMetaStr :: Int -> String -> MIDIWriter ()+outMetaStr code =+   outMetaByteStr code . stringByteFromChar++outMetaList :: Int -> [Int] -> MIDIWriter ()+outMetaList code =+   outMetaByteStr code . map fromIntegral++-- As with outChunk, there are other ways to do this - but+-- it's not obvious which is best or if performance is a big issue.+outMetaMW :: Int -> MIDIWriter () -> MIDIWriter ()+outMetaMW code  =  outMetaByteStr code . execWriter++outputMetaEvent :: MetaEvent -> MIDIWriter ()+outputMetaEvent (SequenceNum num) = outMetaMW     0 (outInt 2 num)+outputMetaEvent (TextEvent s)     = outMetaStr    1 s+outputMetaEvent (Copyright s)     = outMetaStr    2 s+outputMetaEvent (TrackName s)     = outMetaStr    3 s+outputMetaEvent (InstrName s)     = outMetaStr    4 s+outputMetaEvent (Lyric s)         = outMetaStr    5 s+outputMetaEvent (Marker s)        = outMetaStr    6 s+outputMetaEvent (CuePoint s)      = outMetaStr    7 s+outputMetaEvent (MIDIPrefix c)    = outMetaList  32 [MIDIEvent.fromChannel c]+outputMetaEvent EndOfTrack        = outMetaList  47 []++outputMetaEvent (SetTempo tp)     = outMetaMW    81 (outInt 3 (NonNeg.toNumber tp))+outputMetaEvent (SMPTEOffset hr mn se fr ff)+                                  = outMetaList  84 [hr,mn,se,fr,ff]+outputMetaEvent (TimeSig n d c b) = outMetaList  88 [n,d,c,b]+outputMetaEvent (KeySig sf mi)    = outMetaList  89 [sf', fromEnum mi]+                                      where k = index (KeyCf,KeyCs) sf - 7+                                            sf' = if (k >= 0)+                                                  then k+                                                  else 255+k+outputMetaEvent (SequencerSpecific codes)+                                  = outMetaByteStr 127 codes+outputMetaEvent (Unknown typ s)   = outMetaByteStr typ s++{- |+The 'MIDIWriter' accumulates a String.+For all the usual reasons, the String is represented by ShowS.+-}++type MIDIWriter a = Writer ByteString a++outInt :: Int -> Int -> MIDIWriter ()+outInt a = outByteStr . map fromIntegral . Bit.someBytes a++outStr :: String -> MIDIWriter ()+outStr = outByteStr . stringByteFromChar++outByteStr :: ByteString -> MIDIWriter ()+outByteStr = tell++{- |+Numbers of variable size are represented by sequences of 7-bit blocks+tagged (in the top bit) with a bit indicating:+(1) that more data follows; or+(0) that this is the last block.+-}++outVar :: NonNeg.Integer -> MIDIWriter ()+outVar n =+   let bytes = map fromIntegral $ Bit.toBase 128 n+   in  case bytes of+          [] -> outInt 1 0+          (_:bs) ->+             let highBits = map (const 128) bs ++ [0]+             in  outByteStr (zipWith (.|.) highBits bytes)+++outTag :: String -> MIDIWriter ()+outTag tag@(_:_:_:_:[]) = outStr tag+outTag tag =+   error ("SaveMIDI.outChunk: Chunk name " ++ tag +++          " does not consist of 4 characters.")++{-+Note: here I've chosen to compute the track twice+rather than store it.  Other options are worth exploring.+-}++type OutChunk = String -> MIDIWriter () -> MIDIWriter ()++outChunk, outOpenChunk :: OutChunk++outChunk tag m =+   do+     outTag tag+     let str = execWriter m+     outInt 4 (length str)+     outByteStr str++{- |+The MIDI standard seems to require a fixed length for all chunks.+Chunks with unknown length are essential for infinite music+and music that is created on the fly.+-}++outOpenChunk tag m =+   do+     outTag tag+     outInt 4 (-1)+     m
+ src/Sound/MIDI/General.hs view
@@ -0,0 +1,239 @@+{- |+General-MIDI definitions.++Taken from Haskore.+-}++module Sound.MIDI.General where++import qualified Sound.MIDI.Event as MidiEvent+import           Data.Ix(Ix)+import qualified Data.List as List+import System.Random (Random(random,randomR), RandomGen)+++{- * Instrument definitions -}++instrumentNameToProgram :: String -> Maybe MidiEvent.Program+instrumentNameToProgram =+   fmap MidiEvent.toProgram . flip List.elemIndex instrumentNames++instrumentNames :: [String]+instrumentNames = map fst instrumentPrograms++instrumentPrograms :: [(String, MidiEvent.Program)]+instrumentPrograms =+   map (mapSnd MidiEvent.toProgram) [+      ("Acoustic Grand Piano",0),       ("Bright Acoustic Piano",1),+      ("Electric Grand Piano",2),       ("Honky Tonk Piano",3),+      ("Rhodes Piano",4),               ("Chorused Piano",5),+      ("Harpsichord",6),                ("Clavinet",7),+      ("Celesta",8),                    ("Glockenspiel",9),+      ("Music Box",10),                 ("Vibraphone",11),+      ("Marimba",12),                   ("Xylophone",13),+      ("Tubular Bells",14),             ("Dulcimer",15),+      ("Hammond Organ",16),             ("Percussive Organ",17),+      ("Rock Organ",18),                ("Church Organ",19),+      ("Reed Organ",20),                ("Accordion",21),+      ("Harmonica",22),                 ("Tango Accordion",23),+      ("Acoustic Guitar (nylon)",24),   ("Acoustic Guitar (steel)",25),+      ("Electric Guitar (jazz)",26),    ("Electric Guitar (clean)",27),+      ("Electric Guitar (muted)",28),   ("Overdriven Guitar",29),+      ("Distortion Guitar",30),         ("Guitar Harmonics",31),+      ("Acoustic Bass",32),             ("Electric Bass (fingered)",33),+      ("Electric Bass (picked)",34),    ("Fretless Bass",35),+      ("Slap Bass 1",36),               ("Slap Bass 2",37),+      ("Synth Bass 1",38),              ("Synth Bass 2",39),+      ("Violin",40),                    ("Viola",41),+      ("Cello",42),                     ("Contrabass",43),+      ("Tremolo Strings",44),           ("Pizzicato Strings",45),+      ("Orchestral Harp",46),           ("Timpani",47),+      ("String Ensemble 1",48),         ("String Ensemble 2",49),+      ("Synth Strings 1",50),           ("Synth Strings 2",51),+      ("Choir Aahs",52),                ("Voice Oohs",53),+      ("Synth Voice",54),               ("Orchestra Hit",55),+      ("Trumpet",56),                   ("Trombone",57),+      ("Tuba",58),                      ("Muted Trumpet",59),+      ("French Horn",60),               ("Brass Section",61),+      ("Synth Brass 1",62),             ("Synth Brass 2",63),+      ("Soprano Sax",64),               ("Alto Sax",65),+      ("Tenor Sax",66),                 ("Baritone Sax",67),+      ("Oboe",68),                      ("Bassoon",69),+      ("English Horn",70),              ("Clarinet",71),+      ("Piccolo",72),                   ("Flute",73),+      ("Recorder",74),                  ("Pan Flute",75),+      ("Blown Bottle",76),              ("Shakuhachi",77),+      ("Whistle",78),                   ("Ocarina",79),+      ("Lead 1 (square)",80),           ("Lead 2 (sawtooth)",81),+      ("Lead 3 (calliope)",82),         ("Lead 4 (chiff)",83),+      ("Lead 5 (charang)",84),          ("Lead 6 (voice)",85),+      ("Lead 7 (fifths)",86),           ("Lead 8 (bass+lead)",87),+      ("Pad 1 (new age)",88),           ("Pad 2 (warm)",89),+      ("Pad 3 (polysynth)",90),         ("Pad 4 (choir)",91),+      ("Pad 5 (bowed)",92),             ("Pad 6 (metallic)",93),+      ("Pad 7 (halo)",94),              ("Pad 8 (sweep)",95),+      ("FX1 (train)",96),               ("FX2 (soundtrack)",97),+      ("FX3 (crystal)",98),             ("FX4 (atmosphere)",99),+      ("FX5 (brightness)",100),         ("FX6 (goblins)",101),+      ("FX7 (echoes)",102),             ("FX8 (sci-fi)",103),+      ("Sitar",104),                    ("Banjo",105),+      ("Shamisen",106),                 ("Koto",107),+      ("Kalimba",108),                  ("Bagpipe",109),+      ("Fiddle",110),                   ("Shanai",111),+      ("Tinkle Bell",112),              ("Agogo",113),+      ("Steel Drums",114),              ("Woodblock",115),+      ("Taiko Drum",116),               ("Melodic Drum",117),+      ("Synth Drum",118),               ("Reverse Cymbal",119),+      ("Guitar Fret Noise",120),        ("Breath Noise",121),+      ("Seashore",122),                 ("Bird Tweet",123),+      ("Telephone Ring",124),           ("Helicopter",125),+      ("Applause",126),                 ("Gunshot",127)+   ]++instrumentFromProgram :: MidiEvent.Program -> Instrument+instrumentFromProgram = toEnum . MidiEvent.fromProgram++instrumentToProgram :: Instrument -> MidiEvent.Program+instrumentToProgram = MidiEvent.toProgram . fromEnum++instrumentChannels :: [MidiEvent.Channel]+instrumentChannels = map MidiEvent.toChannel $ [0..8] ++ [10..15]++instruments :: [Instrument]+instruments = enumFromTo minBound maxBound++data Instrument =+     AcousticGrandPiano              | BrightAcousticPiano+   | ElectricGrandPiano              | HonkyTonk+   | ElectricPiano1                  | ElectricPiano2+   | Harpsichord                     | Clavinet+   | Celesta                         | Glockenspiel+   | MusicBox                        | Vibraphone+   | Marimba                         | Xylophone+   | TubularBells                    | Dulcimer+   | DrawbarOrgan                    | PercussiveOrgan+   | RockOrgan                       | ChurchOrgan+   | ReedOrgan                       | Accordion+   | Harmonica                       | TangoAccordian+   | AcousticGuitarNylon             | AcousticGuitarSteel+   | ElectricGuitarJazz              | ElectricGuitarClean+   | ElectricGuitarMuted             | OverdrivenGuitar+   | DistortionGuitar                | GuitarHarmonics+   | AcousticBass                    | ElectricBassFinger+   | ElectricBassPick                | FretlessBass+   | SlapBass1                       | SlapBass2+   | SynthBass1                      | SynthBass2+   | Violin                          | Viola+   | Cello                           | Contrabass+   | TremoloStrings                  | PizzicatoStrings+   | OrchestralHarp                  | Timpani+   | StringEnsemble1                 | StringEnsemble2+   | SynthStrings1                   | SynthStrings2+   | ChoirAahs                       | VoiceOohs+   | SynthVoice                      | OrchestraHit+   | Trumpet                         | Trombone+   | Tuba                            | MutedTrumpet+   | FrenchHorn                      | BrassSection+   | SynthBrass1                     | SynthBrass2+   | SopranoSax                      | AltoSax+   | TenorSax                        | BaritoneSax+   | Oboe                            | EnglishHorn+   | Bassoon                         | Clarinet+   | Piccolo                         | Flute+   | Recorder                        | PanFlute+   | BlownBottle                     | Skakuhachi+   | Whistle                         | Ocarina+   | Lead1Square                     | Lead2Sawtooth+   | Lead3Calliope                   | Lead4Chiff+   | Lead5Charang                    | Lead6Voice+   | Lead7Fifths                     | Lead8BassLead+   | Pad1NewAge                      | Pad2Warm+   | Pad3Polysynth                   | Pad4Choir+   | Pad5Bowed                       | Pad6Metallic+   | Pad7Halo                        | Pad8Sweep+   | FX1Rain                         | FX2Soundtrack+   | FX3Crystal                      | FX4Atmosphere+   | FX5Brightness                   | FX6Goblins+   | FX7Echoes                       | FX8SciFi+   | Sitar                           | Banjo+   | Shamisen                        | Koto+   | Kalimba                         | Bagpipe+   | Fiddle                          | Shanai+   | TinkleBell                      | Agogo+   | SteelDrums                      | Woodblock+   | TaikoDrum                       | MelodicTom+   | SynthDrum                       | ReverseCymbal+   | GuitarFretNoise                 | BreathNoise+   | Seashore                        | BirdTweet+   | TelephoneRing                   | Helicopter+   | Applause                        | Gunshot+     deriving (Show, Eq, Ord, Ix, Enum, Bounded)++instance Random Instrument where+   random  = boundedEnumRandom+   randomR = enumRandomR++++{- * Drum definitions -}+++drumChannel :: MidiEvent.Channel+drumChannel = MidiEvent.toChannel 9++drumProgram :: MidiEvent.Program+drumProgram = MidiEvent.toProgram 0++drumMinKey :: MidiEvent.Pitch+drumMinKey = MidiEvent.toPitch 35++drumKeyTable :: [(Drum, MidiEvent.Pitch)]+drumKeyTable = zip drums [drumMinKey ..]++drumFromKey :: MidiEvent.Pitch -> Drum+drumFromKey = toEnum . MidiEvent.subtractPitch drumMinKey++drumToKey :: Drum -> MidiEvent.Pitch+drumToKey = flip MidiEvent.increasePitch drumMinKey . fromEnum++drums :: [Drum]+drums = enumFromTo minBound maxBound+++data Drum =+        AcousticBassDrum  -- Midi Key 35+      | BassDrum1         -- Midi Key 36+      | SideStick         -- ...+      | AcousticSnare | HandClap      | ElectricSnare | LowFloorTom+      | ClosedHiHat   | HighFloorTom  | PedalHiHat    | LowTom+      | OpenHiHat     | LowMidTom     | HiMidTom      | CrashCymbal1+      | HighTom       | RideCymbal1   | ChineseCymbal | RideBell+      | Tambourine    | SplashCymbal  | Cowbell       | CrashCymbal2+      | Vibraslap     | RideCymbal2   | HiBongo       | LowBongo+      | MuteHiConga   | OpenHiConga   | LowConga      | HighTimbale+      | LowTimbale    | HighAgogo     | LowAgogo      | Cabasa+      | Maracas       | ShortWhistle  | LongWhistle   | ShortGuiro+      | LongGuiro     | Claves        | HiWoodBlock   | LowWoodBlock+      | MuteCuica     | OpenCuica     | MuteTriangle+      | OpenTriangle      -- Midi Key 82+   deriving (Show, Eq, Ord, Ix, Enum, Bounded)++instance Random Drum where+   random  = boundedEnumRandom+   randomR = enumRandomR++-- http://oxygen.cside6.com/gallery/ins_gm.html+++enumRandomR :: (Enum a, RandomGen g) => (a,a) -> g -> (a,g)+enumRandomR (l,r) =+   mapFst toEnum . randomR (fromEnum l, fromEnum r)++boundedEnumRandom :: (Enum a, Bounded a, RandomGen g) => g -> (a,g)+boundedEnumRandom  =  enumRandomR (minBound, maxBound)++mapFst :: (a -> c) -> (a,b) -> (c,b)+mapFst f ~(x,y) = (f x, y)++mapSnd :: (b -> d) -> (a,b) -> (a,d)+mapSnd g ~(x,y) = (x, g y)
+ src/Sound/MIDI/IO.hs view
@@ -0,0 +1,37 @@+{- |+Taken from Haskore.+-}+module Sound.MIDI.IO+          (openBinaryFile, readBinaryFile, writeBinaryFile,+           ByteString, stringCharFromByte, stringByteFromChar)+   where++import System.IO+import Control.Exception(bracket)+import Control.Monad(liftM)+import Data.Char (ord, chr)+import Data.Word (Word8)++type ByteString = [Word8]++{- |+Hugs makes trouble here because it performs UTF-8 conversions.+E.g. @[255]@ is output as @[195,191]@+It would be easy to replace these routines by FastPackedString(fps).ByteString.Lazy,+however this introduces a new package dependency.+-}+writeBinaryFile :: FilePath -> ByteString -> IO ()+writeBinaryFile path str =+   bracket (openBinaryFile path WriteMode) hClose+           (flip hPutStr (stringCharFromByte str))++stringCharFromByte :: ByteString -> String+stringCharFromByte = map (chr . fromIntegral)++readBinaryFile :: FilePath -> IO ByteString+readBinaryFile path =+   liftM stringByteFromChar .+      hGetContents =<< openBinaryFile path ReadMode++stringByteFromChar :: String -> ByteString+stringByteFromChar = map (fromIntegral . ord)
+ src/Sound/MIDI/Parser.hs view
@@ -0,0 +1,31 @@+{- |+Taken from Haskore.+-}++module Sound.MIDI.Parser+   (T, zeroOrMore, oneOrMore, StateT(..), force) where++import Control.Monad.State (StateT(StateT, runStateT), liftM2, mplus)+import Control.Monad.Error ()++type T s a = StateT s (Either String) a++{- |+Wadler's force function++'force' guarantees that the parser does not fail.+Thus it makes parsing more lazy.+However if the original parser fails though,+then we get an unrecoverable /irrefutable pattern/ error on 'Just'.+-}+force        :: T s a -> T s a+force p =+   StateT $ \ s ->+     let Right x = runStateT p s+     in  Right x++zeroOrMore   :: T s a -> T s [a]+zeroOrMore p = force $ oneOrMore p `mplus` return []++oneOrMore    :: T s a -> T s [a]+oneOrMore p = liftM2 (:) p (zeroOrMore p)
+ src/Sound/MIDI/ParserState.hs view
@@ -0,0 +1,29 @@+{- |+Very similar to "Sound.MIDI.Parser".+-}++module Sound.MIDI.ParserState+   (T, zeroOrMore, oneOrMore, StateT(..)) where++import qualified Sound.MIDI.Parser as Parser++import Control.Monad.State (StateT(..), mapStateT, liftM2, mplus)++type T st s a = StateT st (StateT s (Either String)) a++{- |+Wadler's force function++'force' guarantees that the parser does not fail.+Thus it makes parsing more lazy.+However if the original parser fails though,+then we get an unrecoverable /irrefutable pattern/ error on 'Just'.+-}+force        :: T st s a -> T st s a+force = mapStateT Parser.force++zeroOrMore   :: T st s a -> T st s [a]+zeroOrMore p = force $ oneOrMore p `mplus` return []++oneOrMore    :: T st s a -> T st s [a]+oneOrMore p = liftM2 (:) p (zeroOrMore p)
+ src/Sound/MIDI/String.hs view
@@ -0,0 +1,33 @@+{- |+Taken from Haskore.+-}++module Sound.MIDI.String where++import Control.Monad.State (State, runState)++unlinesS :: [ShowS] -> ShowS+unlinesS = concatS . map (. showString "\n")++concatS :: [ShowS] -> ShowS+concatS = foldr (.) id++rightS, leftS, centreS :: Int -> ShowS -> ShowS+rightS  n s = showString (right  n (s ""))+leftS   n s = showString (left   n (s ""))+centreS n s = showString (centre n (s ""))++right,left, centre :: Int -> String -> String+right  n s = spaces (n - length s) ++ s+left   n s = s ++ spaces (n - length s)+centre n s = spaces l ++ s ++ spaces (n'-l)+  where+    n' = n - length s+    l  = n' `div` 2++spaces :: Int -> String+spaces n = replicate (max 0 n) ' '++stateToReadS :: State String a -> ReadS a+stateToReadS state string =+   [runState state string]
+ src/Sound/MIDI/Utility.hs view
@@ -0,0 +1,17 @@+module Sound.MIDI.Utility where++fst3 :: (a,b,c) -> a+fst3 (x,_,_) = x++snd3 :: (a,b,c) -> b+snd3 (_,x,_) = x++thd3 :: (a,b,c) -> c+thd3 (_,_,x) = x++toMaybe :: Bool -> a -> Maybe a+toMaybe False _ = Nothing+toMaybe True  x = Just x++swap :: (a,b) -> (b,a)+swap (a,b) = (b,a)