packages feed

event-list (empty) → 0.0.5

raw patch · 30 files changed

+6551/−0 lines, 30 filesdep +QuickCheckdep +basedep +mtlsetup-changed

Dependencies added: QuickCheck, base, 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
+ Test/Data/EventList/Absolute/BodyEnd.hs view
@@ -0,0 +1,325 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Test.Data.EventList.Absolute.BodyEnd (tests) where++import Test.Utility+import Test.QuickCheck (test)++import qualified Data.EventList.Absolute.TimeBody as AbsBody+import qualified Data.EventList.Absolute.TimeBodyPrivate as AbsBodyPriv+import qualified Data.EventList.Relative.TimeBody as RelBody+import qualified Data.AlternatingList.List.Disparate as Disp++-- for testing in GHCi+-- import Data.AlternatingList.List.Disparate (empty)+-- import Data.AlternatingList.List.Uniform ((/.), (./))+import qualified Data.Char as Char++import System.Random (Random, randomR, mkStdGen)+import Control.Monad (liftM)++import qualified Data.EventList.Utility as Utility++import qualified Numeric.NonNegative.Class as NonNeg+import Data.EventList.Utility (mapFst, mapSnd, mapPair)+import qualified Control.Monad as Monad+import Control.Monad.State (State(State), evalState)++import Prelude hiding (filter, concat)+++infixl 5 $~++($~) :: Num time =>+   (AbsBody.T time body -> a) -> (RelBody.T time body -> a)+($~) f = f . RelBody.toAbsoluteEventList 0++infixl 4 ==~++(==~) :: (Eq body, Num time) =>+   AbsBody.T time body -> RelBody.T time body -> Bool+(==~) xs ys =+   xs == RelBody.toAbsoluteEventList 0 ys++++duration :: Num time => RelBody.T time body -> Bool+duration xs =+   AbsBody.duration $~ xs == RelBody.duration xs+++mapBody :: (Eq body1, Num time) =>+   (body0 -> body1) -> RelBody.T time body0 -> Bool+mapBody f xs =+   AbsBody.mapBody f $~ xs ==~ RelBody.mapBody f xs++++mapBodyM ::+   (Monad m, Eq body1, NonNeg.C time) =>+   (m (AbsBody.T time body1) -> AbsBody.T time body1) ->+   (body0 -> m body1) -> RelBody.T time body0 -> Bool+mapBodyM run f xs =+   run (AbsBody.mapBodyM f $~ xs) ==+   run (liftM (RelBody.toAbsoluteEventList 0) (RelBody.mapBodyM f xs))++mapBodyMRandom ::+   (NonNeg.C time, Random body, Eq body) =>+   Int -> RelBody.T time (body, body) -> Bool+mapBodyMRandom seed =+   mapBodyM +      (flip evalState (mkStdGen seed))+      (State . randomR)+++filter :: (Eq body, Num time) =>+   (body -> Bool) -> RelBody.T time body -> Bool+filter p xs =+   AbsBody.filter p $~ xs ==~ RelBody.filter p xs++{-+mapMaybe :: (Num time) =>+   (body0 -> Maybe body1) ->+   RelBody.T time body0 -> RelBody.T time body1+mapMaybe f = catMaybes . mapBody f+-}++catMaybes :: (Eq body, Num time) =>+   RelBody.T time (Maybe body) -> Bool+catMaybes xs =+   AbsBody.catMaybes $~ xs ==~ RelBody.catMaybes xs++{-+Could be implemented more easily in terms of Uniform.partition+-}+partition :: (Eq body, Num time) =>+   (body -> Bool) -> RelBody.T time body -> Bool+partition p xs =+   AbsBody.partition p $~ xs ==+--      mapPair (RelBody.toAbsoluteEventList 0, RelBody.toAbsoluteEventList 0)+      (uncurry $ \ys zs -> (,) $~ ys $~ zs)+      (RelBody.partition p xs)++{- |+Since we need it later for MIDI generation,+we will also define a slicing into equivalence classes of events.+-}+slice :: (Eq a, Eq body, Num time) =>+   (body -> a) -> RelBody.T time body -> Bool+slice f xs =+   AbsBody.slice f $~ xs ==+   map (mapSnd (RelBody.toAbsoluteEventList 0)) (RelBody.slice f xs)+++collectCoincident :: (NonNeg.C time, Eq body) =>+   RelBody.T time body -> Bool+collectCoincident xs =+   AbsBody.collectCoincident $~ xs ==~+   RelBody.collectCoincident xs++collectCoincidentFoldr :: (NonNeg.C time, Eq body) =>+   RelBody.T time body -> Bool+collectCoincidentFoldr xs =+   AbsBody.collectCoincident $~ xs ==+   AbsBody.collectCoincidentFoldr $~ xs++collectCoincidentNonLazy :: (NonNeg.C time, Eq body) =>+   RelBody.T time body -> Bool+collectCoincidentNonLazy xs =+   AbsBody.collectCoincident $~ xs ==+   AbsBody.collectCoincidentNonLazy $~ xs++collectCoincidentInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool+collectCoincidentInfinite =+   checkInfinite .+   AbsBody.collectCoincident .+   makeUncollapsedInfiniteEventList+++flatten :: (NonNeg.C time, Eq body) =>+   RelBody.T time [body] -> Bool+flatten xs =+   AbsBody.flatten $~ xs  ==~  RelBody.flatten xs+++normalize :: (NonNeg.C time, Ord body) =>+   RelBody.T time body -> Bool+normalize xs =+   AbsBody.normalize $~ xs  ==~  RelBody.normalize xs+++merge :: (NonNeg.C time, Ord body) =>+   RelBody.T time body -> RelBody.T time body -> Bool+merge xs ys =+   AbsBody.merge $~ xs $~ ys  ==~  RelBody.merge xs ys+++insert :: (NonNeg.C time, Ord body) =>+   time -> body -> RelBody.T time body -> Bool+insert t b xs =+   AbsBody.insert t b $~ xs  ==~  RelBody.insert t b xs++++append :: (NonNeg.C time, Eq body) =>+   RelBody.T time body -> RelBody.T time body -> Bool+append xs ys =+   AbsBody.append $~ xs $~ ys  ==~+   RelBody.append xs ys++concat :: (NonNeg.C time, Eq body) =>+   [RelBody.T time body] -> Bool+concat xs =+   AbsBody.concat (map (RelBody.toAbsoluteEventList 0) xs)  ==~+   RelBody.concat xs+++{-+cycle :: (NonNeg.C time) =>+   RelBody.T time body -> RelBody.T time body+cycle = concat . List.repeat+-}+++decreaseStart :: (NonNeg.C time, Eq body) =>+   time -> time -> RelBody.T time body -> Bool+decreaseStart dif0 dif1 xs0 =+   let difA = min dif0 dif1+       difB = max dif0 dif1+       xs   = RelBody.delay difB xs0+   in  AbsBody.decreaseStart difA $~ xs ==~+       RelBody.decreaseStart difA xs+++delay :: (NonNeg.C time, Eq body) =>+   time -> RelBody.T time body -> Bool+delay dif xs =+   AbsBody.delay dif $~ xs  ==~+   RelBody.delay dif xs++++{-+resample :: (Integral time, Eq body) =>+   time -> RelBody.T (time, time) body -> Bool+resample rateInt xs0 =+   let xs = RelBody.mapTime (\(n,d) -> n % (d+1)) xs0+       rate = rateInt % 1+   in  AbsBody.resample rate $~ xs ==~+       (RelBody.resample rate xs `asTypeOf`+           AbsBody.singleton (undefined::Int) undefined)+-}++resample :: (Eq body) =>+   TimeDiff -> RelBody.T (TimeDiff, TimeDiff) body -> Bool+resample rateInt xs0 =+   let {-+       I add a small amount to the numerator in order+       to prevent the case of a fraction like 10.5,+       which can be easily rounded to 10 or 11+       depending to previous rounding errors.+       -}+       xs = RelBody.mapTime ((1e-6 +) . makeFracTime) xs0+       rate = timeToDouble rateInt + 1+   in  AbsBody.resample rate $~ xs ==~+       (RelBody.resample rate xs `asTypeOf`+           RelBody.singleton (undefined::TimeDiff) undefined)++resampleInfinite :: (Eq body) =>+   TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) body -> Bool+resampleInfinite rateInt =+   let rate = timeToDouble rateInt + 1+   in  checkInfinite .+       (`asTypeOf` AbsBody.singleton (undefined::TimeDiff) undefined) .+       AbsBody.resample rate .+       makeInfiniteEventList .+       mapPair (mapFst makeFracTime, RelBody.mapTime makeFracTime)+++++type NonEmptyList time body = ((time, body), RelBody.T time body)++makeUncollapsedInfiniteEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> AbsBody.T time body+makeUncollapsedInfiniteEventList =+   makeInfiniteEventList .+   mapFst (mapFst (1+))++makeInfiniteEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> AbsBody.T time body+makeInfiniteEventList =+   RelBody.toAbsoluteEventList 0 . RelBody.cycle . makeNonEmptyEventList++makeNonEmptyEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> RelBody.T time body+makeNonEmptyEventList (p, evs) =+   uncurry RelBody.cons p evs++{- |+Pick an arbitrary element from an infinite list+and check if it can be evaluated.+-}+checkInfinite :: (Eq time, Eq body) =>+   AbsBody.T time body -> Bool+checkInfinite xs0 =+   let x = maybe+              (error "BodyEnd.checkInfinite: empty list") fst $+              AbsBody.viewL $ AbsBodyPriv.lift (Disp.drop 100) xs0+   in  x == x++++++tests :: [(String, IO ())]+tests =+   ("duration",+     test (duration :: RelBody.T TimeDiff Char -> Bool)) :+   ("mapBody",+     test (mapBody Char.toUpper :: RelBody.T TimeDiff Char -> Bool)) :+   ("mapBodyM",+     test (mapBodyMRandom :: Int -> RelBody.T TimeDiff (Char, Char) -> Bool)) :+   ("filter",+     test (\c -> filter (c<) :: RelBody.T TimeDiff Char -> Bool)) :+   ("catMaybes",+     test (catMaybes :: RelBody.T TimeDiff (Maybe Char) -> Bool)) :+   ("partition",+     test (\c -> partition (c<) :: RelBody.T TimeDiff Char -> Bool)) :+   ("slice",+     test (slice fst :: RelBody.T TimeDiff (Char,Char) -> Bool)) :+   ("collectCoincident",+     test (collectCoincident :: RelBody.T TimeDiff Char -> Bool)) :+   ("collectCoincidentFoldr",+     test (collectCoincidentFoldr :: RelBody.T TimeDiff Char -> Bool)) :+   ("collectCoincidentNonLazy",+     test (collectCoincidentNonLazy :: RelBody.T TimeDiff Char -> Bool)) :+   ("collectCoincidentInfinite",+     test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+   ("flatten",+     test (flatten :: RelBody.T TimeDiff [Char] -> Bool)) :+   ("normalize",+     test (normalize :: RelBody.T TimeDiff Char -> Bool)) :+   ("merge",+     test (merge :: RelBody.T TimeDiff Char -> RelBody.T TimeDiff Char -> Bool)) :+   ("insert",+     test (insert :: TimeDiff -> Char -> RelBody.T TimeDiff Char -> Bool)) :+   ("append",+     test (append :: RelBody.T TimeDiff Char -> RelBody.T TimeDiff Char -> Bool)) :+   ("concat",+     test (concat :: [RelBody.T TimeDiff Char] -> Bool)) :+   ("decreaseStart",+     test (decreaseStart :: TimeDiff -> TimeDiff -> RelBody.T TimeDiff Char -> Bool)) :+   ("delay",+     test (delay :: TimeDiff -> RelBody.T TimeDiff Char -> Bool)) :+   ("resample",+     test (resample :: TimeDiff -> RelBody.T (TimeDiff, TimeDiff) Char -> Bool)) :+   ("resampleInfinite",+     test (resampleInfinite :: TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) Char -> Bool)) :+   []
+ Test/Data/EventList/Absolute/TimeEnd.hs view
@@ -0,0 +1,298 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Test.Data.EventList.Absolute.TimeEnd (tests) where++import Test.Utility+import Test.QuickCheck (test)++import qualified Data.EventList.Absolute.TimeTime as AbsTime+import qualified Data.EventList.Absolute.TimeTimePrivate as AbsTimePriv+import qualified Data.EventList.Relative.TimeTime as RelTime+import qualified Data.AlternatingList.List.Mixed as Mixed++-- for testing in GHCi+-- import Data.AlternatingList.List.Disparate (empty)+-- import Data.AlternatingList.List.Uniform ((/.), (./))+import qualified Data.Char as Char++import System.Random (Random, randomR, mkStdGen)+import Control.Monad (liftM)++import qualified Data.EventList.Utility as Utility++import qualified Numeric.NonNegative.Class as NonNeg+import Data.EventList.Utility (mapFst, mapSnd, mapPair)+import qualified Control.Monad as Monad+import Control.Monad.State (State(State), evalState)++import Prelude hiding (filter, concat)+++infixl 5 $~++($~) :: Num time =>+   (AbsTime.T time body -> a) -> (RelTime.T time body -> a)+($~) f = f . RelTime.toAbsoluteEventList 0++infixl 4 ==~++(==~) :: (Eq body, Num time) =>+   AbsTime.T time body -> RelTime.T time body -> Bool+(==~) xs ys =+   xs == RelTime.toAbsoluteEventList 0 ys++++duration :: Num time => RelTime.T time body -> Bool+duration xs =+   AbsTime.duration $~ xs == RelTime.duration xs+++mapBody :: (Eq body1, Num time) =>+   (body0 -> body1) -> RelTime.T time body0 -> Bool+mapBody f xs =+   AbsTime.mapBody f $~ xs ==~ RelTime.mapBody f xs++++mapBodyM ::+   (Monad m, Eq body1, NonNeg.C time) =>+   (m (AbsTime.T time body1) -> AbsTime.T time body1) ->+   (body0 -> m body1) -> RelTime.T time body0 -> Bool+mapBodyM run f xs =+   run (AbsTime.mapBodyM f $~ xs) ==+   run (liftM (RelTime.toAbsoluteEventList 0) (RelTime.mapBodyM f xs))++mapBodyMRandom ::+   (NonNeg.C time, Random body, Eq body) =>+   Int -> RelTime.T time (body, body) -> Bool+mapBodyMRandom seed =+   mapBodyM +      (flip evalState (mkStdGen seed))+      (State . randomR)+++filter :: (Eq body, Num time) =>+   (body -> Bool) -> RelTime.T time body -> Bool+filter p xs =+   AbsTime.filter p $~ xs ==~ RelTime.filter p xs++{-+mapMaybe :: (Num time) =>+   (body0 -> Maybe body1) ->+   RelTime.T time body0 -> RelTime.T time body1+mapMaybe f = catMaybes . mapBody f+-}++catMaybes :: (Eq body, Num time) =>+   RelTime.T time (Maybe body) -> Bool+catMaybes xs =+   AbsTime.catMaybes $~ xs ==~ RelTime.catMaybes xs++{-+Could be implemented more easily in terms of Uniform.partition+-}+partition :: (Eq body, Num time) =>+   (body -> Bool) -> RelTime.T time body -> Bool+partition p xs =+   AbsTime.partition p $~ xs ==+--      mapPair (RelTime.toAbsoluteEventList 0, RelTime.toAbsoluteEventList 0)+      (uncurry $ \ys zs -> (,) $~ ys $~ zs)+      (RelTime.partition p xs)++{- |+Since we need it later for MIDI generation,+we will also define a slicing into equivalence classes of events.+-}+slice :: (Eq a, Eq body, Num time) =>+   (body -> a) -> RelTime.T time body -> Bool+slice f xs =+   AbsTime.slice f $~ xs ==+   map (mapSnd (RelTime.toAbsoluteEventList 0)) (RelTime.slice f xs)+++collectCoincident :: (NonNeg.C time, Eq body) =>+   RelTime.T time body -> Bool+collectCoincident xs =+   AbsTime.collectCoincident $~ xs ==~+   RelTime.collectCoincident xs++collectCoincidentInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool+collectCoincidentInfinite =+   checkInfinite .+   AbsTime.collectCoincident .+   makeUncollapsedInfiniteEventList+++flatten :: (NonNeg.C time, Eq body) =>+   RelTime.T time [body] -> Bool+flatten xs =+   AbsTime.flatten $~ xs  ==~  RelTime.flatten xs+++normalize :: (NonNeg.C time, Ord body) =>+   RelTime.T time body -> Bool+normalize xs =+   AbsTime.normalize $~ xs  ==~  RelTime.normalize xs+++merge :: (NonNeg.C time, Ord body) =>+   RelTime.T time body -> RelTime.T time body -> Bool+merge xs ys =+   AbsTime.merge $~ xs $~ ys  ==~  RelTime.merge xs ys+++insert :: (NonNeg.C time, Ord body) =>+   time -> body -> RelTime.T time body -> Bool+insert t b xs =+   AbsTime.insert t b $~ xs  ==~  RelTime.insert t b xs++++append :: (NonNeg.C time, Eq body) =>+   RelTime.T time body -> RelTime.T time body -> Bool+append xs ys =+   AbsTime.append $~ xs $~ ys  ==~+   RelTime.append xs ys++concat :: (NonNeg.C time, Eq body) =>+   [RelTime.T time body] -> Bool+concat xs =+   AbsTime.concat (map (RelTime.toAbsoluteEventList 0) xs)  ==~+   RelTime.concat xs+++{-+cycle :: (NonNeg.C time) =>+   RelTime.T time body -> RelTime.T time body+cycle = concat . List.repeat+-}+++decreaseStart :: (NonNeg.C time, Eq body) =>+   time -> time -> RelTime.T time body -> Bool+decreaseStart dif0 dif1 xs0 =+   let difA = min dif0 dif1+       difB = max dif0 dif1+       xs   = RelTime.delay difB xs0+   in  AbsTime.decreaseStart difA $~ xs ==~+       RelTime.decreaseStart difA xs+++delay :: (NonNeg.C time, Eq body) =>+   time -> RelTime.T time body -> Bool+delay dif xs =+   AbsTime.delay dif $~ xs  ==~+   RelTime.delay dif xs++++resample :: (Eq body) =>+   TimeDiff -> RelTime.T (TimeDiff, TimeDiff) body -> Bool+resample rateInt xs0 =+   let {-+       I add a small amount to the numerator in order+       to prevent the case of a fraction like 10.5,+       which can be easily rounded to 10 or 11+       depending to previous rounding errors.+       -}+       xs = RelTime.mapTime ((1e-6 +) . makeFracTime) xs0+       rate = timeToDouble rateInt + 1+   in  AbsTime.resample rate $~ xs ==~+       (RelTime.resample rate xs `asTypeOf`+           RelTime.pause (undefined::TimeDiff))++resampleInfinite :: (Eq body) =>+   TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) body -> Bool+resampleInfinite rateInt =+   let rate = timeToDouble rateInt + 1+   in  checkInfinite .+       (`asTypeOf` AbsTime.pause (undefined::TimeDiff)) .+       AbsTime.resample rate .+       makeInfiniteEventList .+       mapPair (mapFst makeFracTime, RelTime.mapTime makeFracTime)++++type NonEmptyList time body = ((time, body), RelTime.T time body)++makeUncollapsedInfiniteEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> AbsTime.T time body+makeUncollapsedInfiniteEventList =+   makeInfiniteEventList .+   mapFst (mapFst (1+))++makeInfiniteEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> AbsTime.T time body+makeInfiniteEventList =+   RelTime.toAbsoluteEventList 0 . RelTime.cycle . makeNonEmptyEventList++makeNonEmptyEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> RelTime.T time body+makeNonEmptyEventList (p, evs) =+   uncurry RelTime.cons p evs++{- |+Pick an arbitrary element from an infinite list+and check if it can be evaluated.+-}+checkInfinite :: (Eq time, Eq body) =>+   AbsTime.T time body -> Bool+checkInfinite xs0 =+   let (x,xs) = AbsTime.viewL (AbsTimePriv.lift (Mixed.dropUniform 100) xs0)+       y = maybe+              (error "checkInfinite: finite list")+              fst+              xs+   in  x == x && y == y+++++tests :: [(String, IO ())]+tests =+   ("duration",+     test (duration :: RelTime.T TimeDiff Char -> Bool)) :+   ("mapBody",+     test (mapBody Char.toUpper :: RelTime.T TimeDiff Char -> Bool)) :+   ("mapBodyM",+     test (mapBodyMRandom :: Int -> RelTime.T TimeDiff (Char, Char) -> Bool)) :+   ("filter",+     test (\c -> filter (c<) :: RelTime.T TimeDiff Char -> Bool)) :+   ("catMaybes",+     test (catMaybes :: RelTime.T TimeDiff (Maybe Char) -> Bool)) :+   ("partition",+     test (\c -> partition (c<) :: RelTime.T TimeDiff Char -> Bool)) :+   ("slice",+     test (slice fst :: RelTime.T TimeDiff (Char,Char) -> Bool)) :+   ("collectCoincident",+     test (collectCoincident :: RelTime.T TimeDiff Char -> Bool)) :+   ("collectCoincidentInfinite",+     test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+   ("flatten",+     test (flatten :: RelTime.T TimeDiff [Char] -> Bool)) :+   ("normalize",+     test (normalize :: RelTime.T TimeDiff Char -> Bool)) :+   ("merge",+     test (merge :: RelTime.T TimeDiff Char -> RelTime.T TimeDiff Char -> Bool)) :+   ("insert",+     test (insert :: TimeDiff -> Char -> RelTime.T TimeDiff Char -> Bool)) :+   ("append",+     test (append :: RelTime.T TimeDiff Char -> RelTime.T TimeDiff Char -> Bool)) :+   ("concat",+     test (concat :: [RelTime.T TimeDiff Char] -> Bool)) :+   ("decreaseStart",+     test (decreaseStart :: TimeDiff -> TimeDiff -> RelTime.T TimeDiff Char -> Bool)) :+   ("delay",+     test (delay :: TimeDiff -> RelTime.T TimeDiff Char -> Bool)) :+   ("resample",+     test (resample :: TimeDiff -> RelTime.T (TimeDiff, TimeDiff) Char -> Bool)) :+   ("resampleInfinite",+     test (resampleInfinite :: TimeDiff -> NonEmptyList (TimeDiff, TimeDiff) Char -> Bool)) :+   []
+ Test/Data/EventList/Relative/BodyEnd.hs view
@@ -0,0 +1,907 @@+module Test.Data.EventList.Relative.BodyEnd (tests) where++import Test.Utility+import Test.QuickCheck (test)++import qualified Data.EventList.Relative.TimeBody as TimeBodyList+import qualified Data.EventList.Relative.TimeTime as TimeTimeList+import qualified Data.EventList.Relative.TimeMixed as TimeMixedList+import qualified Data.EventList.Relative.MixedBody as MixedBodyList+import qualified Data.EventList.Relative.BodyBody as BodyBodyList+import qualified Data.AlternatingList.List.Disparate as Disp++import qualified Data.EventList.Relative.TimeBodyPrivate as TimeBodyPriv++import Data.EventList.Relative.MixedBody ((/.), (./), empty)++import qualified Numeric.NonNegative.Class as NonNeg+import Numeric.NonNegative.Class ((-|))+import Data.EventList.Relative.TimeBody (isNormalized)++import Data.EventList.Utility (mapPair)+import System.Random (Random, randomR, mkStdGen)+import Control.Monad.State (State(State), evalState)+import Control.Monad (liftM2)+import Data.Maybe (isJust)+import qualified Data.List as List+import qualified Data.Char as Char++++viewLConsTime :: (Eq body, Eq time) =>+   TimeBodyList.T time body -> Bool+viewLConsTime xs =+   xs == maybe TimeBodyList.empty (uncurry MixedBodyList.consTime) (MixedBodyList.viewTimeL xs)++viewLConsBody :: (Eq body, Eq time) =>+   BodyBodyList.T time body -> Bool+viewLConsBody xs =+   xs == uncurry MixedBodyList.consBody (MixedBodyList.viewBodyL xs)++++viewLInfinite :: (NonNeg.C time, Eq body) => NonEmptyList time body -> Bool+viewLInfinite =+   checkInfinite .+   maybe (error "viewBodyL: empty list") snd .+   TimeBodyList.viewL .+   makeInfiniteEventList+++consInfinite :: (NonNeg.C time, Eq body) =>+   time -> body -> NonEmptyList time body -> Bool+consInfinite time body =+   checkInfinite .+   TimeBodyList.cons time body .+   makeInfiniteEventList++consTimeBodyInfinite :: (NonNeg.C time, Eq body) =>+   time -> body -> NonEmptyList time body -> Bool+consTimeBodyInfinite time body =+   checkInfinite .+   MixedBodyList.consTime time .+   MixedBodyList.consBody body .+   makeInfiniteEventList+++snocInfinite :: (NonNeg.C time, Eq body) =>+   time -> body -> NonEmptyList time body -> Bool+snocInfinite time body =+   checkInfinite .+   flip (flip TimeBodyList.snoc time) body .+   makeInfiniteEventList+++consInfix :: (NonNeg.C time, Eq body) =>+   time -> body -> time -> body -> Bool+consInfix t0 b0 t1 b1 =+   TimeBodyList.append (t0 /. b0 ./ empty) (t1 /. b1 ./ empty)+      == (t0 /. b0 ./ t1 /. b1 ./ empty)+++mapBodyComposition :: (Eq body2, Eq time) =>+   (body0 -> body1) -> (body1 -> body2) -> TimeBodyList.T time body0 -> Bool+mapBodyComposition f g evs =+   TimeBodyList.mapBody (g . f) evs  ==+   TimeBodyList.mapBody g (TimeBodyList.mapBody f evs)++mapTimeComposition :: (Eq body, Eq time2) =>+   (time0 -> time1) -> (time1 -> time2) -> TimeBodyList.T time0 body -> Bool+mapTimeComposition f g evs =+   TimeBodyList.mapTime (g . f) evs  ==+   TimeBodyList.mapTime g (TimeBodyList.mapTime f evs)+++mapTimeBodyCommutative :: (Eq body1, Eq time1) =>+   (time0 -> time1) -> (body0 -> body1) -> TimeBodyList.T time0 body0 -> Bool+mapTimeBodyCommutative f g evs =+   TimeBodyList.mapBody g (TimeBodyList.mapTime f evs)  ==+   TimeBodyList.mapTime f (TimeBodyList.mapBody g evs)++++mapBodyInfinite :: (NonNeg.C time, Eq body1) =>+   (body0 -> body1) -> NonEmptyList time body0 -> Bool+mapBodyInfinite f =+   checkInfinite . TimeBodyList.mapBody f . makeInfiniteEventList++mapTimeInfinite :: (NonNeg.C time0, Eq time1, Eq body) =>+   (time0 -> time1) -> NonEmptyList time0 body -> Bool+mapTimeInfinite f =+   checkInfinite . TimeBodyList.mapTime f . makeInfiniteEventList++++{- |+Does only hold for monotonic functions.+-}+mapNormalize :: (NonNeg.C time, Ord body0, Ord body1) =>+   (body0 -> body1) -> TimeBodyList.T time body0 -> Bool+mapNormalize f =+   isNormalized . TimeBodyList.mapBody f . TimeBodyList.normalize++++appendLeftIdentity :: (NonNeg.C time, Eq body) =>+   TimeBodyList.T time body -> Bool+appendLeftIdentity xs =+   TimeBodyList.append TimeBodyList.empty xs  ==  xs++appendRightIdentity :: (NonNeg.C time, Eq body) =>+   TimeBodyList.T time body -> Bool+appendRightIdentity xs =+   TimeBodyList.append xs TimeBodyList.empty  ==  xs++appendAssociative :: (NonNeg.C time, Eq body) =>+   TimeBodyList.T time body -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+appendAssociative xs ys zs =+   TimeBodyList.append xs (TimeBodyList.append ys zs)  ==+   TimeBodyList.append (TimeBodyList.append xs ys) zs++appendCons :: (NonNeg.C time, Eq body) =>+   time -> body -> TimeBodyList.T time body -> Bool+appendCons time body xs =+   TimeBodyList.cons time body xs  ==+   TimeBodyList.append (TimeBodyList.cons time body TimeBodyList.empty) xs++appendSplitAtTime :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> Bool+appendSplitAtTime t xs =+   xs == uncurry TimeMixedList.appendBodyEnd (TimeMixedList.splitAtTime t xs)++mapBodyAppend :: (Eq body1, NonNeg.C time) =>+   (body0 -> body1) -> TimeBodyList.T time body0 -> TimeBodyList.T time body0 -> Bool+mapBodyAppend f xs ys =+   TimeBodyList.mapBody f (TimeBodyList.append xs ys)  ==+   TimeBodyList.append (TimeBodyList.mapBody f xs) (TimeBodyList.mapBody f ys)+++appendFirstInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> TimeBodyList.T time body -> Bool+appendFirstInfinite xs =+   checkInfinite . TimeBodyList.append (makeInfiniteEventList xs)++appendSecondInfinite :: (NonNeg.C time, Eq body) =>+   TimeBodyList.T time body -> NonEmptyList time body -> Bool+appendSecondInfinite xs =+   checkInfinite . TimeBodyList.append xs . makeInfiniteEventList+++decreaseStartDelay :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> Bool+decreaseStartDelay dif xs =+   xs == TimeBodyList.decreaseStart dif (TimeBodyList.delay dif xs)++decreaseStartInfinite :: (NonNeg.C time, Eq body) =>+   time -> NonEmptyList time body -> Bool+decreaseStartInfinite dif =+   checkInfinite .+   TimeBodyList.decreaseStart dif .+   TimeBodyList.delay dif .+   makeInfiniteEventList++delayAdditive :: (NonNeg.C time, Eq body) =>+   time -> time -> TimeBodyList.T time body -> Bool+delayAdditive dif0 dif1 xs =+   TimeBodyList.delay (dif0+dif1) xs ==+   TimeBodyList.delay dif0 (TimeBodyList.delay dif1 xs)++delayAppendPause :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> Bool+delayAppendPause dif xs =+   TimeBodyList.delay dif xs == TimeMixedList.appendBodyEnd (TimeTimeList.pause dif) xs++delayInfinite :: (NonNeg.C time, Eq body) =>+   time -> NonEmptyList time body -> Bool+delayInfinite dif =+   checkInfinite .+   TimeBodyList.delay dif .+   makeInfiniteEventList++++splitAtTakeDropTime :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> Bool+splitAtTakeDropTime t xs =+   (TimeMixedList.takeTime t xs, TimeMixedList.dropTime t xs) ==+   TimeMixedList.splitAtTime t xs++takeTimeEndPause :: (NonNeg.C time, Ord body) =>+   time -> TimeBodyList.T time body -> Bool+takeTimeEndPause t xs =+   t == 0 ||+   t >= TimeBodyList.duration xs ||+   0 <  snd (TimeMixedList.viewTimeR (TimeMixedList.takeTime t xs))++takeTimeAppendFirst :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+takeTimeAppendFirst t xs ys =+   TimeMixedList.takeTime t (TimeBodyList.append xs ys) ==+   TimeTimeList.append+      (TimeMixedList.takeTime t xs)+      (TimeMixedList.takeTime (t -| TimeBodyList.duration xs) ys)++takeTimeAppendSecond :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+takeTimeAppendSecond t xs ys0 =+   -- the second list must not start with a zero pause+   let ys = TimeBodyList.delay 1 ys0+       t1 = t+1+   in  TimeMixedList.takeTime (TimeBodyList.duration xs + t1) (TimeBodyList.append xs ys) ==+       TimeMixedList.prependBodyEnd xs (TimeMixedList.takeTime t1 ys)++takeTimeNormalize :: (NonNeg.C time, Ord body) =>+   time -> TimeBodyList.T time body -> Bool+takeTimeNormalize t =+   TimeTimeList.isNormalized . TimeMixedList.takeTime t . TimeBodyList.normalize++dropTimeNormalize :: (NonNeg.C time, Ord body) =>+   time -> TimeBodyList.T time body -> Bool+dropTimeNormalize t =+   isNormalized . TimeMixedList.dropTime t . TimeBodyList.normalize++takeTimeInfinite :: (NonNeg.C time, Ord body) =>+   time -> NonEmptyList time body -> Bool+takeTimeInfinite t =+   (t == ) . TimeTimeList.duration .+   TimeMixedList.takeTime t . makeUncollapsedInfiniteEventList++dropTimeInfinite :: (NonNeg.C time, Ord body) =>+   time -> NonEmptyList time body -> Bool+dropTimeInfinite t =+   checkInfinite . TimeMixedList.dropTime t . makeUncollapsedInfiniteEventList+++++durationPause :: (NonNeg.C time) =>+   time -> Bool+durationPause t =+   t == TimeBodyList.duration (TimeBodyList.singleton t (error "durationPause: no need to access body"))++durationAppend :: (NonNeg.C time) =>+   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+durationAppend xs ys =+   TimeBodyList.duration (TimeBodyList.append xs ys)  ==+   TimeBodyList.duration xs + TimeBodyList.duration ys++durationMerge :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+durationMerge xs ys =+   TimeBodyList.duration (TimeBodyList.merge xs ys)  ==+   max (TimeBodyList.duration xs) (TimeBodyList.duration ys)++durationTakeTime :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> Bool+durationTakeTime t xs =+   min (TimeBodyList.duration xs) t ==+   TimeTimeList.duration (TimeMixedList.takeTime t xs)++durationDropTime :: (NonNeg.C time, Eq body) =>+   time -> TimeBodyList.T time body -> Bool+durationDropTime t xs =+   TimeBodyList.duration xs -| t ==+   TimeBodyList.duration (TimeMixedList.dropTime t xs)++++equalPrefix :: (Eq time, Eq body) =>+   Int -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+equalPrefix n xs ys =+   TimeBodyPriv.lift (Disp.take n) xs ==+   TimeBodyPriv.lift (Disp.take n) ys++cycleInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool+cycleInfinite xs0 =+   let xs = makeInfiniteEventList xs0+   in  equalPrefix 100 xs (TimeBodyList.cycle xs)+++filterSatisfy :: (Num time) =>+   (body -> Bool) ->+   TimeBodyList.T time body -> Bool+filterSatisfy p =+   all p . TimeBodyList.getBodies . TimeBodyList.filter p++filterProjection :: (Num time, Eq body) =>+   (body -> Bool) ->+   TimeBodyList.T time body -> Bool+filterProjection p xs =+   TimeBodyList.filter p xs ==+   TimeBodyList.filter p (TimeBodyList.filter p xs)++filterCommutative :: (Num time, Eq body) =>+   (body -> Bool) ->+   (body -> Bool) ->+   TimeBodyList.T time body -> Bool+filterCommutative p q xs =+   TimeBodyList.filter p (TimeBodyList.filter q xs) ==+   TimeBodyList.filter q (TimeBodyList.filter p xs)++filterComposition :: (Num time, Eq body) =>+   (body -> Bool) ->+   (body -> Bool) ->+   TimeBodyList.T time body -> Bool+filterComposition p q xs =+   TimeBodyList.filter p (TimeBodyList.filter q xs) ==+   TimeBodyList.filter (\b -> p b && q b) xs++filterNormalize :: (NonNeg.C time, Ord body) =>+   (body -> Bool) ->+   TimeBodyList.T time body -> Bool+filterNormalize p =+   isNormalized . TimeBodyList.filter p . TimeBodyList.normalize++filterAppend :: (NonNeg.C time, Eq body) =>+   (body -> Bool) ->+   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+filterAppend p xs0 ys =+   let xs = TimeBodyList.filter p xs0+   in  TimeBodyList.filter p (TimeBodyList.append xs ys)  ==+       TimeBodyList.append xs (TimeBodyList.filter p ys)++filterDuration :: (NonNeg.C time, Eq body) =>+   (body -> Bool) -> TimeTimeList.T time body -> Bool+filterDuration p xs =+   TimeTimeList.duration xs >= TimeTimeList.duration (TimeTimeList.filter p xs)++filterPartition :: (NonNeg.C time, Ord body) =>+   (body -> Bool) -> TimeBodyList.T time body -> Bool+filterPartition p xs =+   (TimeBodyList.filter p xs, TimeBodyList.filter (not . p) xs) ==+   TimeBodyList.partition p xs+++filterInfinite :: (NonNeg.C time, Eq body) =>+   (body -> Bool) -> NonEmptyList time body -> Bool+filterInfinite p xs =+   null (TimeBodyList.getBodies (TimeBodyList.filter p (makeNonEmptyEventList xs)))+   ||+   (checkInfinite .+    TimeBodyList.filter p .+    makeInfiniteEventList) xs++catMaybesAppend :: (NonNeg.C time, Eq body) =>+   TimeBodyList.T time (Maybe body) -> TimeBodyList.T time (Maybe body) -> Bool+catMaybesAppend xs0 ys =+   let xs = TimeBodyList.filter isJust xs0+   in  TimeBodyList.catMaybes (TimeBodyList.append xs ys)  ==+       TimeBodyList.append (TimeBodyList.catMaybes xs) (TimeBodyList.catMaybes ys)+++{- |+'TimeBodyList.merge' preserves normalization of its operands.+-}+mergeNormalize :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+mergeNormalize xs0 ys0 =+   let xs = TimeBodyList.normalize xs0+       ys = TimeBodyList.normalize ys0+   in  isNormalized $ TimeBodyList.merge xs ys++mergeLeftIdentity :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time body -> Bool+mergeLeftIdentity xs =+   TimeBodyList.merge TimeBodyList.empty xs  ==  xs++mergeRightIdentity :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time body -> Bool+mergeRightIdentity xs =+   TimeBodyList.merge xs TimeBodyList.empty  ==  xs++mergeCommutative :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+mergeCommutative xs0 ys0 =+   let xs = TimeBodyList.normalize xs0+       ys = TimeBodyList.normalize ys0+   in  TimeBodyList.merge xs ys  ==  TimeBodyList.merge ys xs++mergeAssociative :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time body -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+mergeAssociative xs0 ys0 zs0 =+   let xs = TimeBodyList.normalize xs0+       ys = TimeBodyList.normalize ys0+       zs = TimeBodyList.normalize zs0+   in  TimeBodyList.merge xs (TimeBodyList.merge ys zs)  ==+       TimeBodyList.merge (TimeBodyList.merge xs ys) zs++{-+Prior normalization is not enough,+because 'append' does not preserve normalization+if the first list ends with time difference 0+and the second one starts with time difference 0.+-}+mergeAppend :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time body -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+mergeAppend xs ys zs =+   TimeBodyList.normalize (TimeBodyList.append xs (TimeBodyList.merge ys zs))  ==+   TimeBodyList.normalize+      (TimeBodyList.merge (TimeBodyList.append xs ys)+          (TimeBodyList.delay (TimeBodyList.duration xs) zs))++{-+Normalization is important++does only hold for monotonic functions+toUpper and toLower are not monotonic+-}++mergeMap :: (NonNeg.C time, Ord body0 ,Ord body1) =>+   (body0 -> body1) -> TimeBodyList.T time body0 -> TimeBodyList.T time body0 -> Bool+mergeMap f xs0 ys0 =+   let xs = TimeBodyList.normalize xs0+       ys = TimeBodyList.normalize ys0+   in  TimeBodyList.mapBody f (TimeBodyList.merge xs ys)  ==+       TimeBodyList.merge (TimeBodyList.mapBody f xs) (TimeBodyList.mapBody f ys)++mergeFilter :: (NonNeg.C time, Ord body) =>+   (body -> Bool) -> TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+mergeFilter p xs0 ys0 =+   let xs = TimeBodyList.normalize xs0+       ys = TimeBodyList.normalize ys0+   in  TimeBodyList.filter p (TimeBodyList.merge xs ys)  ==+       TimeBodyList.merge (TimeBodyList.filter p xs) (TimeBodyList.filter p ys)++mergePartition :: (NonNeg.C time, Ord body) =>+   (body -> Bool) -> TimeBodyList.T time body -> Bool+mergePartition p xs0 =+   let xs = TimeBodyList.normalize xs0+   in  xs  ==  uncurry TimeBodyList.merge (TimeBodyList.partition p xs)++mergeEitherMapMaybe :: (NonNeg.C time, Ord body) =>+   TimeBodyList.T time body -> TimeBodyList.T time body -> Bool+mergeEitherMapMaybe xs0 ys0 =+   let xs = TimeBodyList.normalize xs0+       ys = TimeBodyList.normalize ys0+       zs = TimeBodyList.merge+               (TimeBodyList.mapBody Left xs)+               (TimeBodyList.mapBody Right ys)+   in  xs  ==  TimeBodyList.mapMaybe (either Just (const Nothing)) zs+       &&+       ys  ==  TimeBodyList.mapMaybe (either (const Nothing) Just) zs+++mergeInfinite :: (NonNeg.C time, Ord body) =>+   NonEmptyList time body ->+   NonEmptyList time body -> Bool+mergeInfinite xs0 ys0 =+   let xs = makeInfiniteEventList xs0+       ys = makeInfiniteEventList ys0+   in  checkInfinite (TimeBodyList.merge xs ys)++++insertCommutative :: (NonNeg.C time, Ord body) =>+   (time, body) -> (time, body) -> TimeBodyList.T time body -> Bool+insertCommutative (time0, body0) (time1, body1) evs =+   TimeBodyList.insert time0 body0 (TimeBodyList.insert time1 body1 evs)  ==+   TimeBodyList.insert time1 body1 (TimeBodyList.insert time0 body0 evs)++insertMerge :: (NonNeg.C time, Ord body) =>+   time -> body -> TimeBodyList.T time body -> Bool+insertMerge time body evs =+   TimeBodyList.insert time body evs  ==+   TimeBodyList.merge (TimeBodyList.cons time body TimeBodyList.empty) evs++insertNormalize :: (NonNeg.C time, Ord body) =>+   time -> body -> TimeBodyList.T time body -> Bool+insertNormalize time body =+   isNormalized . TimeBodyList.insert time body . TimeBodyList.normalize++insertSplitAtTime :: (NonNeg.C time, Ord body) =>+   time -> body -> TimeBodyList.T time body -> Bool+insertSplitAtTime time body evs =+   TimeBodyList.insert+      (min time (TimeBodyList.duration evs)) body+      (TimeBodyList.normalize evs)+   ==+      let (prefix,suffix) = TimeMixedList.splitAtTime time evs+      in  TimeBodyList.normalize (TimeMixedList.appendBodyEnd prefix+             (MixedBodyList.consTime 0 (MixedBodyList.consBody body suffix)))++insertInfinite :: (NonNeg.C time, Ord body) =>+   time -> body -> NonEmptyList time body -> Bool+insertInfinite time body =+   checkInfinite . TimeBodyList.insert time body . makeInfiniteEventList++++spanSatisfy :: (NonNeg.C time, Eq body) =>+   (body -> Bool) -> TimeBodyList.T time body -> Bool+spanSatisfy p =+   uncurry (&&) .+   mapPair+     (all p . TimeBodyList.getBodies,+      maybe True (not . p . snd . fst) . TimeBodyList.viewL) .+   TimeBodyList.span p++spanAppend :: (NonNeg.C time, Eq body) =>+   (body -> Bool) -> TimeBodyList.T time body -> Bool+spanAppend p xs =+   uncurry TimeBodyList.append (TimeBodyList.span p xs)  ==  xs++spanInfinite :: (NonNeg.C time, Ord body) =>+   (body -> Bool) -> NonEmptyList time body -> Bool+spanInfinite p =+   checkInfinite . uncurry TimeBodyList.append .+   TimeBodyList.span p . makeInfiniteEventList+++coincidentFlatten :: (NonNeg.C time, Eq body) =>+   TimeBodyList.T time body -> Bool+coincidentFlatten xs =+   xs  ==  TimeBodyList.flatten (TimeBodyList.collectCoincident xs)++collectCoincidentGaps :: (NonNeg.C time, Eq body) =>+   TimeBodyList.T time body -> Bool+collectCoincidentGaps xs =+   let times = TimeBodyList.getTimes (TimeBodyList.collectCoincident xs)+   in  null times || all (0<) (tail times)++collectCoincidentNonEmpty :: (NonNeg.C time, Eq body) =>+   TimeBodyList.T time body -> Bool+collectCoincidentNonEmpty =+   all (not . null) . TimeBodyList.getBodies . TimeBodyList.collectCoincident++collectCoincidentInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool+collectCoincidentInfinite =+   checkInfinite .+   TimeBodyList.collectCoincident .+   makeUncollapsedInfiniteEventList+++mapCoincidentMap :: (NonNeg.C time, Eq body1) =>+   (body0 -> body1) -> TimeBodyList.T time body0 -> Bool+mapCoincidentMap f xs =+   TimeBodyList.mapBody f xs  ==+   TimeBodyList.mapCoincident (map f) xs++mapCoincidentComposition :: (NonNeg.C time, Eq body2) =>+   ([body0] -> [body1]) -> ([body1] -> [body2]) -> TimeBodyList.T time body0 -> Bool+mapCoincidentComposition f g xs =+   TimeBodyList.mapCoincident (g . f) xs  ==+   (TimeBodyList.mapCoincident g . TimeBodyList.mapCoincident f) xs++mapCoincidentReverse :: (NonNeg.C time, Eq body) =>+   TimeBodyList.T time body -> Bool+mapCoincidentReverse xs =+   xs  ==  TimeBodyList.mapCoincident reverse (TimeBodyList.mapCoincident reverse xs)++++mapBodyMAppend ::+   (Monad m, Eq body1, NonNeg.C time) =>+   (m (TimeBodyList.T time body1) -> TimeBodyList.T time body1) ->+   (body0 -> m body1) -> TimeBodyList.T time body0 -> TimeBodyList.T time body0 -> Bool+mapBodyMAppend run f xs ys =+   run (TimeBodyList.mapM return f (TimeBodyList.append xs ys))  ==+   run (liftM2 TimeBodyList.append (TimeBodyList.mapM return f xs) (TimeBodyList.mapM return f ys))++mapBodyMAppendRandom ::+   (Random body, NonNeg.C time, Eq body) =>+   Int -> TimeBodyList.T time (body,body) -> TimeBodyList.T time (body,body) -> Bool+mapBodyMAppendRandom seed =+   mapBodyMAppend+      (flip evalState (mkStdGen seed))+      (State . randomR)+++mapBodyMInfinite ::+   (Random body, NonNeg.C time, Eq body) =>+   Int -> NonEmptyList time (body,body) -> Bool+mapBodyMInfinite seed =+   checkInfinite .+   flip evalState (mkStdGen seed) .+   TimeBodyList.mapM return (State . randomR) .+   makeInfiniteEventList+++{-++mapM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   TimeBodyList.T time0 body0 -> m (TimeBodyList.T time1 body1)+mapM timeAction bodyAction =+   Uniform.mapM bodyAction timeAction++mapImmM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   Immediate time0 body0 -> m (Immediate time1 body1)+mapImmM timeAction bodyAction =+   Disp.mapM bodyAction timeAction+++getBodies :: TimeBodyList.T time body -> [body]+getBodies = Uniform.getFirsts++getTimes :: TimeBodyList.T time body -> [time]+getTimes = Uniform.getSeconds+++empty :: Immediate time body+empty = Disp.empty+++cons :: time -> body -> TimeBodyList.T time body -> TimeBodyList.T time body+cons = Uniform.cons+++snoc :: TimeBodyList.T time body -> body -> time -> TimeBodyList.T time body+snoc = Uniform.snoc+++{-+propInsertPadded :: Event time body -> TimeBodyList.T time body -> Bool+propInsertPadded (Event time body) evs =+   EventList.insert time body (fst evs)  ==  fst (insert time body evs)+-}++appendSingle :: -- (Num time, Ord time, Ord body) =>+   body -> TimeBodyList.T time body -> EventList.T time body+appendSingle body xs =+   Disp.foldr EventList.consTime EventList.consBody EventList.empty $+   Uniform.snocFirst xs body++fromEventList :: time -> EventList.T time body -> TimeBodyList.T time body+fromEventList t =+   EventList.foldr consTime consBody (pause t)++toEventList :: TimeBodyList.T time body -> EventList.T time body+toEventList xs =+   zipWith EventList.Event (getTimes xs) (getBodies xs)++{- |++-}+++discretize :: (RealFrac time, Integral i) =>+   TimeBodyList.T time body -> TimeBodyList.T i body+discretize es =+   evalState (Uniform.mapSecondM roundDiff es) 0++resample :: (RealFrac time, Integral i) =>+   time -> TimeBodyList.T time body -> TimeBodyList.T i body+resample rate es =+   discretize (mapTime (rate*) es)+++toAbsoluteEventList :: (Num time) =>+   time -> TimeBodyList.T time body -> AbsoluteEventList.T time body+toAbsoluteEventList start xs =+   let ts = Uniform.getSeconds xs+       bs = Uniform.getFirsts  xs+       ats = List.scanl (+) start ts+   in  maybe+          (error "padded list always contains one time value")+          (\ ~(ats0,lt) -> (zip ats0 bs, lt))+          (viewR ats)+-}+++++type NonEmptyList time body = (time, body, TimeBodyList.T time body)++makeUncollapsedInfiniteEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> TimeBodyList.T time body+makeUncollapsedInfiniteEventList =+   makeInfiniteEventList .+   (\(time,body,xs) -> (time+1,body,xs))++makeInfiniteEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> TimeBodyList.T time body+makeInfiniteEventList =+   TimeBodyList.cycle . makeNonEmptyEventList++makeNonEmptyEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> TimeBodyList.T time body+makeNonEmptyEventList (t, b, evs) =+   TimeBodyList.cons t b evs++{- |+Pick an arbitrary element from an infinite list+and check if it can be evaluated.+-}+checkInfinite :: (Eq time, Eq body) =>+   TimeBodyList.T time body -> Bool+checkInfinite xs0 =+   let x = maybe+              (error "BodyEnd.checkInfinite: empty list") fst $+              TimeBodyList.viewL $ TimeBodyPriv.lift (Disp.drop 100) xs0+   in  x == x++++tests :: [(String, IO ())]+tests =+   ("viewTimeL consTime",+     test (viewLConsTime :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("viewBodyL consBody",+     test (viewLConsBody :: BodyBodyList.T TimeDiff Char -> Bool)) :++   ("viewLInfinite",+     test (viewLInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+   ("consInfinite",+     test (consInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+   ("consTimeBodyInfinite",+     test (consTimeBodyInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+   ("snocInfinite",+     test (snocInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+   ("consInfix",+     test (consInfix :: TimeDiff -> Char -> TimeDiff -> Char -> Bool)) :+++   ("map body composition",+     test (mapBodyComposition Char.toUpper Char.toLower+               :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("map time composition",+     test ((\dt0 dt1 -> mapTimeComposition (dt0+) (dt1+))+               :: TimeDiff -> TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("map time body commutative",+     test ((\dt -> mapTimeBodyCommutative (dt+) Char.toUpper)+               :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :++   ("mapBodyInfinite",+     test (mapBodyInfinite Char.toUpper+               :: NonEmptyList TimeDiff Char -> Bool)) :+   ("mapTimeInfinite",+     test (\dt -> mapTimeInfinite (dt+)+               :: NonEmptyList TimeDiff Char -> Bool)) :++   ("mapNormalize",+     test (mapNormalize succ+               :: TimeBodyList.T TimeDiff Char -> Bool)) :++   ("append left identity",+     test (appendLeftIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("append right identity",+     test (appendRightIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("append associative",+     test (appendAssociative+              :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char ->+                 TimeBodyList.T TimeDiff Char -> Bool)) :++   ("appendCons",+     test (appendCons :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("mapBodyAppend",+     test (mapBodyAppend Char.toUpper+               :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("appendSplitAtTime",+     test (appendSplitAtTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("appendFirstInfinite",+     test (appendFirstInfinite :: NonEmptyList TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("appendSecondInfinite",+     test (appendSecondInfinite :: TimeBodyList.T TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :+   ("cycleInfinite",+     test (cycleInfinite :: NonEmptyList TimeDiff Char -> Bool)) :++   ("decreaseStart delay",+     test (decreaseStartDelay :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("decreaseStartInfinite",+     test (decreaseStartInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :++   ("delay additive",+     test (delayAdditive :: TimeDiff -> TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("delay append pause",+     test (delayAppendPause :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("delayInfinite",+     test (delayInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :++   ("splitAtTakeDropTime",+     test (splitAtTakeDropTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("takeTimeEndPause",+     test (takeTimeEndPause :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("takeTimeAppendFirst",+     test (takeTimeAppendFirst :: TimeDiff -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("takeTimeAppendSecond",+     test (takeTimeAppendSecond :: TimeDiff -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("takeTimeNormalize",+     test (takeTimeNormalize :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("dropTimeNormalize",+     test (dropTimeNormalize :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("takeTimeInfinite",+     test (takeTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+   ("dropTimeInfinite",+     test (dropTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :++   ("duration pause",+     test (durationPause :: TimeDiff -> Bool)) :+   ("duration append",+     test (durationAppend :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("duration merge",+     test (durationMerge :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("durationTakeTime",+     test (durationTakeTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("durationDropTime",+     test (durationDropTime :: TimeDiff -> TimeBodyList.T TimeDiff Char -> Bool)) :++   ("filterSatisfy",+     test (\c -> filterSatisfy (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("filterProjection",+     test (\c -> filterProjection (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("filterCommutative",+     test (\c0 c1 -> filterCommutative (c0<) (c1>) :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("filterComposition",+     test (\c0 c1 -> filterComposition (c0<) (c1>) :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("filterNormalize",+     test (\c -> filterNormalize (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("filterAppend",+     test (\c -> filterAppend (c<) :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("filterDuration",+     test (\c -> filterDuration (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("filterPartition",+     test (\c -> filterPartition (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("filterInfinite",+     test (\c -> filterInfinite (c<) :: NonEmptyList TimeDiff Char -> Bool)) :+   ("catMaybesAppend",+     test (catMaybesAppend :: TimeBodyList.T TimeDiff (Maybe Char) -> TimeBodyList.T TimeDiff (Maybe Char) -> Bool)) :++   ("mergeNormalize",+     test (mergeNormalize :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("merge left identity",+     test (mergeLeftIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("merge right identity",+     test (mergeRightIdentity :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("merge commutative",+     test (mergeCommutative :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("merge associative",+     test (mergeAssociative :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("merge append",+     test (mergeAppend :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("mergeMap",+     test (mergeMap succ :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("mergeFilter",+     test (\c -> mergeFilter (c>)+             :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("mergePartition",+     test (\c -> mergePartition (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("mergeEitherMapMaybe",+     test (mergeEitherMapMaybe+         :: TimeBodyList.T TimeDiff Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("mergeInfinite",+     test (mergeInfinite+         :: NonEmptyList TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :++   ("insert commutative",+     test (insertCommutative :: (TimeDiff, Char) -> (TimeDiff, Char) -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("insert merge",+     test (insertMerge :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("insertNormalize",+     test (insertNormalize :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("insertSplitAtTime",+     test (insertSplitAtTime :: TimeDiff -> Char -> TimeBodyList.T TimeDiff Char -> Bool)) :+   ("insertInfinite",+     test (insertInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :++   ("spanSatisfy",+     test (\c -> spanSatisfy (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("spanAppend",+     test (\c -> spanAppend (c<) :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("spanInfinite",+     test (\c -> spanInfinite (c<) :: NonEmptyList TimeDiff Char -> Bool)) :++   ("coincidentFlatten",+     test (coincidentFlatten :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("collectCoincidentGaps",+     test (collectCoincidentGaps :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("collectCoincidentNonEmpty",+     test (collectCoincidentNonEmpty :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("collectCoincidentInfinite",+     test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) :++   ("mapCoincidentMap",+     test (mapCoincidentMap Char.toUpper :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("mapCoincidentComposition",+     test (mapCoincidentComposition reverse reverse :: TimeBodyList.T TimeDiff Char -> Bool)) :+   ("mapCoincidentReverse",+     test (mapCoincidentReverse :: TimeBodyList.T TimeDiff Char -> Bool)) :++   ("mapBodyMAppendRandom",+     test (mapBodyMAppendRandom :: Int -> TimeBodyList.T TimeDiff (Char,Char) -> TimeBodyList.T TimeDiff (Char,Char) -> Bool)) :+   ("mapBodyMInfinite",+     test (mapBodyMInfinite :: Int -> NonEmptyList TimeDiff (Char,Char) -> Bool)) :++   []
+ Test/Data/EventList/Relative/TimeEnd.hs view
@@ -0,0 +1,978 @@+module Test.Data.EventList.Relative.TimeEnd (tests) where++import Test.Utility+import Test.QuickCheck (test)++import qualified Data.EventList.Relative.TimeBody as TimeBodyList+import qualified Data.EventList.Relative.TimeTime as TimeTimeList+import qualified Data.EventList.Relative.TimeMixed as TimeMixedList+import qualified Data.EventList.Relative.MixedTime as MixedTimeList+import qualified Data.EventList.Relative.BodyTime as BodyTimeList+import qualified Data.AlternatingList.List.Mixed as Mixed++import Data.EventList.Relative.MixedTime ((/.), (./), empty)++import Data.EventList.Relative.TimeTimePrivate (($~~), lift)++import qualified Numeric.NonNegative.Class as NonNeg+import Numeric.NonNegative.Class ((-|))+import Data.EventList.Relative.TimeTime (isNormalized)++import System.Random (Random, randomR, mkStdGen)+import Control.Monad.State (State(State), evalState)+import Control.Monad (liftM2)+import qualified Data.List as List+import qualified Data.Char as Char++++viewLConsTime :: (Eq body, Eq time) =>+   TimeTimeList.T time body -> Bool+viewLConsTime xs =+   xs == uncurry MixedTimeList.consTime (MixedTimeList.viewTimeL xs)++viewLConsBody :: (Eq body, Eq time) =>+   BodyTimeList.T time body -> Bool+viewLConsBody xs =+   xs == maybe BodyTimeList.empty (uncurry MixedTimeList.consBody) (MixedTimeList.viewBodyL xs)++viewRSnocTime :: (Eq body, Eq time) =>+   TimeTimeList.T time body -> Bool+viewRSnocTime xs =+   xs == uncurry TimeMixedList.snocTime (TimeMixedList.viewTimeR xs)++viewRSnocBody :: (Eq body, Eq time) =>+   TimeBodyList.T time body -> Bool+viewRSnocBody xs =+   xs == maybe TimeBodyList.empty (uncurry TimeMixedList.snocBody) (TimeMixedList.viewBodyR xs)+++++viewLInfinite :: (NonNeg.C time, Eq body) => NonEmptyList time body -> Bool+viewLInfinite =+   checkInfinite .+   maybe (error "viewBodyL: empty list") snd . MixedTimeList.viewBodyL .+   snd . MixedTimeList.viewTimeL .+   makeInfiniteEventList++viewRInfinite :: (NonNeg.C time, Eq body) => NonEmptyList time body -> Bool+viewRInfinite =+   checkInfinite .+   maybe (error "viewBodyR: empty list") fst . TimeMixedList.viewBodyR .+   fst . TimeMixedList.viewTimeR .+   makeInfiniteEventList+++consInfinite :: (NonNeg.C time, Eq body) =>+   time -> body -> NonEmptyList time body -> Bool+consInfinite time body =+   checkInfinite .+   TimeTimeList.cons time body .+   makeInfiniteEventList++consTimeBodyInfinite :: (NonNeg.C time, Eq body) =>+   time -> body -> NonEmptyList time body -> Bool+consTimeBodyInfinite time body =+   checkInfinite .+   MixedTimeList.consTime time .+   MixedTimeList.consBody body .+   makeInfiniteEventList+++snocInfinite :: (NonNeg.C time, Eq body) =>+   time -> body -> NonEmptyList time body -> Bool+snocInfinite time body =+   checkInfinite .+   flip (flip TimeTimeList.snoc body) time .+   makeInfiniteEventList++snocTimeBodyInfinite :: (NonNeg.C time, Eq body) =>+   time -> body -> NonEmptyList time body -> Bool+snocTimeBodyInfinite time body =+   checkInfinite .+   flip TimeMixedList.snocTime time .+   flip TimeMixedList.snocBody body .+   makeInfiniteEventList+++consInfix :: (NonNeg.C time, Eq body) =>+   time -> body -> time -> time -> body -> time -> Bool+consInfix t0a b0 t0b t1a b1 t1b =+   TimeTimeList.append (t0a /. b0 ./ t0b /. empty) (t1a /. b1 ./ t1b /. empty)+      == (t0a /. b0 ./ (t0b+t1a) /. b1 ./ t1b /. empty)+++++mapBodyComposition :: (Eq body2, Eq time) =>+   (body0 -> body1) -> (body1 -> body2) -> TimeTimeList.T time body0 -> Bool+mapBodyComposition f g evs =+   TimeTimeList.mapBody (g . f) evs  ==+   TimeTimeList.mapBody g (TimeTimeList.mapBody f evs)++mapTimeComposition :: (Eq body, Eq time2) =>+   (time0 -> time1) -> (time1 -> time2) -> TimeTimeList.T time0 body -> Bool+mapTimeComposition f g evs =+   TimeTimeList.mapTime (g . f) evs  ==+   TimeTimeList.mapTime g (TimeTimeList.mapTime f evs)+++mapTimeBodyCommutative :: (Eq body1, Eq time1) =>+   (time0 -> time1) -> (body0 -> body1) -> TimeTimeList.T time0 body0 -> Bool+mapTimeBodyCommutative f g evs =+   TimeTimeList.mapBody g (TimeTimeList.mapTime f evs)  ==+   TimeTimeList.mapTime f (TimeTimeList.mapBody g evs)++++mapBodyInfinite :: (NonNeg.C time, Eq body1) =>+   (body0 -> body1) -> NonEmptyList time body0 -> Bool+mapBodyInfinite f =+   checkInfinite . TimeTimeList.mapBody f . makeInfiniteEventList++mapTimeInfinite :: (NonNeg.C time0, Eq time1, Eq body) =>+   (time0 -> time1) -> NonEmptyList time0 body -> Bool+mapTimeInfinite f =+   checkInfinite . TimeTimeList.mapTime f . makeInfiniteEventList++++{- |+Does only hold for monotonic functions.+-}+mapNormalize :: (NonNeg.C time, Ord body0, Ord body1) =>+   (body0 -> body1) -> TimeTimeList.T time body0 -> Bool+mapNormalize f =+   isNormalized . TimeTimeList.mapBody f . TimeTimeList.normalize++++appendLeftIdentity :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time body -> Bool+appendLeftIdentity xs =+   TimeTimeList.append (TimeTimeList.pause 0) xs  ==  xs++appendRightIdentity :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time body -> Bool+appendRightIdentity xs =+   TimeTimeList.append xs (TimeTimeList.pause 0)  ==  xs++appendAssociative :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+appendAssociative xs ys zs =+   TimeTimeList.append xs (TimeTimeList.append ys zs)  ==+   TimeTimeList.append (TimeTimeList.append xs ys) zs++appendCons :: (NonNeg.C time, Eq body) =>+   time -> body -> TimeTimeList.T time body -> Bool+appendCons time body xs =+   TimeTimeList.cons time body xs  ==+   TimeTimeList.append (TimeTimeList.cons time body (TimeTimeList.pause 0)) xs++appendSplitAtTime :: (NonNeg.C time, Eq body) =>+   time -> TimeTimeList.T time body -> Bool+appendSplitAtTime t xs =+   xs == uncurry TimeTimeList.append (TimeTimeList.splitAtTime t xs)++mapBodyAppend :: (Eq body1, NonNeg.C time) =>+   (body0 -> body1) -> TimeTimeList.T time body0 -> TimeTimeList.T time body0 -> Bool+mapBodyAppend f xs ys =+   TimeTimeList.mapBody f (TimeTimeList.append xs ys)  ==+   TimeTimeList.append (TimeTimeList.mapBody f xs) (TimeTimeList.mapBody f ys)+++appendFirstInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> TimeTimeList.T time body -> Bool+appendFirstInfinite xs =+   checkInfinite . TimeTimeList.append (makeInfiniteEventList xs)++appendSecondInfinite :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time body -> NonEmptyList time body -> Bool+appendSecondInfinite xs =+   checkInfinite . TimeTimeList.append xs . makeInfiniteEventList+++decreaseStartDelay :: (NonNeg.C time, Eq body) =>+   time -> TimeTimeList.T time body -> Bool+decreaseStartDelay dif xs =+   xs == TimeTimeList.decreaseStart dif (TimeTimeList.delay dif xs)++decreaseStartInfinite :: (NonNeg.C time, Eq body) =>+   time -> NonEmptyList time body -> Bool+decreaseStartInfinite dif =+   checkInfinite .+   TimeTimeList.decreaseStart dif .+   TimeTimeList.delay dif .+   makeInfiniteEventList++delayAdditive :: (NonNeg.C time, Eq body) =>+   time -> time -> TimeTimeList.T time body -> Bool+delayAdditive dif0 dif1 xs =+   TimeTimeList.delay (dif0+dif1) xs ==+   TimeTimeList.delay dif0 (TimeTimeList.delay dif1 xs)++delayPause :: (NonNeg.C time) =>+   time -> time -> Bool+delayPause dif0 dif1 =+   let pause = TimeTimeList.pause (dif0+dif1)+   in  TimeTimeList.delay dif0 (TimeTimeList.pause dif1) ==+       (asTypeOf pause (TimeTimeList.cons dif0 () pause))++delayAppendPause :: (NonNeg.C time, Eq body) =>+   time -> TimeTimeList.T time body -> Bool+delayAppendPause dif xs =+   TimeTimeList.delay dif xs == TimeTimeList.append (TimeTimeList.pause dif) xs++delayInfinite :: (NonNeg.C time, Eq body) =>+   time -> NonEmptyList time body -> Bool+delayInfinite dif =+   checkInfinite .+   TimeTimeList.delay dif .+   makeInfiniteEventList++++splitAtTakeDropTime :: (NonNeg.C time, Eq body) =>+   time -> TimeTimeList.T time body -> Bool+splitAtTakeDropTime t xs =+   (TimeTimeList.takeTime t xs, TimeTimeList.dropTime t xs) ==+   TimeTimeList.splitAtTime t xs++takeTimeEndPause :: (NonNeg.C time, Ord body) =>+   time -> TimeTimeList.T time body -> Bool+takeTimeEndPause t xs =+   t == 0 ||+   t >= TimeTimeList.duration xs ||+   0 <  snd (TimeMixedList.viewTimeR (TimeTimeList.takeTime t xs))++takeTimeAppendFirst :: (NonNeg.C time, Eq body) =>+   time -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+takeTimeAppendFirst t xs ys =+   TimeTimeList.takeTime t (TimeTimeList.append xs ys) ==+   TimeTimeList.append+      (TimeTimeList.takeTime t xs)+      (TimeTimeList.takeTime (t -| TimeTimeList.duration xs) ys)++takeTimeAppendSecond :: (NonNeg.C time, Eq body) =>+   time -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+takeTimeAppendSecond t xs0 ys =+   -- the first list must not end with a zero pause+   let xs = TimeTimeList.append xs0 (TimeTimeList.pause 1)+   in  TimeTimeList.takeTime (TimeTimeList.duration xs + t) (TimeTimeList.append xs ys) ==+       TimeTimeList.append xs (TimeTimeList.takeTime t ys)++takeTimeNormalize :: (NonNeg.C time, Ord body) =>+   time -> TimeTimeList.T time body -> Bool+takeTimeNormalize t =+   isNormalized . TimeTimeList.takeTime t . TimeTimeList.normalize++dropTimeNormalize :: (NonNeg.C time, Ord body) =>+   time -> TimeTimeList.T time body -> Bool+dropTimeNormalize t =+   isNormalized . TimeTimeList.dropTime t . TimeTimeList.normalize++takeTimeInfinite :: (NonNeg.C time, Ord body) =>+   time -> NonEmptyList time body -> Bool+takeTimeInfinite t =+   (t == ) . TimeTimeList.duration .+   TimeTimeList.takeTime t . makeUncollapsedInfiniteEventList++dropTimeInfinite :: (NonNeg.C time, Ord body) =>+   time -> NonEmptyList time body -> Bool+dropTimeInfinite t =+   checkInfinite . TimeTimeList.dropTime t . makeUncollapsedInfiniteEventList+++++durationPause :: (NonNeg.C time) =>+   time -> Bool+durationPause t =+   t == TimeTimeList.duration (TimeTimeList.pause t)++durationAppend :: (NonNeg.C time) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+durationAppend xs ys =+   TimeTimeList.duration (TimeTimeList.append xs ys)  ==+   TimeTimeList.duration xs + TimeTimeList.duration ys++durationMerge :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+durationMerge xs ys =+   TimeTimeList.duration (TimeTimeList.merge xs ys)  ==+   max (TimeTimeList.duration xs) (TimeTimeList.duration ys)++durationTakeTime :: (NonNeg.C time, Eq body) =>+   time -> TimeTimeList.T time body -> Bool+durationTakeTime t xs =+   min (TimeTimeList.duration xs) t ==+   TimeTimeList.duration (TimeTimeList.takeTime t xs)++durationDropTime :: (NonNeg.C time, Eq body) =>+   time -> TimeTimeList.T time body -> Bool+durationDropTime t xs =+   TimeTimeList.duration xs -| t ==+   TimeTimeList.duration (TimeTimeList.dropTime t xs)++++concatNaive :: (NonNeg.C time, Eq body) =>+   [TimeTimeList.T time body] -> Bool+concatNaive xs =+   TimeTimeList.concat xs == TimeTimeList.concatNaive xs+++equalPrefix :: (Eq time, Eq body) =>+   Int -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+equalPrefix n xs ys =+   Mixed.takeDisparate n $~~ xs ==+   Mixed.takeDisparate n $~~ ys++cycleNaive :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool+cycleNaive xs0 =+   let xs = makeNonEmptyEventList xs0+   in  equalPrefix 100 (TimeTimeList.cycle xs) (TimeTimeList.cycleNaive xs)++cycleInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool+cycleInfinite xs0 =+   let xs = makeInfiniteEventList xs0+   in  equalPrefix 100 xs (TimeTimeList.cycle xs)+++filterSatisfy :: (Num time) =>+   (body -> Bool) ->+   TimeTimeList.T time body -> Bool+filterSatisfy p =+   all p . TimeTimeList.getBodies . TimeTimeList.filter p++filterProjection :: (Num time, Eq body) =>+   (body -> Bool) ->+   TimeTimeList.T time body -> Bool+filterProjection p xs =+   TimeTimeList.filter p xs ==+   TimeTimeList.filter p (TimeTimeList.filter p xs)++filterCommutative :: (Num time, Eq body) =>+   (body -> Bool) ->+   (body -> Bool) ->+   TimeTimeList.T time body -> Bool+filterCommutative p q xs =+   TimeTimeList.filter p (TimeTimeList.filter q xs) ==+   TimeTimeList.filter q (TimeTimeList.filter p xs)++filterComposition :: (Num time, Eq body) =>+   (body -> Bool) ->+   (body -> Bool) ->+   TimeTimeList.T time body -> Bool+filterComposition p q xs =+   TimeTimeList.filter p (TimeTimeList.filter q xs) ==+   TimeTimeList.filter (\b -> p b && q b) xs++filterNormalize :: (NonNeg.C time, Ord body) =>+   (body -> Bool) ->+   TimeTimeList.T time body -> Bool+filterNormalize p =+   isNormalized . TimeTimeList.filter p . TimeTimeList.normalize++filterAppend :: (NonNeg.C time, Eq body) =>+   (body -> Bool) ->+   TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+filterAppend p xs ys =+   TimeTimeList.filter p (TimeTimeList.append xs ys)  ==+   TimeTimeList.append (TimeTimeList.filter p xs) (TimeTimeList.filter p ys)++filterDuration :: (NonNeg.C time, Eq body) =>+   (body -> Bool) -> TimeTimeList.T time body -> Bool+filterDuration p xs =+   TimeTimeList.duration xs == TimeTimeList.duration (TimeTimeList.filter p xs)++filterPartition :: (NonNeg.C time, Ord body) =>+   (body -> Bool) -> TimeTimeList.T time body -> Bool+filterPartition p xs =+   (TimeTimeList.filter p xs, TimeTimeList.filter (not . p) xs) ==+   TimeTimeList.partition p xs+++filterInfinite :: (NonNeg.C time, Eq body) =>+   (body -> Bool) -> NonEmptyList time body -> Bool+filterInfinite p xs =+   null (TimeTimeList.getBodies (TimeTimeList.filter p (makeNonEmptyEventList xs)))+   ||+   (checkInfinite .+    TimeTimeList.filter p .+    makeInfiniteEventList) xs++catMaybesAppend :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time (Maybe body) -> TimeTimeList.T time (Maybe body) -> Bool+catMaybesAppend xs ys =+   TimeTimeList.catMaybes (TimeTimeList.append xs ys)  ==+   TimeTimeList.append (TimeTimeList.catMaybes xs) (TimeTimeList.catMaybes ys)+++{- |+'TimeTimeList.merge' preserves normalization of its operands.+-}+mergeNormalize :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+mergeNormalize xs0 ys0 =+   let xs = TimeTimeList.normalize xs0+       ys = TimeTimeList.normalize ys0+   in  isNormalized $ TimeTimeList.merge xs ys++mergeLeftIdentity :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> Bool+mergeLeftIdentity xs =+   TimeTimeList.merge (TimeTimeList.pause 0) xs  ==  xs++mergeRightIdentity :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> Bool+mergeRightIdentity xs =+   TimeTimeList.merge xs (TimeTimeList.pause 0)  ==  xs++mergeCommutative :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+mergeCommutative xs0 ys0 =+   let xs = TimeTimeList.normalize xs0+       ys = TimeTimeList.normalize ys0+   in  TimeTimeList.merge xs ys  ==  TimeTimeList.merge ys xs+{-+merge commutative: Falsifiable, after 8 tests:+3 ./ '!' /. 0 ./ ' ' /. 1 ./ ' ' /. 2 ./ empty+3 ./ '!' /. 3 ./ '!' /. 1 ./ empty+-}++mergeAssociative :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+mergeAssociative xs0 ys0 zs0 =+   let xs = TimeTimeList.normalize xs0+       ys = TimeTimeList.normalize ys0+       zs = TimeTimeList.normalize zs0+   in  TimeTimeList.merge xs (TimeTimeList.merge ys zs)  ==+       TimeTimeList.merge (TimeTimeList.merge xs ys) zs++{-+Prior normalization is not enough,+because 'append' does not preserve normalization+if the first list ends with time difference 0+and the second one starts with time difference 0.++Without posterior normalization you get++merge append: Falsifiable, after 30 tests:+1 ./ 'a' /. 0 ./ empty+1 ./ ' ' /. 1 ./ empty+0 ./ ' ' /. 1 ./ empty++-}+mergeAppend :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+mergeAppend xs ys zs =+   TimeTimeList.normalize (TimeTimeList.append xs (TimeTimeList.merge ys zs))  ==+   TimeTimeList.normalize+      (TimeTimeList.merge (TimeTimeList.append xs ys)+          (TimeTimeList.delay (TimeTimeList.duration xs) zs))++appendByMerge :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+appendByMerge xs ys =+   TimeTimeList.normalize (TimeTimeList.append xs ys)  ==+   TimeTimeList.normalize (TimeTimeList.merge xs+      (TimeTimeList.delay (TimeTimeList.duration xs) ys))++{-+Normalization is important, otherwise the following counter-examples exist:++merge associative: Falsifiable, after 99 tests:+0 ./ '\DEL' /. 2 ./ '\DEL' /. 2 ./ empty+0 ./ '\DEL' /. 2 ./ '\DEL' /. 0 ./ '~' /. 3 ./ empty+2 ./ ' ' /. 2 ./ '\DEL' /. 3 ./ empty++merge associative: Falsifiable, after 99 tests:+6 ./ '~' /. 2 ./ '%' /. 1 ./ '#' /. 3 ./ '$' /. 2 ./ empty+6 ./ '~' /. 0 ./ '"' /. 2 ./ '{' /. 0 ./ '"' /. 6 ./ empty+0 ./ '{' /. 5 ./ '$' /. 3 ./ empty++merge associative: Falsifiable, after 41 tests:+2 ./ '~' /. 0 ./ empty+2 ./ '~' /. 0 ./ '$' /. 3 ./ empty+1 ./ '#' /. 4 ./ '"' /. 4 ./ empty+-}++-- does only hold for monotonic functions+-- toUpper and toLower are not monotonic+mergeMap :: (NonNeg.C time, Ord body0 ,Ord body1) =>+   (body0 -> body1) -> TimeTimeList.T time body0 -> TimeTimeList.T time body0 -> Bool+mergeMap f xs0 ys0 =+   let xs = TimeTimeList.normalize xs0+       ys = TimeTimeList.normalize ys0+   in  TimeTimeList.mapBody f (TimeTimeList.merge xs ys)  ==+       TimeTimeList.merge (TimeTimeList.mapBody f xs) (TimeTimeList.mapBody f ys)++mergeFilter :: (NonNeg.C time, Ord body) =>+   (body -> Bool) -> TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+mergeFilter p xs0 ys0 =+   let xs = TimeTimeList.normalize xs0+       ys = TimeTimeList.normalize ys0+   in  TimeTimeList.filter p (TimeTimeList.merge xs ys)  ==+       TimeTimeList.merge (TimeTimeList.filter p xs) (TimeTimeList.filter p ys)++mergePartition :: (NonNeg.C time, Ord body) =>+   (body -> Bool) -> TimeTimeList.T time body -> Bool+mergePartition p xs0 =+   let xs = TimeTimeList.normalize xs0+   in  xs  ==  uncurry TimeTimeList.merge (TimeTimeList.partition p xs)++mergeEitherMapMaybe :: (NonNeg.C time, Ord body) =>+   TimeTimeList.T time body -> TimeTimeList.T time body -> Bool+mergeEitherMapMaybe xs0 ys0 =+   let xs = TimeTimeList.normalize xs0+       ys = TimeTimeList.normalize ys0+       zs = TimeTimeList.merge+               (TimeTimeList.mapBody Left xs)+               (TimeTimeList.mapBody Right ys)+       dur = TimeTimeList.duration zs+       longXs = TimeTimeList.merge (TimeTimeList.pause dur) xs+       longYs = TimeTimeList.merge (TimeTimeList.pause dur) ys+   in  longXs  ==  TimeTimeList.mapMaybe (either Just (const Nothing)) zs+       &&+       longYs  ==  TimeTimeList.mapMaybe (either (const Nothing) Just) zs+++mergeInfinite :: (NonNeg.C time, Ord body) =>+   NonEmptyList time body ->+   NonEmptyList time body -> Bool+mergeInfinite xs0 ys0 =+   let xs = makeInfiniteEventList xs0+       ys = makeInfiniteEventList ys0+   in  checkInfinite (TimeTimeList.merge xs ys)++++insertCommutative :: (NonNeg.C time, Ord body) =>+   (time, body) -> (time, body) -> TimeTimeList.T time body -> Bool+insertCommutative (time0, body0) (time1, body1) evs =+   TimeTimeList.insert time0 body0 (TimeTimeList.insert time1 body1 evs)  ==+   TimeTimeList.insert time1 body1 (TimeTimeList.insert time0 body0 evs)++insertMerge :: (NonNeg.C time, Ord body) =>+   time -> body -> TimeTimeList.T time body -> Bool+insertMerge time body evs =+   TimeTimeList.insert time body evs  ==+   TimeTimeList.merge (TimeTimeList.cons time body $ TimeTimeList.pause 0) evs++insertNormalize :: (NonNeg.C time, Ord body) =>+   time -> body -> TimeTimeList.T time body -> Bool+insertNormalize time body =+   isNormalized . TimeTimeList.insert time body . TimeTimeList.normalize++insertSplitAtTime :: (NonNeg.C time, Ord body) =>+   time -> body -> TimeTimeList.T time body -> Bool+insertSplitAtTime time body evs =+   TimeTimeList.insert+      (min time (TimeTimeList.duration evs)) body+      (TimeTimeList.normalize evs)+   ==+      let (prefix,suffix) = TimeTimeList.splitAtTime time evs+      in  TimeTimeList.normalize+             (TimeTimeList.append prefix (TimeTimeList.cons 0 body suffix))+      --  append prefix (MixedTimeList.consBody body suffix)++insertInfinite :: (NonNeg.C time, Ord body) =>+   time -> body -> NonEmptyList time body -> Bool+insertInfinite time body =+   checkInfinite . TimeTimeList.insert time body . makeInfiniteEventList+++++coincidentFlatten :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time body -> Bool+coincidentFlatten xs =+   xs  ==  TimeTimeList.flatten (TimeTimeList.collectCoincident xs)++collectCoincidentGaps :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time body -> Bool+collectCoincidentGaps xs =+   let times = tail (TimeTimeList.getTimes (TimeTimeList.collectCoincident xs))+   in  null times || all (0<) (init times)++collectCoincidentNonEmpty :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time body -> Bool+collectCoincidentNonEmpty =+   all (not . null) . TimeTimeList.getBodies . TimeTimeList.collectCoincident++collectCoincidentInfinite :: (NonNeg.C time, Eq body) =>+   NonEmptyList time body -> Bool+collectCoincidentInfinite =+   checkInfinite .+   TimeTimeList.collectCoincident .+   makeUncollapsedInfiniteEventList+++mapCoincidentMap :: (NonNeg.C time, Eq body1) =>+   (body0 -> body1) -> TimeTimeList.T time body0 -> Bool+mapCoincidentMap f xs =+   TimeTimeList.mapBody f xs  ==+   TimeTimeList.mapCoincident (map f) xs++mapCoincidentComposition :: (NonNeg.C time, Eq body2) =>+   ([body0] -> [body1]) -> ([body1] -> [body2]) -> TimeTimeList.T time body0 -> Bool+mapCoincidentComposition f g xs =+   TimeTimeList.mapCoincident (g . f) xs  ==+   (TimeTimeList.mapCoincident g . TimeTimeList.mapCoincident f) xs++mapCoincidentReverse :: (NonNeg.C time, Eq body) =>+   TimeTimeList.T time body -> Bool+mapCoincidentReverse xs =+   xs  ==  TimeTimeList.mapCoincident reverse (TimeTimeList.mapCoincident reverse xs)++++mapBodyMAppend ::+   (Monad m, Eq body1, NonNeg.C time) =>+   (m (TimeTimeList.T time body1) -> TimeTimeList.T time body1) ->+   (body0 -> m body1) -> TimeTimeList.T time body0 -> TimeTimeList.T time body0 -> Bool+mapBodyMAppend run f xs ys =+   run (TimeTimeList.mapM return f (TimeTimeList.append xs ys))  ==+   run (liftM2 TimeTimeList.append (TimeTimeList.mapM return f xs) (TimeTimeList.mapM return f ys))++mapBodyMAppendRandom ::+   (Random body, NonNeg.C time, Eq body) =>+   Int -> TimeTimeList.T time (body,body) -> TimeTimeList.T time (body,body) -> Bool+mapBodyMAppendRandom seed =+   mapBodyMAppend+      (flip evalState (mkStdGen seed))+      (State . randomR)+++mapBodyMInfinite ::+   (Random body, NonNeg.C time, Eq body) =>+   Int -> NonEmptyList time (body,body) -> Bool+mapBodyMInfinite seed =+   checkInfinite .+   flip evalState (mkStdGen seed) .+   TimeTimeList.mapM return (State . randomR) .+   makeInfiniteEventList+++{-++mapM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   TimeTimeList.T time0 body0 -> m (TimeTimeList.T time1 body1)+mapM timeAction bodyAction =+   Uniform.mapM bodyAction timeAction++mapImmM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   Immediate time0 body0 -> m (Immediate time1 body1)+mapImmM timeAction bodyAction =+   Disp.mapM bodyAction timeAction+++getBodies :: TimeTimeList.T time body -> [body]+getBodies = Uniform.getFirsts++getTimes :: TimeTimeList.T time body -> [time]+getTimes = Uniform.getSeconds+++empty :: Immediate time body+empty = Disp.empty+++cons :: time -> body -> TimeTimeList.T time body -> TimeTimeList.T time body+cons = Uniform.cons+++snoc :: TimeTimeList.T time body -> body -> time -> TimeTimeList.T time body+snoc = Uniform.snoc+++{-+propInsertPadded :: Event time body -> TimeTimeList.T time body -> Bool+propInsertPadded (Event time body) evs =+   EventList.insert time body (fst evs)  ==  fst (insert time body evs)+-}++appendSingle :: -- (Num time, Ord time, Ord body) =>+   body -> TimeTimeList.T time body -> EventList.T time body+appendSingle body xs =+   Disp.foldr EventList.consTime EventList.consBody EventList.empty $+   Uniform.snocFirst xs body++fromEventList :: time -> EventList.T time body -> TimeTimeList.T time body+fromEventList t =+   EventList.foldr consTime consBody (pause t)++toEventList :: TimeTimeList.T time body -> EventList.T time body+toEventList xs =+   zipWith EventList.Event (getTimes xs) (getBodies xs)++{- |++-}+++discretize :: (RealFrac time, Integral i) =>+   TimeTimeList.T time body -> TimeTimeList.T i body+discretize es =+   evalState (Uniform.mapSecondM roundDiff es) 0++resample :: (RealFrac time, Integral i) =>+   time -> TimeTimeList.T time body -> TimeTimeList.T i body+resample rate es =+   discretize (mapTime (rate*) es)+++toAbsoluteEventList :: (Num time) =>+   time -> TimeTimeList.T time body -> AbsoluteEventList.T time body+toAbsoluteEventList start xs =+   let ts = Uniform.getSeconds xs+       bs = Uniform.getFirsts  xs+       ats = List.scanl (+) start ts+   in  maybe+          (error "padded list always contains one time value")+          (\ ~(ats0,lt) -> (zip ats0 bs, lt))+          (viewR ats)+-}+++++type NonEmptyList time body = (time, body, TimeTimeList.T time body)++makeUncollapsedInfiniteEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> TimeTimeList.T time body+makeUncollapsedInfiniteEventList =+   makeInfiniteEventList .+   (\(time,body,xs) -> (time+1,body,xs))++makeInfiniteEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> TimeTimeList.T time body+makeInfiniteEventList =+   TimeTimeList.cycle . makeNonEmptyEventList++makeNonEmptyEventList :: (NonNeg.C time) =>+   NonEmptyList time body -> TimeTimeList.T time body+makeNonEmptyEventList (t, b, evs) =+   TimeTimeList.cons t b evs++{- |+Pick an arbitrary element from an infinite list+and check if it can be evaluated.+-}+checkInfinite :: (Eq time, Eq body) =>+   TimeTimeList.T time body -> Bool+checkInfinite xs0 =+   let (x,xs) = MixedTimeList.viewTimeL (lift (Mixed.dropUniform 100) xs0)+       y = maybe+              (error "checkInfinite: finite list")+              fst+              (MixedTimeList.viewBodyL xs)+   in  x == x && y == y++++tests :: [(String, IO ())]+tests =+   ("viewTimeL consTime",+     test (viewLConsTime :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("viewBodyL consBody",+     test (viewLConsBody :: BodyTimeList.T TimeDiff Char -> Bool)) :+   ("viewTimeR snocTime",+     test (viewRSnocTime :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("viewBodyR snocBody",+     test (viewRSnocBody :: TimeBodyList.T TimeDiff Char -> Bool)) :++   ("viewLInfinite",+     test (viewLInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+   ("viewRInfinite",+     test (viewRInfinite :: NonEmptyList TimeDiff Char -> Bool)) :+   ("consInfinite",+     test (consInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+   ("consTimeBodyInfinite",+     test (consTimeBodyInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+   ("snocInfinite",+     test (snocInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+   ("snocTimeBodyInfinite",+     test (snocTimeBodyInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :+   ("consInfix",+     test (consInfix :: TimeDiff -> Char -> TimeDiff -> TimeDiff -> Char -> TimeDiff -> Bool)) :+++   ("map body composition",+     test (mapBodyComposition Char.toUpper Char.toLower+               :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("map time composition",+     test ((\dt0 dt1 -> mapTimeComposition (dt0+) (dt1+))+               :: TimeDiff -> TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("map time body commutative",+     test ((\dt -> mapTimeBodyCommutative (dt+) Char.toUpper)+               :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :++   ("mapBodyInfinite",+     test (mapBodyInfinite Char.toUpper+               :: NonEmptyList TimeDiff Char -> Bool)) :+   ("mapTimeInfinite",+     test (\dt -> mapTimeInfinite (dt+)+               :: NonEmptyList TimeDiff Char -> Bool)) :++   ("mapNormalize",+     test (mapNormalize succ+               :: TimeTimeList.T TimeDiff Char -> Bool)) :++   ("append left identity",+     test (appendLeftIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("append right identity",+     test (appendRightIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("append associative",+     test (appendAssociative+              :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char ->+                 TimeTimeList.T TimeDiff Char -> Bool)) :++   ("appendCons",+     test (appendCons :: TimeDiff -> Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("mapBodyAppend",+     test (mapBodyAppend Char.toUpper+               :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("appendSplitAtTime",+     test (appendSplitAtTime :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("appendFirstInfinite",+     test (appendFirstInfinite :: NonEmptyList TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("appendSecondInfinite",+     test (appendSecondInfinite :: TimeTimeList.T TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :+   ("concatNaive",+     test (concatNaive :: [TimeTimeList.T TimeDiff Char] -> Bool)) :+   ("cycleNaive",+     test (cycleNaive :: NonEmptyList TimeDiff Char -> Bool)) :+   ("cycleInfinite",+     test (cycleInfinite :: NonEmptyList TimeDiff Char -> Bool)) :++   ("decreaseStart delay",+     test (decreaseStartDelay :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("decreaseStartInfinite",+     test (decreaseStartInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :++   ("delay additive",+     test (delayAdditive :: TimeDiff -> TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("delay pause",+     test (delayPause :: TimeDiff -> TimeDiff -> Bool)) :+   ("delay append pause",+     test (delayAppendPause :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("delayInfinite",+     test (delayInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :++   ("splitAtTakeDropTime",+     test (splitAtTakeDropTime :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("takeTimeEndPause",+     test (takeTimeEndPause :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("takeTimeAppendFirst",+     test (takeTimeAppendFirst :: TimeDiff -> TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("takeTimeAppendSecond",+     test (takeTimeAppendSecond :: TimeDiff -> TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("takeTimeNormalize",+     test (takeTimeNormalize :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("dropTimeNormalize",+     test (dropTimeNormalize :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("takeTimeInfinite",+     test (takeTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :+   ("dropTimeInfinite",+     test (dropTimeInfinite :: TimeDiff -> NonEmptyList TimeDiff Char -> Bool)) :++   ("duration pause",+     test (durationPause :: TimeDiff -> Bool)) :+   ("duration append",+     test (durationAppend :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("duration merge",+     test (durationMerge :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("durationTakeTime",+     test (durationTakeTime :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("durationDropTime",+     test (durationDropTime :: TimeDiff -> TimeTimeList.T TimeDiff Char -> Bool)) :++   ("filterSatisfy",+     test (\c -> filterSatisfy (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("filterProjection",+     test (\c -> filterProjection (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("filterCommutative",+     test (\c0 c1 -> filterCommutative (c0<) (c1>) :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("filterComposition",+     test (\c0 c1 -> filterComposition (c0<) (c1>) :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("filterNormalize",+     test (\c -> filterNormalize (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("filterAppend",+     test (\c -> filterAppend (c<) :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("filterDuration",+     test (\c -> filterDuration (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("filterPartition",+     test (\c -> filterPartition (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("filterInfinite",+     test (\c -> filterInfinite (c<) :: NonEmptyList TimeDiff Char -> Bool)) :+   ("catMaybesAppend",+     test (catMaybesAppend :: TimeTimeList.T TimeDiff (Maybe Char) -> TimeTimeList.T TimeDiff (Maybe Char) -> Bool)) :++   ("mergeNormalize",+     test (mergeNormalize :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("merge left identity",+     test (mergeLeftIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("merge right identity",+     test (mergeRightIdentity :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("merge commutative",+     test (mergeCommutative :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("merge associative",+     test (mergeAssociative :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("merge append",+     test (mergeAppend :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("appendByMerge",+     test (appendByMerge :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("mergeMap",+     test (mergeMap succ :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("mergeFilter",+     test (\c -> mergeFilter (c>)+             :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("mergePartition",+     test (\c -> mergePartition (c<) :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("mergeEitherMapMaybe",+     test (mergeEitherMapMaybe+         :: TimeTimeList.T TimeDiff Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("mergeInfinite",+     test (mergeInfinite+         :: NonEmptyList TimeDiff Char -> NonEmptyList TimeDiff Char -> Bool)) :++   ("insert commutative",+     test (insertCommutative :: (TimeDiff, Char) -> (TimeDiff, Char) -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("insert merge",+     test (insertMerge :: TimeDiff -> Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("insertNormalize",+     test (insertNormalize :: TimeDiff -> Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("insertSplitAtTime",+     test (insertSplitAtTime :: TimeDiff -> Char -> TimeTimeList.T TimeDiff Char -> Bool)) :+   ("insertInfinite",+     test (insertInfinite :: TimeDiff -> Char -> NonEmptyList TimeDiff Char -> Bool)) :++   ("coincidentFlatten",+     test (coincidentFlatten :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("collectCoincidentGaps",+     test (collectCoincidentGaps :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("collectCoincidentNonEmpty",+     test (collectCoincidentNonEmpty :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("collectCoincidentInfinite",+     test (collectCoincidentInfinite :: NonEmptyList TimeDiff Char -> Bool)) :++   ("mapCoincidentMap",+     test (mapCoincidentMap Char.toUpper :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("mapCoincidentComposition",+     test (mapCoincidentComposition reverse reverse :: TimeTimeList.T TimeDiff Char -> Bool)) :+   ("mapCoincidentReverse",+     test (mapCoincidentReverse :: TimeTimeList.T TimeDiff Char -> Bool)) :++   ("mapBodyMAppendRandom",+     test (mapBodyMAppendRandom :: Int -> TimeTimeList.T TimeDiff (Char,Char) -> TimeTimeList.T TimeDiff (Char,Char) -> Bool)) :+   ("mapBodyMInfinite",+     test (mapBodyMInfinite :: Int -> NonEmptyList TimeDiff (Char,Char) -> Bool)) :++   []
+ Test/Main.hs view
@@ -0,0 +1,20 @@+module Main where++import qualified Test.Data.EventList.Absolute.BodyEnd as AbsBodyEnd+import qualified Test.Data.EventList.Absolute.TimeEnd as AbsTimeEnd+import qualified Test.Data.EventList.Relative.BodyEnd as RelBodyEnd+import qualified Test.Data.EventList.Relative.TimeEnd as RelTimeEnd++prefix :: String -> [(String, IO ())] -> [(String, IO ())]+prefix msg =+   map (\(str,test) -> (msg ++ "." ++ str, test))++main :: IO ()+main =+   mapM_ (\(msg,io) -> putStr (msg++": ") >> io) $+   concat $+      prefix "Absolute.BodyEnd" AbsBodyEnd.tests :+      prefix "Absolute.TimeEnd" AbsTimeEnd.tests :+      prefix "Relative.BodyEnd" RelBodyEnd.tests :+      prefix "Relative.TimeEnd" RelTimeEnd.tests :+      []
+ Test/Utility.hs view
@@ -0,0 +1,28 @@+module Test.Utility where++import Test.QuickCheck (Arbitrary(..))++import qualified Numeric.NonNegative.Wrapper as NonNeg+import Control.Monad (liftM)+import Data.Char (chr)+++type TimeDiff = NonNeg.Int++timeToDouble :: TimeDiff -> NonNeg.Double+timeToDouble = fromIntegral++makeFracTime :: (TimeDiff, TimeDiff) -> NonNeg.Double+makeFracTime (n,d) =+   timeToDouble n / (timeToDouble d + 1)+++instance Arbitrary Char where+   arbitrary = liftM (chr . (32+) . flip mod 96) arbitrary+   coarbitrary = undefined++instance Arbitrary a => Arbitrary (Maybe a) where+   arbitrary =+      arbitrary >>=+         \b -> if b then fmap Just arbitrary else return Nothing+   coarbitrary = undefined
+ event-list.cabal view
@@ -0,0 +1,60 @@+Name:             event-list+Version:          0.0.5+License:          GPL+License-File:     LICENSE+Author:           Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>+Homepage:         http://darcs.haskell.org/event-list/+Category:         Data Structures+Build-Type:       Simple+Build-Depends:    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.+Synopsis:         Event lists with relative or absolute time stamps+Description:+   These lists manage events that are associated with times.+   Times may be given as difference between successive events+   or as absolute time values.+   Pauses before the first and after the last event are supported.+   The underlying data structures are lists of elements of alternating types,+   that is [b,a,b,...,a,b] or [a,b,a,...,a,b].+   The data structures can be used to represent+   MIDI files, OpenSoundControl message streams, music performances etc.+GHC-Options:      -Wall+Tested-With:      GHC==6.4.1+Hs-Source-Dirs:   src+Exposed-Modules:+  Data.EventList.Absolute.TimeBody+  Data.EventList.Absolute.TimeTime+  Data.EventList.Absolute.TimeMixed+  Data.EventList.Relative.TimeBody+  Data.EventList.Relative.TimeTime+  Data.EventList.Relative.TimeMixed+  Data.EventList.Relative.BodyBody+  Data.EventList.Relative.BodyTime+  Data.EventList.Relative.MixedTime+  Data.EventList.Relative.MixedBody+Other-Modules:+  Data.EventList.Utility+  Data.EventList.Absolute.TimeBodyPrivate+  Data.EventList.Absolute.TimeTimePrivate+  Data.EventList.Relative.TimeBodyPrivate+  Data.EventList.Relative.BodyBodyPrivate+  Data.EventList.Relative.TimeTimePrivate+  Data.EventList.Relative.BodyTimePrivate+  Data.AlternatingList.Custom+  Data.AlternatingList.List.Disparate+  Data.AlternatingList.List.Uniform+  Data.AlternatingList.List.Mixed++Executable:       test+Hs-source-dirs:   src, .+GHC-Options:      -Wall+Main-Is:          Test/Main.hs+Other-Modules:+  Test.Utility+  Test.Data.EventList.Absolute.BodyEnd+  Test.Data.EventList.Absolute.TimeEnd+  Test.Data.EventList.Relative.BodyEnd+  Test.Data.EventList.Relative.TimeEnd
+ src/Data/AlternatingList/Custom.hs view
@@ -0,0 +1,68 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98++Lists of elements of alternating type.+This module iuses custom data types which depend mutually.+This looks nicer but it lacks high level optimizations.+(They could be added, though.)+-}+module Data.AlternatingList.Custom where++infixr 5 :>, :<++{- |+A list of elements of alternating types,+where the types of the beginning and the end element are independent,+namely @a@ at the beginning, @b@ at the end.++Example:+@1 :> \'a\' :< 2 :> \'b\' :< End@+-}+data Disparate a b =+    a :> Uniform a b+  | End++{- |+A list of elements of alternating types,+where the type of the beginning and the end element is equal,+namely @b@.++Example:+@1 :> \'a\' :< 2 :> \'b\' :< 3 :> End@+-}+data Uniform a b =+    b :< Disparate a b++++mapDisparate ::+   (a0 -> a1) -> (b0 -> b1) ->+   (Disparate a0 b0 -> Disparate a1 b1)+mapDisparate f g =+   foldrDisparate ((:>) . f) ((:<) . g) End++mapUniform ::+   (a0 -> a1) -> (b0 -> b1) ->+   (Uniform a0 b0 -> Uniform a1 b1)+mapUniform f g =+   foldrUniform ((:>) . f) ((:<) . g) End++++foldrDisparate ::+   (a -> c -> d) -> (b -> d -> c) ->+   d -> Disparate a b -> d+foldrDisparate f g start a0 =+   case a0 of+      End -> start+      a :> bas -> f a (foldrUniform f g start bas)++foldrUniform ::+   (a -> c -> d) -> (b -> d -> c) ->+   d -> Uniform a b -> c+foldrUniform f g start (b :< abas) =+   g b (foldrDisparate f g start abas)
+ src/Data/AlternatingList/List/Disparate.hs view
@@ -0,0 +1,267 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98++Lists of elements of alternating type.+This module is based on the standard list type+and may benefit from list optimizations.+-}+module Data.AlternatingList.List.Disparate+   (T,+    fromPairList, toPairList,+    map, mapFirst, mapSecond,+    sequence, sequence_,+    mapM, mapM_, mapFirstM, mapSecondM,+    getFirsts, getSeconds, length, genericLength,+    empty, singleton, null,+    cons, snoc, viewL, viewR, mapHead, mapLast,+    foldr, foldrPair,+    format,+    append, concat, cycle,+    splitAt, take, drop,+    genericSplitAt, genericTake, genericDrop,+    spanFirst, spanSecond,+    zipWithFirst, zipWithSecond,+   ) where++import qualified Data.EventList.Utility as Utility++import Data.EventList.Utility (mapPair, mapFst, mapSnd)++import qualified Data.List as List+import qualified Control.Monad as Monad++import Test.QuickCheck (Arbitrary, arbitrary, coarbitrary)++import Prelude hiding+   (null, foldr, map, concat, cycle, length, take, drop, splitAt,+    sequence, sequence_, mapM, mapM_)+++data Pair a b =+     Pair {pairFirst  :: a,+           pairSecond :: b}+   deriving (Eq, Ord, Show)++newtype T a b = Cons {decons :: [Pair a b]}+   deriving (Eq, Ord)+++format :: (Show a, Show b) =>+   String -> String -> Int -> T a b -> ShowS+format first second p xs =+   showParen (p>5) $+   flip (foldr+      (\a -> showsPrec 5 a . showString first)+      (\b -> showsPrec 5 b . showString second))+      xs .+      showString "empty"++instance (Show a, Show b) => Show (T a b) where+   showsPrec = format " /. " " ./ "+++instance (Arbitrary a, Arbitrary b) =>+             Arbitrary (Pair a b) where+   arbitrary = Monad.liftM2 Pair arbitrary arbitrary+   coarbitrary = undefined++instance (Arbitrary a, Arbitrary b) =>+             Arbitrary (T a b) where+   arbitrary = Monad.liftM Cons arbitrary+   coarbitrary = undefined+++fromPairList :: [(a,b)] -> T a b+fromPairList = Cons . List.map (uncurry Pair)++toPairList :: T a b -> [(a,b)]+toPairList = List.map (\ ~(Pair a b) -> (a,b)) . decons+++lift :: ([Pair a0 b0] -> [Pair a1 b1]) -> (T a0 b0 -> T a1 b1)+lift f = Cons . f . decons++mapPairFirst :: (a0 -> a1) -> Pair a0 b -> Pair a1 b+mapPairFirst f e = e{pairFirst = f (pairFirst e)}++mapPairSecond :: (b0 -> b1) -> Pair a b0 -> Pair a b1+mapPairSecond f e = e{pairSecond = f (pairSecond e)}++map :: (a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1+map f g = lift (List.map (mapPairFirst f . mapPairSecond g))++mapFirst :: (a0 -> a1) -> T a0 b -> T a1 b+mapFirst f = lift (List.map (mapPairFirst f))++mapSecond :: (b0 -> b1) -> T a b0 -> T a b1+mapSecond g = lift (List.map (mapPairSecond g))++++sequence :: Monad m =>+   T (m a) (m b) -> m (T a b)+sequence =+   Monad.liftM Cons .+   Monad.mapM (\(Pair a b) -> Monad.liftM2 Pair a b) .+   decons++sequence_ :: Monad m =>+   T (m ()) (m ()) -> m ()+sequence_ =+   Monad.mapM_ (\(Pair a b) -> a >> b) . decons+++mapM :: Monad m =>+   (a0 -> m a1) -> (b0 -> m b1) ->+   T a0 b0 -> m (T a1 b1)+mapM aAction bAction =+   sequence . map aAction bAction++mapM_ :: Monad m =>+   (a -> m ()) -> (b -> m ()) -> T a b -> m ()+mapM_ aAction bAction =+   sequence_ . map aAction bAction+++mapFirstM :: Monad m =>+   (a0 -> m a1) -> T a0 b -> m (T a1 b)+mapFirstM aAction =+   mapM aAction return++mapSecondM :: Monad m =>+   (b0 -> m b1) -> T a b0 -> m (T a b1)+mapSecondM bAction =+   mapM return bAction+++getFirsts :: T a b -> [a]+getFirsts = List.map pairFirst . decons++getSeconds :: T a b -> [b]+getSeconds = List.map pairSecond . decons++length :: T a b -> Int+length = List.length . getFirsts++genericLength :: Integral i => T a b -> i+genericLength = List.genericLength . getFirsts++++empty :: T a b+empty = Cons []++singleton :: a -> b -> T a b+singleton a b = Cons [Pair a b]++null :: T a b -> Bool+null = List.null . decons+++cons :: a -> b -> T a b -> T a b+cons a b = lift (Pair a b : )++snoc :: T a b -> a -> b -> T a b+snoc (Cons xs) a b = Cons (xs ++ [Pair a b])+++viewL :: T a b -> Maybe ((a, b), T a b)+viewL (Cons ys) =+   case ys of+      (Pair a b : xs) -> Just ((a, b), Cons xs)+      [] -> Nothing++mapHead :: ((a,b) -> (a,b)) -> T a b -> T a b+mapHead f =+   maybe empty (uncurry (uncurry cons) . mapFst f) . viewL+++viewR :: T a b -> Maybe (T a b, (a, b))+viewR =+   fmap (mapPair (Cons, \ ~(Pair a b) -> (a, b))) .+   Utility.viewR . decons++mapLast :: ((a,b) -> (a,b)) -> T a b -> T a b+mapLast f =+   maybe empty (uncurry (uncurry . snoc) . mapSnd f) . viewR+++foldr :: (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d+foldr f g =+   foldrPair (\ a b -> f a . g b)++foldrPair :: (a -> b -> c -> c) -> c -> T a b -> c+foldrPair f x =+   List.foldr (\ ~(Pair a b) -> f a b) x . decons+++append :: T a b -> T a b -> T a b+append (Cons xs) = lift (xs++)++concat :: [T a b] -> T a b+concat = Cons . List.concat . List.map decons++cycle :: T a b -> T a b+cycle = Cons . List.cycle . decons++++{- |+Currently it is not checked, whether n is too big.+Don't rely on the current behaviour of @splitAt n x@ for @n > length x@.+-}+splitAt :: Int -> T a b -> (T a b, T a b)+splitAt n = mapPair (Cons, Cons) . List.splitAt n . decons++take :: Int -> T a b -> T a b+take n = Cons . List.take n . decons++drop :: Int -> T a b -> T a b+drop n = Cons . List.drop n . decons+++genericSplitAt :: Integral i => i -> T a b -> (T a b, T a b)+genericSplitAt n = mapPair (Cons, Cons) . List.genericSplitAt n . decons++genericTake :: Integral i => i -> T a b -> T a b+genericTake n = Cons . List.genericTake n . decons++genericDrop :: Integral i => i -> T a b -> T a b+genericDrop n = Cons . List.genericDrop n . decons+++spanFirst :: (a -> Bool) -> T a b -> (T a b, T a b)+spanFirst p =+   mapPair (Cons, Cons) . List.span (p . pairFirst) . decons++spanSecond :: (b -> Bool) -> T a b -> (T a b, T a b)+spanSecond p =+   mapPair (Cons, Cons) . List.span (p . pairSecond) . decons++{-+filterFirst :: (a -> Bool) -> T a b -> T a [b]+filterFirst =+   foldr+      (\time ->+          if time==0+            then id+            else consBody [] . consTime time)+      (\body ->+          maybe+             (consBody [body] $ consTime 0 $ empty)+             (\(bodys,xs) -> consBody (body:bodys) xs) .+          viewBodyL)+      empty+-}++zipWithFirst :: (a0 -> a1 -> a2) -> [a0] -> T a1 b -> T a2 b+zipWithFirst f xs =+   Cons . zipWith (\x (Pair a b) -> Pair (f x a) b) xs . decons++zipWithSecond :: (b0 -> b1 -> b2) -> [b0] -> T a b1 -> T a b2+zipWithSecond f xs =+   Cons . zipWith (\x (Pair a b) -> Pair a (f x b)) xs . decons
+ src/Data/AlternatingList/List/Mixed.hs view
@@ -0,0 +1,265 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98++Functions that combine both data types,+'Data.AlternatingList.List.Disparate.T' and+'Data.AlternatingList.List.Uniform.T'+-}+module Data.AlternatingList.List.Mixed (+    consFirst, consSecond, (./), (/.),+    snocFirst, snocSecond,+    viewL, viewR, viewFirstL, viewFirstR, viewSecondL, viewSecondR,+    mapFirstL,  mapFirstHead,  mapFirstTail,+    mapSecondL, mapSecondHead, mapSecondTail,+    mapFirstR,  mapFirstLast,  mapFirstInit,+    mapSecondR, mapSecondLast, mapSecondInit,+    appendUniformUniform, appendDisparateUniform, appendUniformDisparate,+    concatUniform, concatDisparate,+    splitAtDisparateUniform, splitAtUniformDisparate, splitAtUniformUniform,+    takeDisparate, takeUniform, dropDisparate, dropUniform,+    {- spanFirst, spanSecond, spanDisparate, -}++   ) where+++import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform++import Data.AlternatingList.List.Uniform (mapSecondHead)++import qualified Control.Monad as Monad++import Data.EventList.Utility (mapPair, mapFst, mapSnd)++import Prelude hiding+   (null, foldr, map, concat, sequence, sequence_, mapM, mapM_)+++infixr 5 ./, /.++(/.) :: a -> Uniform.T a b -> Disp.T a b+(/.) = consFirst++(./) :: b -> Disp.T a b -> Uniform.T a b+(./) = consSecond+++consFirst :: a -> Uniform.T a b -> Disp.T a b+consFirst a ~(Uniform.Cons b xs) = Disp.cons a b xs++consSecond :: b -> Disp.T a b -> Uniform.T a b+consSecond = Uniform.Cons+++snocFirst :: Uniform.T a b -> a -> Disp.T b a+snocFirst xs = appendUniformUniform xs . Uniform.singleton+-- snocFirst xs a = Uniform.foldr consSecond consFirst (Uniform.singleton a) xs++snocSecond :: Disp.T b a -> b -> Uniform.T a b+snocSecond xs = appendDisparateUniform xs . Uniform.singleton+-- snocSecond xs b = Disp.foldr consSecond consFirst (Uniform.singleton b) xs+++viewL :: Uniform.T a b -> (b, Maybe (a, Uniform.T a b))+viewL = mapSnd viewFirstL . viewSecondL++viewFirstL :: Disp.T a b -> Maybe (a, Uniform.T a b)+viewFirstL =+   Monad.liftM (\((a,b), xs) -> (a, consSecond b xs)) . Disp.viewL++viewSecondL :: Uniform.T a b -> (b, Disp.T a b)+viewSecondL (Uniform.Cons b xs) = (b,xs)+++viewR :: Uniform.T a b -> (Maybe (Uniform.T a b, a), b)+viewR (Uniform.Cons b0 xs0) =+   maybe+     (Nothing, b0)+     (\ (xs, ~(a,b)) -> (Just (consSecond b0 xs, a), b)) $+     Disp.viewR xs0++viewFirstR :: Disp.T b a -> Maybe (Uniform.T a b, a)+viewFirstR =+   Monad.liftM (\ (xs, ~(a,b)) -> (snocSecond xs a, b)) .+   Disp.viewR++viewSecondR :: Uniform.T a b -> (Disp.T b a, b)+viewSecondR (Uniform.Cons b0 xs0) =+   maybe+      (Disp.empty, b0)+      (\ (xs, ~(a,b)) -> (consFirst b0 (snocSecond xs a), b))+      (Disp.viewR xs0)+++-- could also be in ListDisparate+mapFirstL ::+   (a -> a, Uniform.T a b0 -> Uniform.T a b1) ->+   Disp.T a b0 -> Disp.T a b1+mapFirstL f =+   maybe Disp.empty (uncurry consFirst . mapPair f) . viewFirstL++mapFirstHead ::+   (a -> a) ->+   Disp.T a b -> Disp.T a b+mapFirstHead f = mapFirstL (f,id)++mapFirstTail ::+   (Uniform.T a b0 -> Uniform.T a b1) ->+   Disp.T a b0 -> Disp.T a b1+mapFirstTail f = mapFirstL (id,f)+++mapSecondL ::+   (b -> b, Disp.T a0 b -> Disp.T a1 b) ->+   Uniform.T a0 b -> Uniform.T a1 b+mapSecondL f = uncurry consSecond . mapPair f . viewSecondL++{-+mapSecondHead ::+   (b -> b) ->+   Uniform.T a b -> Uniform.T a b+mapSecondHead f = mapSecondL (f,id)+-}++mapSecondTail ::+   (Disp.T a0 b -> Disp.T a1 b) ->+   Uniform.T a0 b -> Uniform.T a1 b+mapSecondTail f = mapSecondL (id,f)+++mapFirstR ::+   (Uniform.T a b0 -> Uniform.T a b1, a -> a) ->+   Disp.T b0 a -> Disp.T b1 a+mapFirstR f =+   maybe Disp.empty (uncurry snocFirst . mapPair f) . viewFirstR++-- could also be in ListDisparate+mapFirstLast ::+   (a -> a) ->+   Disp.T b a -> Disp.T b a+mapFirstLast f = mapFirstR (id,f)++mapFirstInit ::+   (Uniform.T a b0 -> Uniform.T a b1) ->+   Disp.T b0 a -> Disp.T b1 a+mapFirstInit f = mapFirstR (f,id)+++mapSecondR ::+   (Disp.T b a0 -> Disp.T b a1, b -> b) ->+   Uniform.T a0 b -> Uniform.T a1 b+mapSecondR f = uncurry snocSecond . mapPair f . viewSecondR++mapSecondLast ::+   (b -> b) ->+   Uniform.T a b -> Uniform.T a b+mapSecondLast f = mapSecondR (id,f)++mapSecondInit ::+   (Disp.T b a0 -> Disp.T b a1) ->+   Uniform.T a0 b -> Uniform.T a1 b+mapSecondInit f = mapSecondR (f,id)+++++appendUniformUniform :: Uniform.T a b -> Uniform.T b a -> Disp.T b a+appendUniformUniform xs ys =+   Uniform.foldr consSecond consFirst ys xs++appendDisparateUniform :: Disp.T b a -> Uniform.T a b -> Uniform.T a b+appendDisparateUniform xs ys =+   Disp.foldr consSecond consFirst ys xs++appendUniformDisparate :: Uniform.T a b -> Disp.T a b -> Uniform.T a b+appendUniformDisparate xs ys =+   mapSecondTail (flip Disp.append ys) xs+++concatDisparate :: Disp.T (Uniform.T b a) (Uniform.T a b) -> Disp.T a b+concatDisparate =+   Disp.foldr appendUniformUniform appendUniformDisparate Disp.empty++concatUniform :: Uniform.T (Uniform.T b a) (Uniform.T a b) -> Uniform.T a b+concatUniform =+   (\(b,xs) -> appendUniformDisparate b (concatDisparate xs)) .+   viewSecondL++++splitAtDisparateUniform :: Int -> Uniform.T a b -> (Disp.T b a, Uniform.T a b)+splitAtDisparateUniform 0 = (,) Disp.empty+splitAtDisparateUniform n =+   (\ ~(prefix,suffix) ->+       maybe+          (error "splitAtDisparateUniform: empty list")+          (mapFst (snocFirst prefix))+          (viewFirstL suffix)) .+   splitAtUniformDisparate (pred n)++splitAtUniformDisparate :: Int -> Uniform.T a b -> (Uniform.T a b, Disp.T a b)+splitAtUniformDisparate n (Uniform.Cons b xs) =+   mapFst (consSecond b) $ Disp.splitAt n xs+++splitAtUniformUniform ::+   Int -> Disp.T b a -> Maybe (Uniform.T a b, Uniform.T b a)+splitAtUniformUniform n =+   (\ ~(xs,ys) ->+        fmap+           (mapFst (snocSecond xs))+           (viewFirstL ys)) .+   Disp.splitAt n+++takeDisparate :: Int -> Uniform.T a b -> Disp.T b a+takeDisparate n =+   fst . viewSecondR . takeUniform n++takeUniform :: Int -> Uniform.T a b -> Uniform.T a b+takeUniform n (Uniform.Cons b xs) =+   consSecond b $ Disp.take n xs++dropDisparate :: Int -> Uniform.T a b -> Disp.T a b+dropDisparate n = Disp.drop n . snd . viewSecondL++dropUniform :: Int -> Uniform.T a b -> Uniform.T a b+dropUniform 0 = id+dropUniform n =+   maybe (error "dropUniform: empty list") snd .+   viewFirstL . dropDisparate (pred n)+++{-+breakDisparateFirst :: (a -> Bool) ->+   Disp.T a b -> (Disp.T a b, Disp.T a b)+breakDisparateFirst p = Disp.spanFirst (not . p)++breakUniformFirst :: (a -> Bool) ->+   Uniform.T a b -> (Uniform.T a b, Disp.T a b)+breakUniformFirst p =+   let recurse xs0 =+          (\(b,xs) ->+              if p b+                then (empty, xs0)+                else+                  maybe+                     (\(a,ys) ->)+                  let (as,) = recurse  xs+                  in  ) $+          viewSecondL xs0+-}++{-+spanSecond :: (b -> Bool) -> Uniform.T a b -> (Uniform.T a b, Disp.T b a)+spanSecond p (Uniform.Cons b xs) =+   mapFst (consSecond b) (Disp.span p xs)++spanDisparate :: (b -> Bool) -> Disp.T a b -> (Uniform.T b a, Uniform.T a b)+spanDisparate p =+   mapPair (consSecond, consSecond) . List.span (p . pairFirst) . toPairList+-}
+ src/Data/AlternatingList/List/Uniform.hs view
@@ -0,0 +1,248 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98++Lists of elements of alternating type.+This module is based on the standard list type+and may benefit from list optimizations.+-}+module Data.AlternatingList.List.Uniform+   (T(Cons),+    map, mapFirst, mapSecond,+    sequence, sequence_, mapM, mapM_, mapFirstM, mapSecondM,+    getFirsts, getSeconds, length, genericLength,+    fromFirstList, fromSecondList, fromEitherList,+    singleton, isSingleton,+    cons, snoc, mapSecondHead,+    foldr,+    format,+    filterFirst, partitionFirst, partitionMaybeFirst,+    partitionEitherFirst, unzipEitherFirst,+    filterSecond, partitionSecond, partitionMaybeSecond,+    partitionEitherSecond, unzipEitherSecond,++    catMaybesFirst, catMaybesSecond,+   ) where++import qualified Data.AlternatingList.List.Disparate as Disp++import qualified Control.Monad as Monad+import qualified Data.List as List++import Control.Monad (Monad, return, (>>))++import Test.QuickCheck (Arbitrary, arbitrary, coarbitrary)++import Data.EventList.Utility (toMaybe, mapPair, mapFst, mapSnd)+{- this way we cannot access (:) in Hugs+import Data.Maybe (Maybe, maybe)+import Text.Show (Show, ShowS, showsPrec, showParen, showString)+import Prelude+   (Bool, Int, (.), ($), id, undefined, flip, error,+    pred, fst, snd,+    Eq, Ord, Show, (>))+-}+import Prelude hiding+   (null, foldr, map, concat, length, sequence, sequence_, mapM, mapM_)+++{- |+The constructor is only exported for use in "Data.AlternatingList.List.Mixed".+-}+data T a b = Cons {+   _lead :: b,+   disp  :: Disp.T a b+   }+   deriving (Eq, Ord)+++format :: (Show a, Show b) =>+   String -> String -> Int -> T a b -> ShowS+format first second p xs =+   showParen (p>5) $+   flip (foldr+      (\a -> showsPrec 5 a . showString first)+      (\b -> showsPrec 5 b . showString second))+      xs .+      showString "empty"++instance (Show a, Show b) => Show (T a b) where+   showsPrec = format " /. " " ./ "+++instance (Arbitrary a, Arbitrary b) =>+             Arbitrary (T a b) where+   arbitrary = Monad.liftM2 Cons arbitrary arbitrary+   coarbitrary = undefined++++map :: (a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1+map f g (Cons b xs) = Cons (g b) (Disp.map f g xs)++mapFirst :: (a0 -> a1) -> T a0 b -> T a1 b+mapFirst f (Cons b xs) = Cons b (Disp.mapFirst f xs)++mapSecond :: (b0 -> b1) -> T a b0 -> T a b1+mapSecond g (Cons b xs) = Cons (g b) (Disp.mapSecond g xs)++++sequence :: Monad m =>+   T (m a) (m b) -> m (T a b)+sequence (Cons b xs) =+   Monad.liftM2 Cons b (Disp.sequence xs)++sequence_ :: Monad m =>+   T (m ()) (m ()) -> m ()+sequence_ (Cons b xs) =+   b >> Disp.sequence_ xs+++mapM :: Monad m =>+   (a0 -> m a1) -> (b0 -> m b1) ->+   T a0 b0 -> m (T a1 b1)+mapM aAction bAction =+   sequence . map aAction bAction++mapM_ :: Monad m =>+   (a -> m ()) -> (b -> m ()) -> T a b -> m ()+mapM_ aAction bAction =+   sequence_ . map aAction bAction+++mapFirstM :: Monad m =>+   (a0 -> m a1) -> T a0 b -> m (T a1 b)+mapFirstM aAction =+   mapM aAction return++mapSecondM :: Monad m =>+   (b0 -> m b1) -> T a b0 -> m (T a b1)+mapSecondM bAction =+   mapM return bAction+++getFirsts :: T a b -> [a]+getFirsts = Disp.getFirsts . disp++getSeconds :: T a b -> [b]+getSeconds (Cons b xs) = b : Disp.getSeconds xs++length :: T a b -> Int+length = List.length . getFirsts++genericLength :: Integral i => T a b -> i+genericLength = List.genericLength . getFirsts+++fromFirstList :: b -> [a] -> T a b+fromFirstList b as =+   Cons b (List.foldr (flip Disp.cons b) Disp.empty as)++fromSecondList :: a -> [b] -> T a b+fromSecondList a (b:bs) =+   Cons b (List.foldr (Disp.cons a) Disp.empty bs)+fromSecondList _ [] = error "fromSecondList: empty list"++fromEitherList :: [Either a b] -> T a [b]+fromEitherList =+   List.foldr+      (either+         (cons [])+         (mapSecondHead . (:)))+      (singleton [])+++singleton :: b -> T a b+singleton b = Cons b Disp.empty++isSingleton :: T a b -> Bool+isSingleton = Disp.null . disp+++cons :: b -> a -> T a b -> T a b+cons b0 a ~(Cons b1 xs) = Cons b0 (Disp.cons a b1 xs)+++snoc :: T a b -> a -> b -> T a b+snoc (Cons b0 xs) a b1 = Cons b0 (Disp.snoc xs a b1)+++mapSecondHead :: (b -> b) -> T a b -> T a b+mapSecondHead f (Cons b xs) = Cons (f b) xs++++foldr :: (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c+foldr f g d (Cons b xs) = g b $ Disp.foldr f g d xs++++filterFirst :: (a -> Bool) -> T a b -> T a [b]+filterFirst p =+   catMaybesFirst . mapFirst (\a -> toMaybe (p a) a)++filterSecond :: (b -> Bool) -> T a b -> T b [a]+filterSecond p =+   catMaybesSecond . mapSecond (\a -> toMaybe (p a) a)++partitionFirst :: (a -> Bool) -> T a b -> (T a [b], T a [b])+partitionFirst p =+   unzipEitherFirst .+   mapFirst (\a -> if p a then Left a else Right a)++partitionSecond :: (b -> Bool) -> T a b -> (T b [a], T b [a])+partitionSecond p =+   unzipEitherSecond .+   mapSecond (\b -> if p b then Left b else Right b)++partitionMaybeFirst :: (a0 -> Maybe a1) -> T a0 b -> (T a1 [b], T a0 [b])+partitionMaybeFirst f =+   unzipEitherFirst . mapFirst (\a0 -> maybe (Right a0) Left (f a0))++partitionMaybeSecond :: (b0 -> Maybe b1) -> T a b0 -> (T b1 [a], T b0 [a])+partitionMaybeSecond f =+   unzipEitherSecond . mapSecond (\b0 -> maybe (Right b0) Left (f b0))++partitionEitherFirst :: (a -> Either a0 a1) -> T a b -> (T a0 [b], T a1 [b])+partitionEitherFirst f =+   unzipEitherFirst . mapFirst f++partitionEitherSecond :: (b -> Either b0 b1) -> T a b -> (T b0 [a], T b1 [a])+partitionEitherSecond f =+   unzipEitherSecond . mapSecond f++unzipEitherFirst :: T (Either a0 a1) b -> (T a0 [b], T a1 [b])+unzipEitherFirst =+   foldr+      (either+          (mapFst . cons [])+          (mapSnd . cons []))+      (\b -> mapPair (mapSecondHead (b:), mapSecondHead (b:)))+      (singleton [], singleton [])++unzipEitherSecond :: T a (Either b0 b1) -> (T b0 [a], T b1 [a])+unzipEitherSecond =+   foldr+      (\a -> mapPair (mapSecondHead (a:), mapSecondHead (a:)))+      (either+          (mapFst . cons [])+          (mapSnd . cons []))+      (singleton [], singleton [])++catMaybesFirst :: T (Maybe a) b -> T a [b]+catMaybesFirst =+   foldr+      (maybe id (cons []))+      (mapSecondHead . (:))+      (singleton [])++catMaybesSecond :: T a (Maybe b) -> T b [a]+catMaybesSecond =+   foldr+      (mapSecondHead . (:))+      (maybe id (cons []))+      (singleton [])
+ src/Data/EventList/Absolute/TimeBody.hs view
@@ -0,0 +1,418 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Data.EventList.Absolute.TimeBody+   (T,+    empty, singleton, null,+    viewL, viewR, cons, snoc,+    fromPairList, toPairList,+    getTimes, getBodies, duration,+    mapBody, mapTime,+    mapM, mapM_, mapBodyM, mapTimeM,+    merge, mergeBy, insert, insertBy,+    decreaseStart, delay, filter, partition, slice, foldr, foldrPair,+    mapMaybe, catMaybes,+    normalize, isNormalized,+    collectCoincident, flatten, mapCoincident,+    append, concat, cycle,+--    splitAtTime, takeTime, dropTime,+    discretize, resample,+    checkTimes,++    collectCoincidentFoldr, collectCoincidentNonLazy, -- for testing+   ) where++import Data.EventList.Absolute.TimeBodyPrivate++import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++import qualified Data.List as List+import qualified Data.EventList.Utility as Utility++import Data.EventList.Utility+   (mapFst, mapSnd, toMaybe, isMonotonic, isMonotonicLazy, beforeBy)+import qualified Control.Monad as Monad+import Control.Monad.State (State(State), evalState)++import Prelude hiding (mapM, mapM_, null, foldr, filter, concat, cycle)+++empty :: T time body+empty = Cons $ Disp.empty++null :: T time body -> Bool+null = Disp.null . decons++singleton :: time -> body -> T time body+singleton time body = Cons $ Disp.singleton time body+++cons :: time -> body -> T time body -> T time body+cons time body = lift (Disp.cons time body)++snoc :: T time body -> time -> body -> T time body+snoc xs time body =+   Cons $ (Disp.snoc $~ xs) time body+--   lift (\ys -> Disp.snoc ys time body) xs+++viewL :: T time body -> Maybe ((time, body), T time body)+viewL = fmap (mapSnd Cons) . Disp.viewL . decons++viewR :: T time body -> Maybe (T time body, (time, body))+viewR = fmap (mapFst Cons) . Disp.viewR . decons+++fromPairList :: [(a,b)] -> T a b+fromPairList = Cons . Disp.fromPairList++toPairList :: T a b -> [(a,b)]+toPairList = Disp.toPairList . decons++getBodies :: T time body -> [body]+getBodies = Disp.getSeconds . decons++getTimes :: T time body -> [time]+getTimes = Disp.getFirsts . decons++{- |+Duration of an empty event list is considered zero.+However, I'm not sure if this is sound.+-}+duration :: Num time => T time body -> time+duration = maybe 0 (fst . snd) . viewR++++mapBody :: (body0 -> body1) -> T time body0 -> T time body1+mapBody f = lift (Disp.mapSecond f)++mapTime :: (time0 -> time1) -> T time0 body -> T time1 body+mapTime f = lift (Disp.mapFirst f)++++mapM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   T time0 body0 -> m (T time1 body1)+mapM f g = liftM (Disp.mapM f g)++mapM_ :: Monad m =>+   (time -> m ()) -> (body -> m ()) ->+   T time body -> m ()+mapM_ f g = Disp.mapM_ f g . decons+++mapBodyM :: Monad m =>+   (body0 -> m body1) -> T time body0 -> m (T time body1)+mapBodyM f = liftM (Disp.mapSecondM f)++mapTimeM :: Monad m =>+   (time0 -> m time1) -> T time0 body -> m (T time1 body)+mapTimeM f = liftM (Disp.mapFirstM f)+++{- |+Check whether time values are in ascending order.+The list is processed lazily and+times that are smaller than there predecessors are replaced by 'undefined'.+If you would remove the 'undefined' times from the resulting list+the times may still not be ordered.+E.g. consider the time list @[0,3,1,2]@+-}+checkTimes :: (Ord time) => T time body -> T time body+checkTimes xs =+   lift+      (Disp.zipWithFirst+         (\b t -> if b then t else error "times out of order")+         (isMonotonicLazy (getTimes xs)))+      xs+++foldr :: (time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b+foldr f g x = Disp.foldr f g x . decons++foldrPair :: (time -> body -> a -> a) -> a -> T time body -> a+foldrPair f x = Disp.foldrPair f x . decons+++filter :: (Num time) =>+   (body -> Bool) -> T time body -> T time body+filter p = mapMaybe (\b -> toMaybe (p b) b)++mapMaybe :: (Num time) =>+   (body0 -> Maybe body1) ->+   T time body0 -> T time body1+mapMaybe f = catMaybes . mapBody f++catMaybes :: (Num time) =>+   T time (Maybe body) -> T time body+catMaybes =+   foldrPair (maybe id . cons) empty++{-+Could be implemented more easily in terms of Uniform.partition+-}+partition ::+   (body -> Bool) -> T time body -> (T time body, T time body)+partition p =+   foldrPair+      (\ t b ->+          (if p b then mapFst else mapSnd) (cons t b))+      (empty, empty)++{- |+Since we need it later for MIDI generation,+we will also define a slicing into equivalence classes of events.+-}+slice :: (Eq a) =>+   (body -> a) -> T time body -> [(a, T time body)]+slice = Utility.slice (fmap (snd . fst) . viewL) partition+++{- |+We will also sometimes need a function which groups events by equal start times.+This implementation is not so obvious since we work with time differences.+The criterion is: Two neighbouring events start at the same time+if the second one has zero time difference.+-}+collectCoincident :: Eq time => T time body -> T time [body]+collectCoincident =+   Cons .+   maybe+      Disp.empty+      (uncurry $ \ t0 ->+         Mixed.consFirst t0 .+         Uniform.catMaybesFirst .+         flip evalState (Just t0) .+         Uniform.mapFirstM (\time -> State $ \ oldTime ->+            (Monad.guard (time /= oldTime) >> time, time)) .+         Uniform.mapFirst Just) .+   Mixed.viewFirstL .+   decons++collectCoincidentFoldr :: Eq time => T time body -> T time [body]+collectCoincidentFoldr =+   Cons .+   foldrPair+      (\t0 b0 xs ->+          Mixed.consFirst t0 $+          maybe+             (Uniform.singleton [b0])+             (\((t1,bs),ys) ->+                 if t0 == t1+                   then Mixed.consSecond (b0:bs) ys+                   else Mixed.consSecond [b0] xs) $+             Disp.viewL xs)+      Disp.empty++{- |+Will fail on infinite lists.+-}+collectCoincidentNonLazy :: Eq time => T time body -> T time [body]+collectCoincidentNonLazy =+   Cons .+   foldrPair+      (\t0 b0 xs ->+          maybe+             (Disp.singleton t0 [b0])+             (\((t1,bs),ys) ->+                 if t0 == t1+                   then Disp.cons t0 (b0:bs) ys+                   else Disp.cons t0 [b0] xs) $+             Disp.viewL xs)+      Disp.empty+++flatten :: (Ord time, Num time) => T time [body] -> T time body+flatten =+   foldrPair+      (\t bs xs -> List.foldr (cons t) xs bs)+      empty+++{- |+Apply a function to the lists of coincident events.+-}++mapCoincident :: (Ord time, Num time) =>+   ([a] -> [b]) -> T time a -> T time b+mapCoincident f = flatten . mapBody f . collectCoincident++{- |++'List.sort' sorts a list of coinciding events,+that is all events but the first one have time difference 0.+'normalize' sorts all coinciding events in a list+thus yielding a canonical representation of a time ordered list.+-}++normalize :: (Ord time, Num time, Ord body) => T time body -> T time body+normalize = mapCoincident List.sort++isNormalized :: (Ord time, Num time, Ord body) =>+   T time body -> Bool+isNormalized =+   all isMonotonic . getBodies . collectCoincident+++{- |+The first important function is 'merge'+which merges the events of two lists into a new time order list.+-}++merge :: (Ord time, Ord body) =>+   T time body -> T time body -> T time body+merge = mergeBy (<)++{- |+Note that 'merge' compares entire events rather than just start+times.  This is to ensure that it is commutative, a desirable+condition for some of the proofs used in \secref{equivalence}.+It is also necessary to assert a unique representation+of the performance independent of the structure of the 'Music.T note'.+The same function for inserting into a time ordered list with a trailing pause.+The strictness annotation is necessary for working with infinite lists.++Here are two other functions that are already known for non-padded time lists.+-}++{-+Could be implemented using as 'splitAt' and 'insert'.+-}+mergeBy :: (Ord time) =>+   (body -> body -> Bool) ->+   T time body -> T time body -> T time body+mergeBy before =+   let recurse xs0 ys0 =+          case (viewL xs0, viewL ys0) of+             (Nothing, _) -> ys0+             (_, Nothing) -> xs0+             (Just (x,xs), Just (y,ys)) ->+                if beforeBy before x y+                  then uncurry cons x $ mergeBy before xs ys0+                  else uncurry cons y $ mergeBy before ys xs0+   in  recurse++{- |+The final critical function is @insert@,+which inserts an event+into an already time-ordered sequence of events.+For instance it is used in MidiFiles to insert a @NoteOff@ event+into a list of @NoteOn@ and @NoteOff@ events.+-}++insert :: (Ord time, Ord body) =>+   time -> body -> T time body -> T time body+insert = insertBy (<)+++insertBy :: (Ord time) =>+   (body -> body -> Bool) ->+   time -> body -> T time body -> T time body+insertBy before t0 me0 mevs1 =+   let mev0 = (t0, me0)+   in  maybe+          (uncurry singleton mev0)+          (\(mev1, mevs) ->+              if beforeBy before mev0 mev1+                then uncurry cons mev0 $ mevs1+                else uncurry cons mev1 $ uncurry (insertBy before) mev0 mevs) $+       viewL mevs1+++append :: (Ord time, Num time) =>+   T time body -> T time body -> T time body+append xs = lift (Disp.append $~ xs) . delay (duration xs)++concat :: (Ord time, Num time) =>+   [T time body] -> T time body+concat xs =+   let ts = scanl (+) 0 (map duration xs)+   in  Cons $ Disp.concat $ map decons $ zipWith delay ts xs++cycle :: (Ord time, Num time) =>+   T time body -> T time body+cycle = concat . List.repeat++++{-+splitAtTime :: (Ord time, Num time) =>+   time -> T time body -> (Uniform.T body time, T time body)+splitAtTime t0 =+   maybe+      (Uniform.singleton 0, empty)+      (\(t1,xs) ->+          if t0<=t1+            then (Uniform.singleton t0, consTime (t1-t0) xs)+            else+               (\(b,ys) -> mapFst (Uniform.cons t1 b) (splitAtTime (t0-t1) ys))+               (viewBodyL xs)) .+   viewTimeL++takeTime :: (Ord time, Num time) =>+   time -> T time body -> Uniform.T body time+takeTime t = fst . splitAtTime t++dropTime :: (Ord time, Num time) =>+   time -> T time body -> T time body+dropTime t = snd . splitAtTime t+-}+++decreaseStart :: (Ord time, Num time) =>+   time -> T time body -> T time body+decreaseStart dif =+   maybe+      empty+      (\((t, b), xs) ->+         cons+            (if t>=dif+               then t-dif+               else error "decreaseStart: difference too big") b+            (mapTime (subtract dif) xs)) .+      viewL++delay :: (Ord time, Num time) =>+   time -> T time body -> T time body+delay dif =+   if dif>=0+     then mapTime (dif+)+     else error "delay: negative delay"++++{- |++Here are some functions for discretizing the time information.+When converting the precise relative event times+to the integer relative event times+we have to prevent accumulation of rounding errors.+We avoid this problem with a stateful conversion+which remembers each rounding error we make.+This rounding error is used to correct the next rounding.+Given the relative time and duration of a note+the function @discretizeEventM@ creates a @State@+which computes the rounded relative time.+It is corrected by previous rounding errors.++The resulting event list may have differing time differences+which were equal before discretization,+but the overall timing is uniformly close to the original.++-}++discretize :: (RealFrac time, Integral i) =>+   T time body -> T i body+discretize = mapTime round++resample :: (RealFrac time, Integral i) =>+   time -> T time body -> T i body+resample rate = discretize . mapTime (rate*)
+ src/Data/EventList/Absolute/TimeBodyPrivate.hs view
@@ -0,0 +1,36 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Data.EventList.Absolute.TimeBodyPrivate where++import qualified Data.AlternatingList.List.Disparate as Disp+-- import qualified Data.AlternatingList.List.Uniform as Uniform+-- import qualified Data.AlternatingList.List.Mixed as Mixed++import qualified Control.Monad as Monad++++newtype T time body = Cons {decons :: Disp.T time body}+   deriving (Eq, Ord, Show)+++infixl 5 $~++($~) :: (Disp.T time body -> a) -> (T time body -> a)+($~) f = f . decons+++lift ::+   (Disp.T time0 body0 -> Disp.T time1 body1) ->+   (T time0 body0 -> T time1 body1)+lift f = Cons . f . decons++liftM :: Monad m =>+   (Disp.T time0 body0 -> m (Disp.T time1 body1)) ->+   (T time0 body0 -> m (T time1 body1))+liftM f = Monad.liftM Cons . f . decons
+ src/Data/EventList/Absolute/TimeMixed.hs view
@@ -0,0 +1,22 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Data.EventList.Absolute.TimeMixed+   (snocBody, snocTime, -- (/.), (./),+    viewTimeR, viewBodyR,+    mapTimeInit,+    ) where++import Data.EventList.Absolute.TimeTimePrivate+-- import qualified Data.EventList.Absolute.TimeBody as TimeBodyList+-- import qualified Data.EventList.Absolute.TimeTime as TimeTimeList++-- import qualified Data.AlternatingList.List.Disparate as Disp+-- import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++-- import Data.AlternatingList.List.Mixed ((/.), (./))
+ src/Data/EventList/Absolute/TimeTime.hs view
@@ -0,0 +1,284 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98++Event list with absolute times starting with a time and ending with a body+-}+module Data.EventList.Absolute.TimeTime+   (T,+    pause, isPause,+    viewL, cons, snoc,+    mapBody, mapTime,+    mapM, mapM_, mapBodyM, mapTimeM,+    getTimes, getBodies, duration,+    merge, mergeBy, insert, insertBy,+    decreaseStart, delay, filter, partition, slice, foldr,+    mapMaybe, catMaybes,+    normalize, isNormalized,+    collectCoincident, flatten, mapCoincident,+    append, concat, cycle,+    discretize, resample,+   ) where++import Data.EventList.Absolute.TimeTimePrivate+import Data.EventList.Absolute.TimeBodyPrivate (($~))+import qualified Data.EventList.Absolute.TimeBodyPrivate as TimeBodyPriv+import qualified Data.EventList.Absolute.TimeBody as TimeBodyList++import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++import qualified Data.List as List+import qualified Data.EventList.Utility as Utility++import Data.EventList.Utility (mapPair, mapSnd, toMaybe, isMonotonic)+import qualified Control.Monad as Monad+import Control.Monad.State (State(State), evalState)++import Data.Maybe (fromMaybe)++import Prelude hiding+   (null, foldr, map, filter, concat, cycle, sequence, sequence_, mapM, mapM_)++++pause :: time -> T time body+pause = Cons . Uniform.singleton++isPause :: T time body -> Bool+isPause = Uniform.isSingleton . decons++++getBodies :: T time body -> [body]+getBodies = Uniform.getFirsts . decons++getTimes :: T time body -> [time]+getTimes = Uniform.getSeconds . decons++duration :: Num time => T time body -> time+duration = snd . viewTimeR+-- duration = last . getTimes++++cons :: time -> body -> T time body -> T time body+cons time body = lift (Uniform.cons time body)++snoc :: T time body -> body -> time -> T time body+snoc xs body time =+   Cons $ (Uniform.snoc $* xs) body time+++viewL :: T time body -> (time, Maybe (body, T time body))+viewL =+   mapSnd (fmap (mapSnd Cons) . Mixed.viewFirstL) .+   Mixed.viewSecondL .+   decons+++mapBody :: (body0 -> body1) -> T time body0 -> T time body1+mapBody = lift . Uniform.mapFirst++mapTime :: (time0 -> time1) -> T time0 body -> T time1 body+mapTime = lift . Uniform.mapSecond++++mapM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   T time0 body0 -> m (T time1 body1)+mapM f g = liftM (Uniform.mapM g f)++mapM_ :: Monad m =>+   (time -> m ()) -> (body -> m ()) ->+   T time body -> m ()+mapM_ f g = Uniform.mapM_ g f . decons+++mapBodyM :: Monad m =>+   (body0 -> m body1) -> T time body0 -> m (T time body1)+mapBodyM = liftM . Uniform.mapFirstM++mapTimeM :: Monad m =>+   (time0 -> m time1) -> T time0 body -> m (T time1 body)+mapTimeM = liftM . Uniform.mapSecondM++++foldr :: (time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b+foldr f g x = Uniform.foldr g f x . decons+++filter :: (Num time) =>+   (body -> Bool) -> T time body -> T time body+filter p = mapMaybe (\b -> toMaybe (p b) b)++mapMaybe :: (Num time) =>+   (body0 -> Maybe body1) ->+   T time body0 -> T time body1+mapMaybe f = catMaybes . mapBody f++catMaybes :: (Num time) =>+   T time (Maybe body) -> T time body+catMaybes =+   mapTimeInit TimeBodyList.catMaybes++{-+Could be implemented more easily in terms of Uniform.partition+-}+partition ::+   (body -> Bool) -> T time body -> (T time body, T time body)+partition p =+   (\(xs,t) ->+      mapPair+         (flip snocTime t, flip snocTime t)+         (TimeBodyList.partition p xs)) .+   viewTimeR++slice :: (Eq a, Num time) =>+   (body -> a) -> T time body -> [(a, T time body)]+slice =+   Utility.slice+      (fmap fst . snd . viewL)+      partition+++collectCoincident :: Eq time => T time body -> T time [body]+collectCoincident =+   Cons .+   (uncurry $ \ t0 ->+      Mixed.consSecond t0 .+      Mixed.mapFirstInit+         (Uniform.catMaybesFirst .+          flip evalState (Just t0) .+          Uniform.mapFirstM (\time -> State $ \ oldTime ->+             (Monad.guard (time /= oldTime) >> time, time)) .+          Uniform.mapFirst Just)) .+   Mixed.viewSecondL .+   decons+++flatten :: (Ord time, Num time) => T time [body] -> T time body+flatten = mapTimeInit TimeBodyList.flatten+++{- |+Apply a function to the lists of coincident events.+-}++mapCoincident :: (Ord time, Num time) =>+   ([a] -> [b]) -> T time a -> T time b+mapCoincident f = flatten . mapBody f . collectCoincident++{- |++'List.sort' sorts a list of coinciding events,+that is all events but the first one have time difference 0.+'normalize' sorts all coinciding events in a list+thus yielding a canonical representation of a time ordered list.+-}++normalize :: (Ord time, Num time, Ord body) => T time body -> T time body+normalize = mapCoincident List.sort++isNormalized :: (Ord time, Num time, Ord body) =>+   T time body -> Bool+isNormalized =+   all isMonotonic . getBodies . collectCoincident++++merge :: (Ord time, Ord body) =>+   T time body -> T time body -> T time body+merge = mergeBy (<)++mergeBy :: (Ord time) =>+   (body -> body -> Bool) ->+   T time body -> T time body -> T time body+mergeBy before xs0 ys0 =+   let (xs,xt) = viewTimeR xs0+       (ys,yt) = viewTimeR ys0+   in  snocTime+          (TimeBodyList.mergeBy before xs ys)+          (max xt yt)++insert :: (Ord time, Ord body) =>+   time -> body -> T time body -> T time body+insert = insertBy (<)++insertBy :: (Ord time) =>+   (body -> body -> Bool) ->+   time -> body -> T time body -> T time body+insertBy before t0 me0 mevs1 =+   let mev0 = (t0, me0)+       (t1,mxs) = viewL mevs1+   in  maybe+          (uncurry cons mev0 $ pause (max t0 t1))+          (\(ev1, mevs) ->+              let mev1 = (t1,ev1)+              in  if Utility.beforeBy before mev0 mev1+                    then uncurry cons mev0 $ mevs1+                    else uncurry cons mev1 $ uncurry (insertBy before) mev0 mevs)+          mxs++++append :: (Ord time, Num time) =>+   T time body -> T time body -> T time body+append =+   (\(xs, t) -> lift (Mixed.appendDisparateUniform $~ xs) . delay t) .+   viewTimeR++concat :: (Ord time, Num time) =>+   [T time body] -> T time body+concat xs =+   let ts0 = scanl (+) 0 (List.map duration xs)+       (ts,dur) =+          fromMaybe+             (error "list of accumulated times is always non-empty")+             (Utility.viewR ts0)+   in  snocTime+          (TimeBodyPriv.Cons $ Disp.concat $ List.map TimeBodyPriv.decons $+           zipWith TimeBodyList.delay ts (List.map (fst . viewTimeR) xs))+          dur++cycle :: (Ord time, Num time) =>+   T time body -> T time body+cycle = concat . List.repeat+++decreaseStart :: (Ord time, Num time) =>+   time -> T time body -> T time body+decreaseStart dif =+   Cons .+   (\(t, xs) ->+      Mixed.consSecond+         (if t>=dif+            then t-dif+            else error "decreaseStart: difference too big")+         (Disp.mapSecond (subtract dif) xs)) .+   Mixed.viewSecondL .+   decons++delay :: (Ord time, Num time) =>+   time -> T time body -> T time body+delay dif =+   if dif>=0+     then mapTime (dif+)+     else error "delay: negative delay"+++discretize :: (RealFrac time, Integral i) =>+   T time body -> T i body+discretize = mapTime round++resample :: (RealFrac time, Integral i) =>+   time -> T time body -> T i body+resample rate =+   discretize . mapTime (rate*)+
+ src/Data/EventList/Absolute/TimeTimePrivate.hs view
@@ -0,0 +1,65 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Data.EventList.Absolute.TimeTimePrivate where++import qualified Data.EventList.Absolute.TimeBodyPrivate as TimeBodyList++import Data.EventList.Absolute.TimeBodyPrivate (($~))++-- import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++import Data.EventList.Utility (mapFst)++import qualified Control.Monad as Monad+++newtype T time body = Cons {decons :: Uniform.T body time}+   deriving (Eq, Ord, Show)++infixl 5 $*++($*) :: (Uniform.T body time -> a) -> (T time body -> a)+($*) f = f . decons+++lift ::+   (Uniform.T body0 time0 -> Uniform.T body1 time1) ->+   (T time0 body0 -> T time1 body1)+lift f = Cons . f . decons++liftM :: Monad m =>+   (Uniform.T body0 time0 -> m (Uniform.T body1 time1)) ->+   (T time0 body0 -> m (T time1 body1))+liftM f = Monad.liftM Cons . f . decons+++snocBody :: T time body -> body -> TimeBodyList.T time body+snocBody xs =+   TimeBodyList.Cons . (Mixed.snocFirst $* xs)++snocTime :: TimeBodyList.T time body -> time -> T time body+snocTime xs =+   Cons . (Mixed.snocSecond $~ xs)+++viewTimeR :: T time body -> (TimeBodyList.T time body, time)+viewTimeR =+   mapFst TimeBodyList.Cons . Mixed.viewSecondR . decons++viewBodyR :: TimeBodyList.T time body -> Maybe (T time body, body)+viewBodyR =+   fmap (mapFst Cons) . Mixed.viewFirstR . TimeBodyList.decons+++mapTimeInit ::+   (TimeBodyList.T time body0 -> TimeBodyList.T time body1) ->+   T time body0 -> T time body1+mapTimeInit f = uncurry snocTime . mapFst f . viewTimeR+
+ src/Data/EventList/Relative/BodyBody.hs view
@@ -0,0 +1,29 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+++Event lists starting with a body and ending with a body.++-}+module Data.EventList.Relative.BodyBody+   (T,+    mapM,+   ) where++import Data.EventList.Relative.BodyBodyPrivate++-- import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform++import Prelude hiding (mapM)+++mapM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   T time0 body0 -> m (T time1 body1)+mapM f g = liftM (Uniform.mapM f g)+
+ src/Data/EventList/Relative/BodyBodyPrivate.hs view
@@ -0,0 +1,52 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Data.EventList.Relative.BodyBodyPrivate where++-- import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform+-- import qualified Data.AlternatingList.List.Mixed as Mixed++import qualified Control.Monad as Monad++import Test.QuickCheck (Arbitrary(..))++++newtype T time body = Cons {decons :: Uniform.T time body}+   deriving (Eq, Ord)++instance (Show time, Show body) => Show (T time body) where+   showsPrec p = Uniform.format " /. " " ./ " p . decons+++instance (Arbitrary time, Arbitrary body) =>+             Arbitrary (T time body) where+   arbitrary = Monad.liftM Cons arbitrary+   coarbitrary = undefined+++infixl 5 $**++($**) :: (Uniform.T time body -> a) -> (T time body -> a)+($**) f = f . decons+++lift ::+   (Uniform.T time0 body0 -> Uniform.T time1 body1) ->+   (T time0 body0 -> T time1 body1)+lift f = Cons . f . decons++liftM :: Monad m =>+   (Uniform.T time0 body0 -> m (Uniform.T time1 body1)) ->+   (T time0 body0 -> m (T time1 body1))+liftM f = Monad.liftM Cons . f . decons++unlift ::+   (T time0 body0 -> T time1 body1) ->+   (Uniform.T time0 body0 -> Uniform.T time1 body1)+unlift f = decons . f . Cons
+ src/Data/EventList/Relative/BodyTime.hs view
@@ -0,0 +1,32 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+++Event lists starting with a body and ending with a time difference.++-}+module Data.EventList.Relative.BodyTime+   (T, mapM, empty, ) where++import Data.EventList.Relative.BodyTimePrivate++import qualified Data.AlternatingList.List.Disparate as Disp+-- import qualified Data.AlternatingList.List.Uniform as Uniform++import Prelude hiding+   (mapM)+++mapM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   T time0 body0 -> m (T time1 body1)+mapM timeAction bodyAction =+   liftM (Disp.mapM bodyAction timeAction)+++empty :: T time body+empty = Cons Disp.empty
+ src/Data/EventList/Relative/BodyTimePrivate.hs view
@@ -0,0 +1,70 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Data.EventList.Relative.BodyTimePrivate where++import qualified Data.AlternatingList.List.Disparate as Disp+-- import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++import qualified Control.Monad as Monad++import Test.QuickCheck (Arbitrary(..))++++newtype T time body = Cons {decons :: Disp.T body time}+   deriving (Eq, Ord)++instance (Show time, Show body) => Show (T time body) where+   showsPrec p = Disp.format " ./ " " /. " p . decons+++instance (Arbitrary time, Arbitrary body) =>+             Arbitrary (T time body) where+   arbitrary = Monad.liftM Cons arbitrary+   coarbitrary = undefined+++infixl 5 $*~++($*~) :: (Disp.T body time -> a) -> (T time body -> a)+($*~) f = f . decons+++lift ::+   (Disp.T body0 time0 -> Disp.T body1 time1) ->+   (T time0 body0 -> T time1 body1)+lift f = Cons . f . decons++liftM :: Monad m =>+   (Disp.T body0 time0 -> m (Disp.T body1 time1)) ->+   (T time0 body0 -> m (T time1 body1))+liftM f = Monad.liftM Cons . f . decons++unlift ::+   (T time0 body0 -> T time1 body1) ->+   (Disp.T body0 time0 -> Disp.T body1 time1)+unlift f = decons . f . Cons++++concat :: -- (NonNeg.C time) =>+   [T time body] -> T time body+concat =+   Cons . Disp.concat . map decons+++cycle :: -- (NonNeg.C time) =>+   T time body -> T time body+cycle = lift Disp.cycle+++mapTimeLast ::+   (time -> time) ->+   T time body -> T time body+mapTimeLast = lift . Mixed.mapFirstLast
+ src/Data/EventList/Relative/MixedBody.hs view
@@ -0,0 +1,55 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+++Event lists starting with a body and ending with a time difference.++-}+module Data.EventList.Relative.MixedBody+   (consBody, consTime, (/.), (./), empty,+    viewTimeL, viewBodyL,+    mapTimeL, mapTimeHead, mapTimeTail,+   ) where++import Data.EventList.Relative.TimeBody (empty)++import qualified Data.EventList.Relative.TimeBody as TimeBodyList+import qualified Data.EventList.Relative.BodyBody as BodyBodyList++import qualified Data.EventList.Relative.TimeBodyPrivate as TimeBodyPriv+import qualified Data.EventList.Relative.BodyBodyPrivate as BodyBodyPriv++import Data.EventList.Relative.TimeBodyPrivate (mapTimeL, mapTimeHead, mapTimeTail,)++-- import qualified Data.AlternatingList.List.Disparate as Disp+-- import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++-- import Data.AlternatingList.List.Mixed ((/.), (./))++import Data.EventList.Utility (mapSnd)+++consBody, (./) :: body -> TimeBodyList.T time body -> BodyBodyList.T time body+consBody b = BodyBodyPriv.Cons . Mixed.consSecond b . TimeBodyPriv.decons++consTime, (/.) :: time -> BodyBodyList.T time body -> TimeBodyList.T time body+consTime t = TimeBodyPriv.Cons . Mixed.consFirst t . BodyBodyPriv.decons++infixr 5 /. , ./++(./) = consBody++(/.) = consTime++viewTimeL :: TimeBodyList.T time body -> Maybe (time, BodyBodyList.T time body)+viewTimeL =+   fmap (mapSnd BodyBodyPriv.Cons) . Mixed.viewFirstL . TimeBodyPriv.decons++viewBodyL :: BodyBodyList.T time body -> (body, TimeBodyList.T time body)+viewBodyL = mapSnd TimeBodyPriv.Cons . Mixed.viewSecondL . BodyBodyPriv.decons+
+ src/Data/EventList/Relative/MixedTime.hs view
@@ -0,0 +1,61 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+++Event lists starting with a body and ending with a time difference.++-}+module Data.EventList.Relative.MixedTime+   (consBody, consTime, (/.), (./), empty,+    viewTimeL, viewBodyL,+    mapTimeL, mapTimeHead, mapTimeTail,+    mapBodyL, mapBodyHead, mapBodyTail,+   ) where++import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimePriv+import           Data.EventList.Relative.TimeTimePrivate as TimeTimePriv++import qualified Data.EventList.Relative.BodyTime as BodyTimeList+import qualified Data.EventList.Relative.TimeTime as TimeTimeList++import Data.EventList.Relative.BodyTime (empty)++-- import qualified Data.AlternatingList.List.Disparate as Disp+-- import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++-- import Data.AlternatingList.List.Mixed ((/.), (./))++import Data.EventList.Utility (mapSnd)++import Prelude hiding+   (null, foldr, map, filter, concat, cycle, sequence, sequence_, mapM, mapM_)+++infixr 5 /. , ./++(./) :: body -> TimeTimeList.T time body -> BodyTimeList.T time body+(./) = consBody++(/.) :: time -> BodyTimeList.T time body -> TimeTimeList.T time body+(/.) = consTime++mapBodyL ::+   (body -> body, TimeTimeList.T time0 body -> TimeTimeList.T time1 body) ->+   BodyTimeList.T time0 body -> BodyTimeList.T time1 body+mapBodyL = BodyTimePriv.lift . Mixed.mapFirstL . mapSnd TimeTimePriv.unlift++mapBodyHead ::+   (body -> body) ->+   BodyTimeList.T time body -> BodyTimeList.T time body+mapBodyHead = BodyTimePriv.lift . Mixed.mapFirstHead++mapBodyTail ::+   (TimeTimeList.T time0 body -> TimeTimeList.T time1 body) ->+   BodyTimeList.T time0 body -> BodyTimeList.T time1 body+mapBodyTail = BodyTimePriv.lift . Mixed.mapFirstTail . TimeTimePriv.unlift+
+ src/Data/EventList/Relative/TimeBody.hs view
@@ -0,0 +1,423 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+++Event lists starting with a time difference and ending with a body.+++The time is stored in differences between the events.+Thus there is no increase of time information for long,+or even infinite, streams of events.+Further on, the time difference is stored+in the latter of two neighbouring events.+This is necessary for real-time computing+where it is not known whether and when the next event happens.++-}+module Data.EventList.Relative.TimeBody+   (T,+    empty, singleton, null,+    viewL, viewR, cons, snoc,+    fromPairList, toPairList,+    getTimes, getBodies, duration,+    mapBody, mapTime,+    mapM, mapM_, mapBodyM, mapTimeM,+    foldr, foldrPair,+    merge, mergeBy, insert, insertBy,+    decreaseStart, delay, filter, partition, slice, span,+    mapMaybe, catMaybes,+    normalize, isNormalized,+    collectCoincident, flatten, mapCoincident,+    append, concat, cycle,+    discretize, resample,+    toAbsoluteEventList, fromAbsoluteEventList,+   ) where++import Data.EventList.Relative.TimeBodyPrivate+import qualified Data.EventList.Relative.BodyBodyPrivate as BodyBodyPriv++import qualified Data.EventList.Absolute.TimeBodyPrivate as AbsoluteEventPriv+import qualified Data.EventList.Absolute.TimeBody as AbsoluteEventList++import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++import qualified Data.List as List+import qualified Data.EventList.Utility as Utility++import qualified Numeric.NonNegative.Class as NonNeg+import Data.EventList.Utility (floorDiff, mapFst, mapSnd, toMaybe, isMonotonic, beforeBy)+import Control.Monad.State (evalState, modify, get, put)++import Prelude hiding (mapM, mapM_, null, foldr, filter, concat, cycle, span)++++empty :: T time body+empty = Cons Disp.empty++null :: T time body -> Bool+null = Disp.null . decons++singleton :: time -> body -> T time body+singleton time body = Cons $ Disp.singleton time body+++cons :: time -> body -> T time body -> T time body+cons time body = lift (Disp.cons time body)++snoc :: T time body -> time -> body -> T time body+snoc xs time body = Cons $ (Disp.snoc $~* xs) time body++++viewL :: T time body -> Maybe ((time, body), T time body)+viewL = fmap (mapSnd Cons) . Disp.viewL . decons++viewR :: T time body -> Maybe (T time body, (time, body))+viewR = fmap (mapFst Cons) . Disp.viewR . decons++++fromPairList :: [(a,b)] -> T a b+fromPairList = Cons . Disp.fromPairList++toPairList :: T a b -> [(a,b)]+toPairList = Disp.toPairList . decons++getBodies :: T time body -> [body]+getBodies = Disp.getSeconds . decons++getTimes :: T time body -> [time]+getTimes = Disp.getFirsts . decons++duration :: Num time => T time body -> time+duration = sum . getTimes++++mapBody :: (body0 -> body1) -> T time body0 -> T time body1+mapBody f = lift (Disp.mapSecond f)++mapTime :: (time0 -> time1) -> T time0 body -> T time1 body+mapTime f = lift (Disp.mapFirst f)++++mapM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   T time0 body0 -> m (T time1 body1)+mapM f g = liftM (Disp.mapM f g)++mapM_ :: Monad m =>+   (time -> m ()) -> (body -> m ()) ->+   T time body -> m ()+mapM_ f g = Disp.mapM_ f g . decons+++mapBodyM :: Monad m =>+   (body0 -> m body1) -> T time body0 -> m (T time body1)+mapBodyM f = liftM (Disp.mapSecondM f)++mapTimeM :: Monad m =>+   (time0 -> m time1) -> T time0 body -> m (T time1 body)+mapTimeM f = liftM (Disp.mapFirstM f)+++++foldr :: (time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b+foldr f g x = Disp.foldr f g x . decons++foldrPair :: (time -> body -> a -> a) -> a -> T time body -> a+foldrPair f x = Disp.foldrPair f x . decons+++{- |++The function 'partition' is somehow the inverse to 'merge'.+It is similar to 'List.partition'.+We could use the List function if the event times would be absolute,+because then the events need not to be altered on splits.+But absolute time points can't be used for infinite music+thus we take the burden of adapting the time differences+when an event is removed from the performance list and+put to the list of events of a particular instrument.+@t0@ is the time gone since the last event in the first partition,+@t1@ is the time gone since the last event in the second partition.++Note, that using 'Data.EventList.Utility.mapPair' we circumvent the following problem:+Since the recursive call to 'partition'+may end up with Bottom,+pattern matching with, say \expression{(es0,es1)},+will halt the bounding of the variables+until the most inner call to 'partition' is finished.+This never happens.+If the pair constructor is made strict,+that is we write \expression{~(es0,es1)},+then everything works.+Also avoiding pattern matching and+using 'fst' and 'snd' would help.++-}++filter :: (Num time) =>+   (body -> Bool) -> T time body -> T time body+filter p = mapMaybe (\b -> toMaybe (p b) b)+-- filter p = fst . partition p++mapMaybe :: (Num time) =>+   (body0 -> Maybe body1) ->+   T time body0 -> T time body1+mapMaybe f = catMaybes . mapBody f++catMaybes :: (Num time) =>+   T time (Maybe body) -> T time body+catMaybes =+   Cons .+   fst . Mixed.viewSecondR .+   Uniform.mapSecond sum .+   Uniform.catMaybesFirst .+   flip Mixed.snocSecond (error "catMaybes: no trailing time") .+   decons++{-+Could be implemented more easily in terms of Uniform.partition+-}+partition :: (Num time) =>+   (body -> Bool) -> T time body -> (T time body, T time body)+partition p = partitionRec p 0 0++partitionRec :: (Num time) =>+   (body -> Bool) -> time -> time ->+       T time body -> (T time body, T time body)+partitionRec p =+   let recurse t0 t1 =+          maybe+             (empty, empty)+             (\ ((t, b), es) ->+                let t0' = t0 + t+                    t1' = t1 + t+                in  if p b+                      then mapFst (cons t0' b) (recurse 0 t1' es)+                      else mapSnd (cons t1' b) (recurse t0' 0 es)) .+          viewL+   in  recurse++{- |+Since we need it later for MIDI generation,+we will also define a slicing into equivalence classes of events.+-}+slice :: (Eq a, Num time) =>+   (body -> a) -> T time body -> [(a, T time body)]+slice = Utility.slice (fmap (snd . fst) . viewL) partition+++span :: (body -> Bool) -> T time body -> (T time body, T time body)+span p = Utility.mapPair (Cons, Cons) . Disp.spanSecond p . decons+++{- |+We will also sometimes need a function which groups events by equal start times.+This implementation is not so obvious since we work with time differences.+The criterion is: Two neighbouring events start at the same time+if the second one has zero time difference.+-}+collectCoincident :: (NonNeg.C time) => T time body -> T time [body]+collectCoincident =+   mapTimeTail $ BodyBodyPriv.lift $ Uniform.filterFirst (0<)++flatten :: (NonNeg.C time) => T time [body] -> T time body+flatten =+   Cons .+   maybe+      Disp.empty+      (uncurry $ \time ->+         unlift (delay time) .+         fst . Mixed.viewSecondR .+         Uniform.foldr+            (Mixed.appendUniformUniform . Uniform.fromSecondList 0)+            Mixed.consSecond Disp.empty .+         Uniform.mapSecond sum .+         Uniform.filterSecond (not . List.null)) .+   Mixed.viewFirstL .+   decons+++{- |+Apply a function to the lists of coincident events.+-}++mapCoincident :: (NonNeg.C time) =>+   ([a] -> [b]) -> T time a -> T time b+mapCoincident f = flatten . mapBody f . collectCoincident++{- |+++'List.sort' sorts a list of coinciding events,+that is all events but the first one have time difference 0.+'normalize' sorts all coinciding events in a list+thus yielding a canonical representation of a time ordered list.+-}++normalize :: (NonNeg.C time, Ord body) => T time body -> T time body+normalize = mapCoincident List.sort++isNormalized :: (NonNeg.C time, Ord body) =>+   T time body -> Bool+isNormalized =+   all isMonotonic . getBodies . collectCoincident++++{- |+The first important function is 'merge'+which merges the events of two lists into a new time order list.+-}++merge :: (NonNeg.C time, Ord body) =>+   T time body -> T time body -> T time body+merge = mergeBy (<)++{- |+Note that 'merge' compares entire events rather than just start+times.  This is to ensure that it is commutative, a desirable+condition for some of the proofs used in \secref{equivalence}.+It is also necessary to assert a unique representation+of the performance independent of the structure of the 'Music.T note'.+The same function for inserting into a time ordered list with a trailing pause.+The strictness annotation is necessary for working with infinite lists.++Here are two other functions that are already known for non-padded time lists.+-}++{-+Could be implemented using as 'splitAt' and 'insert'.+-}+mergeBy :: (NonNeg.C time) =>+   (body -> body -> Bool) ->+   T time body -> T time body -> T time body+mergeBy before xs0 ys0 =+   case (viewL xs0, viewL ys0) of+      (Nothing, _) -> ys0+      (_, Nothing) -> xs0+      (Just (x@(xt,xb),xs), Just (y@(yt,yb),ys)) ->+         if beforeBy before x y+           then uncurry cons x $ mergeBy before xs $ cons (yt-xt) yb ys+           else uncurry cons y $ mergeBy before ys $ cons (xt-yt) xb xs+++{- |+The final critical function is @insert@,+which inserts an event+into an already time-ordered sequence of events.+For instance it is used in MidiFiles to insert a @NoteOff@ event+into a list of @NoteOn@ and @NoteOff@ events.+-}++insert :: (NonNeg.C time, Ord body) =>+   time -> body -> T time body -> T time body+insert t0 me0 =+   maybe+      (singleton t0 me0)+      (\(mev1@(t1, me1), mevs) ->+          let mev0 = (t0, me0)+          in  if mev0 < mev1+                then uncurry cons mev0 $ cons   (t1-t0) me1 mevs+                else uncurry cons mev1 $ insert (t0-t1) me0 mevs)+    . viewL++++insertBy :: (NonNeg.C time, Ord body) =>+   (body -> body -> Bool) ->+   time -> body -> T time body -> T time body+insertBy before t0 me0 =+   maybe+      (singleton t0 me0)+      (\(mev1@(t1, me1), mevs) ->+          if beforeBy before (t0, me0) mev1+            then cons t0 me0 $ cons   (t1-t0) me1 mevs+            else cons t1 me1 $ insert (t0-t1) me0 mevs)+    . viewL+++append :: T time body -> T time body -> T time body+append xs = lift (Disp.append $~* xs)++concat :: [T time body] -> T time body+concat = Cons . Disp.concat . map decons++cycle :: T time body -> T time body+cycle = lift Disp.cycle++++decreaseStart :: (NonNeg.C time) =>+   time -> T time body -> T time body+decreaseStart dif =+   mapTimeHead (subtract dif)++delay :: (NonNeg.C time) =>+   time -> T time body -> T time body+delay dif =+   mapTimeHead (dif+)++++{- |+We provide 'discretize' and 'resample' for discretizing the time information.+When converting the precise relative event times+to the integer relative event times+we have to prevent accumulation of rounding errors.+We avoid this problem with a stateful conversion+which remembers each rounding error we make.+This rounding error is used to correct the next rounding.+Given the relative time and duration of an event+the function 'floorDiff' creates a 'Control.Monad.State.State'+which computes the rounded relative time.+It is corrected by previous rounding errors.++The resulting event list may have differing time differences+which were equal before discretization,+but the overall timing is uniformly close to the original.++We use 'floorDiff' rather than 'Utility.roundDiff'+in order to compute exclusively with non-negative numbers.+-}++discretize :: (NonNeg.C time, RealFrac time, NonNeg.C i, Integral i) =>+   T time body -> T i body+discretize =+   flip evalState 0.5 . mapTimeM floorDiff++resample :: (NonNeg.C time, RealFrac time, NonNeg.C i, Integral i) =>+   time -> T time body -> T i body+resample rate =+   discretize . mapTime (rate*)+++{- |+We tried hard to compute everything with respect to relative times.+However sometimes we need absolute time values.+-}+toAbsoluteEventList :: (Num time) =>+   time -> T time body -> AbsoluteEventList.T time body+toAbsoluteEventList start =+   AbsoluteEventPriv.Cons . decons .+   flip evalState start .+   mapTimeM (\dur -> modify (dur+) >> get)++fromAbsoluteEventList :: (Num time) =>+   AbsoluteEventList.T time body -> T time body+fromAbsoluteEventList =+   flip evalState 0 .+   mapTimeM+      (\time -> do lastTime <- get; put time; return (time-lastTime)) .+   Cons . AbsoluteEventPriv.decons
+ src/Data/EventList/Relative/TimeBodyPrivate.hs view
@@ -0,0 +1,75 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Data.EventList.Relative.TimeBodyPrivate where++import qualified Data.EventList.Relative.BodyBodyPrivate as BodyBodyList+import qualified Data.EventList.Relative.BodyBodyPrivate as BodyBodyPriv++import qualified Data.AlternatingList.List.Disparate as Disp+-- import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++import qualified Control.Monad as Monad++import Data.EventList.Utility (mapSnd)++import Test.QuickCheck (Arbitrary(..))++++newtype T time body = Cons {decons :: Disp.T time body}+   deriving (Eq, Ord)+++instance (Show time, Show body) => Show (T time body) where+   showsPrec p = Disp.format " /. " " ./ " p . decons+++instance (Arbitrary time, Arbitrary body) =>+             Arbitrary (T time body) where+   arbitrary = Monad.liftM Cons arbitrary+   coarbitrary = undefined+++infixl 5 $~*++($~*) :: (Disp.T time body -> a) -> (T time body -> a)+($~*) f = f . decons+++lift ::+   (Disp.T time0 body0 -> Disp.T time1 body1) ->+   (T time0 body0 -> T time1 body1)+lift f = Cons . f . decons++liftM :: Monad m =>+   (Disp.T time0 body0 -> m (Disp.T time1 body1)) ->+   (T time0 body0 -> m (T time1 body1))+liftM f = Monad.liftM Cons . f . decons++unlift ::+   (T time0 body0 -> T time1 body1) ->+   (Disp.T time0 body0 -> Disp.T time1 body1)+unlift f = decons . f . Cons++++mapTimeL ::+   (time -> time, BodyBodyList.T time body0 -> BodyBodyList.T time body1) ->+   T time body0 -> T time body1+mapTimeL = lift . Mixed.mapFirstL . mapSnd BodyBodyPriv.unlift++mapTimeHead ::+   (time -> time) ->+   T time body -> T time body+mapTimeHead = lift . Mixed.mapFirstHead++mapTimeTail ::+   (BodyBodyList.T time body0 -> BodyBodyList.T time body1) ->+   T time body0 -> T time body1+mapTimeTail = lift . Mixed.mapFirstTail . BodyBodyPriv.unlift
+ src/Data/EventList/Relative/TimeMixed.hs view
@@ -0,0 +1,121 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+++Event lists starting with a body and ending with a time difference.++-}+module Data.EventList.Relative.TimeMixed+   (snocBody, snocTime,+--    (/.), (./),+    viewTimeR, viewBodyR,+    mapTimeR, mapTimeLast, mapTimeInit,+    mapBodyR, mapBodyLast, mapBodyInit,+    appendBodyEnd, prependBodyEnd,+    splitAtTime, takeTime, dropTime,+   ) where++import qualified Data.EventList.Relative.TimeBody as TimeBodyList+import qualified Data.EventList.Relative.TimeTime as TimeTimeList++import qualified Data.EventList.Relative.TimeBodyPrivate as TimeBodyPriv+import qualified Data.EventList.Relative.TimeTimePrivate as TimeTimePriv+-- import Data.EventList.Relative.TimeBodyPrivate (($~*))++import Data.EventList.Relative.TimeTimePrivate+   (viewTimeR, viewBodyR, mapTimeR, mapTimeLast, mapTimeInit)++import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++-- import Data.AlternatingList.List.Mixed ((/.), (./))++import qualified Numeric.NonNegative.Class as NonNeg+import Data.EventList.Utility (mapFst, mapPair)+++snocBody :: TimeTimeList.T time body -> body -> TimeBodyList.T time body+snocBody xs = TimeBodyPriv.Cons . Mixed.snocFirst (TimeTimePriv.decons xs)++snocTime :: TimeBodyList.T time body -> time -> TimeTimeList.T time body+snocTime xs = TimeTimePriv.Cons . Mixed.snocSecond (TimeBodyPriv.decons xs)++++mapBodyR ::+   (TimeTimeList.T time0 body -> TimeTimeList.T time1 body, body -> body) ->+   TimeBodyList.T time0 body -> TimeBodyList.T time1 body+mapBodyR = TimeBodyPriv.lift . Mixed.mapFirstR . mapFst TimeTimePriv.unlift++mapBodyLast ::+   (body -> body) ->+   TimeBodyList.T time body -> TimeBodyList.T time body+mapBodyLast = TimeBodyPriv.lift . Mixed.mapFirstLast++mapBodyInit ::+   (TimeTimeList.T time0 body -> TimeTimeList.T time1 body) ->+   TimeBodyList.T time0 body -> TimeBodyList.T time1 body+mapBodyInit = TimeBodyPriv.lift . Mixed.mapFirstInit . TimeTimePriv.unlift+++{-+propInsertPadded :: Event time body -> T time body -> Bool+propInsertPadded (Event time body) evs =+   TimeBodyList.insert time body (fst evs)  ==  fst (insert time body evs)+-}++{- |+This is not a good name, expect a change.+-}+appendBodyEnd :: (NonNeg.C time) =>+   TimeTimeList.T time body -> TimeBodyList.T time body -> TimeBodyList.T time body+appendBodyEnd =+   (\ ~(xs, t) -> TimeBodyList.append xs . TimeBodyList.delay t) .+   viewTimeR++{- |+This is not a good name, expect a change.+-}+prependBodyEnd ::+   TimeBodyList.T time body -> TimeTimeList.T time body -> TimeTimeList.T time body+prependBodyEnd =+   TimeTimePriv.lift . Mixed.appendDisparateUniform . TimeBodyPriv.decons++++splitAtTimeAux :: (NonNeg.C time) =>+   time -> Disp.T time body ->+   (Uniform.T body time, Disp.T time body)+splitAtTimeAux t0 =+   maybe+      (Uniform.singleton 0, Disp.empty)+      (\(t1,xs) ->+          if t0<=t1+            then (Uniform.singleton t0, Mixed.consFirst (t1-t0) xs)+            else+               (\(b,ys) -> mapFst (Uniform.cons t1 b) (splitAtTimeAux (t0-t1) ys))+               (Mixed.viewSecondL xs)) .+   Mixed.viewFirstL++splitAtTime :: (NonNeg.C time) =>+   time -> TimeBodyList.T time body ->+   (TimeTimeList.T time body, TimeBodyList.T time body)+splitAtTime t0 =+   mapPair (TimeTimePriv.Cons, TimeBodyPriv.Cons) .+   splitAtTimeAux t0 .+   TimeBodyPriv.decons++takeTime :: (NonNeg.C time) =>+   time -> TimeBodyList.T time body -> TimeTimeList.T time body+takeTime t = fst . splitAtTime t++dropTime :: (NonNeg.C time) =>+   time -> TimeBodyList.T time body -> TimeBodyList.T time body+dropTime t = snd . splitAtTime t++
+ src/Data/EventList/Relative/TimeTime.hs view
@@ -0,0 +1,414 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98++Event lists starting with a time difference and ending with a time difference.+-}+module Data.EventList.Relative.TimeTime+   (T,+    mapBody, mapTime,+    mapM, mapM_, mapBodyM, mapTimeM,+    getTimes, getBodies, duration,+    merge, mergeBy, insert,+    decreaseStart, delay, filter, partition, slice, foldr,+    pause, isPause, cons, snoc, viewL, viewR,+    mapMaybe, catMaybes,+    append, concat, concatNaive, cycle, cycleNaive,+    splitAtTime, takeTime, dropTime,+    discretize, resample,+    collectCoincident, flatten, mapCoincident,+    normalize, isNormalized,+    toAbsoluteEventList, fromAbsoluteEventList,+   ) where++import Data.EventList.Relative.TimeTimePrivate as TimeTimePriv+import Data.EventList.Relative.TimeBodyPrivate (($~*))++import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimePriv+import qualified Data.EventList.Relative.TimeBody as TimeBodyList++import qualified Data.EventList.Absolute.TimeTimePrivate as AbsoluteEventPriv+import qualified Data.EventList.Absolute.TimeTime as AbsoluteEventList++import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++import qualified Data.List as List+import qualified Data.EventList.Utility as Utility++import qualified Numeric.NonNegative.Class as NonNeg+import Data.EventList.Utility (floorDiff, mapPair, mapFst, mapSnd, toMaybe, isMonotonic)+import qualified Control.Monad.State as Monad+import Control.Monad.State (evalState, modify, get, put)++import Prelude hiding+   (null, foldr, map, filter, concat, cycle, sequence, sequence_, mapM, mapM_)++++pause :: time -> T time body+pause = Cons . Uniform.singleton++isPause :: T time body -> Bool+isPause = Uniform.isSingleton . decons++++getBodies :: T time body -> [body]+getBodies = Uniform.getFirsts . decons++getTimes :: T time body -> [time]+getTimes = Uniform.getSeconds . decons++duration :: Num time => T time body -> time+duration = sum . getTimes++++cons :: time -> body -> T time body -> T time body+cons time body = lift (Uniform.cons time body)++snoc :: T time body -> body -> time -> T time body+snoc xs body time =+   Cons $ (Uniform.snoc $~~ xs) body time+++viewL :: T time body -> (time, Maybe (body, T time body))+viewL =+   mapSnd (fmap (mapSnd Cons)) .+   Mixed.viewL .+   decons++viewR :: T time body -> (Maybe (T time body, body), time)+viewR =+   mapFst (fmap (mapFst Cons)) . Mixed.viewR . decons+++mapBody :: (body0 -> body1) -> T time body0 -> T time body1+mapBody = lift . Uniform.mapFirst++mapTime :: (time0 -> time1) -> T time0 body -> T time1 body+mapTime = lift . Uniform.mapSecond++++mapM :: Monad m =>+   (time0 -> m time1) -> (body0 -> m body1) ->+   T time0 body0 -> m (T time1 body1)+mapM f g = liftM (Uniform.mapM g f)++mapM_ :: Monad m =>+   (time -> m ()) -> (body -> m ()) ->+   T time body -> m ()+mapM_ f g = Uniform.mapM_ g f . decons+++mapBodyM :: Monad m =>+   (body0 -> m body1) -> T time body0 -> m (T time body1)+mapBodyM = liftM . Uniform.mapFirstM++mapTimeM :: Monad m =>+   (time0 -> m time1) -> T time0 body -> m (T time1 body)+mapTimeM = liftM . Uniform.mapSecondM++++{- |+Sort coincident elements.+-}+normalize :: (Ord body, NonNeg.C time) =>+   T time body -> T time body+normalize = mapCoincident List.sort++isNormalized :: (NonNeg.C time, Ord body) =>+   T time body -> Bool+isNormalized =+   all isMonotonic . getBodies . collectCoincident+++{- |+The first important function is 'merge'+which merges the events of two lists into a new time order list.+-}++merge :: (NonNeg.C time, Ord body) =>+   T time body -> T time body -> T time body+merge = mergeBy (<)++{-+Could be implemented using as 'splitAt' and 'insert'.+-}+mergeBy :: (NonNeg.C time) =>+   (body -> body -> Bool) ->+   T time body -> T time body -> T time body+mergeBy before xs0 ys0 =+   let (xt,xs) = viewTimeL xs0+       (yt,ys) = viewTimeL ys0+   in  case compare xt yt of+          LT -> mergeFirstBy before xs0 ys0+          GT -> mergeFirstBy before ys0 xs0+          EQ ->+             consTime xt $+             case (viewBodyL xs, viewBodyL ys) of+                (Nothing, _) -> ys+                (_, Nothing) -> xs+                (Just (b0,xs1), Just (b1,ys1)) ->+                   {- do not insert both b0 and b1 immediately,+                      because the later one of b0 and b1 may be pushed even further,+                      thus recurse with 'mergeBy' on xs or ys -}+                   if before b0 b1+                     then consBody b0 $ mergeBy before xs1 $ consTime 0 ys+                     else consBody b1 $ mergeBy before ys1 $ consTime 0 xs++{- | merge two time ordered lists provided that e0 is earlier than e1 -}+mergeFirstBy :: (NonNeg.C time) =>+   (body -> body -> Bool) ->+   T time body -> T time body -> T time body+mergeFirstBy before xs0 ys0 =+   let (xt,xs) = viewTimeL xs0+       (yt,ys) = viewTimeL ys0+   in  maybe+          ys0+          (\(b,xs1) ->+              consTime xt $ consBody b $ mergeBy before xs1 $ consTime (yt-xt) ys)+          (viewBodyL xs)+++{- |+Note that 'merge' compares entire events rather than just start+times.  This is to ensure that it is commutative, a desirable+condition for some of the proofs used in \secref{equivalence}.+It is also necessary to assert a unique representation+of the performance independent of the structure of the 'Music.T note'.+The same function for inserting into a time ordered list with a trailing pause.+The strictness annotation is necessary for working with infinite lists.++Here are two other functions that are already known for non-padded time lists.+-}++insert :: (NonNeg.C time, Ord body) =>+   time -> body -> T time body -> T time body+insert = insertBy (<)++{-+Ordering of bodies at the same time+could be simplified using collectCoincident.+-}+insertBy :: (NonNeg.C time) =>+   (body -> body -> Bool) ->+   time -> body -> T time body -> T time body+insertBy before t0 me0 =+   let recurseTime t =+          (\ (t1,xs) ->+             if t<t1+               then cons t me0 (consTime (t1-t) xs)+               else recurseBody t1 t xs)+            . viewTimeL+       recurseBody t1 t =+          maybe+             (cons t me0 $ pause 0)+             (\(me1,xs) ->+                 consTime t1 $+                    if t==t1 && before me0 me1+                      then consBody me0 (cons 0 me1 xs)+                      else consBody me1 (recurseTime (t-t1) xs))+            . viewBodyL+   in   recurseTime t0++append :: (NonNeg.C time) =>+   T time body -> T time body -> T time body+append =+   (\(xs, t) -> lift (Mixed.appendDisparateUniform $~* xs) . delay t) .+   viewTimeR++concat :: (NonNeg.C time) =>+   [T time body] -> T time body+concat =+   flatten . consTime 0 .+   BodyTimePriv.concat .+   List.map (consBody [] . mapBody (:[]))++{- |+'concat' and 'concatNaive' are essentially the same.+'concat' must use 'foldr' in order to work on infinite lists,+however if there are many empty lists,+summing of their durations will be done from right to left,+which is inefficient.+Thus we detect subsequent empty lists and merge them from left to right.+-}+concatNaive :: (NonNeg.C time) =>+   [T time body] -> T time body+concatNaive = List.foldr append (pause 0)+++{- |+Uses sharing.+-}+cycle :: (NonNeg.C time) =>+   T time body -> T time body+cycle =+   (\(t0,xs) ->+       consTime t0 $+       BodyTimePriv.cycle $+       BodyTimePriv.mapTimeLast (+t0) xs) .+   viewTimeL+++cycleNaive :: (NonNeg.C time) =>+   T time body -> T time body+cycleNaive = concat . List.repeat++++{- |+If there is an event at the cutting time,+this event is returned in the suffix part.+That is+@splitAtTime t0 (t0 ./ x /. t1 ./ empty) ==+    (pause t0, 0 ./ x /. t1 ./ empty)@+-}+{-+It could also be implemented by inserting a marker element+and then splitting at this element.+I hope that the current manual recursion routine is the most efficient solution.+-}+splitAtTime :: (NonNeg.C time) =>+   time -> T time body -> (T time body, T time body)+splitAtTime t0 =+   (\(t1,xs) ->+        if t0<=t1+          then (pause t0, consTime (t1-t0) xs)+          else+             maybe+                (pause t1, pause 0)+                (\(b,ys) -> mapFst (cons t1 b) (splitAtTime (t0-t1) ys))+                (viewBodyL xs)) .+   viewTimeL++takeTime :: (NonNeg.C time) =>+   time -> T time body -> T time body+takeTime t = fst . splitAtTime t++dropTime :: (NonNeg.C time) =>+   time -> T time body -> T time body+dropTime t = snd . splitAtTime t+++decreaseStart :: (NonNeg.C time) =>+   time -> T time body -> T time body+decreaseStart dif =+   mapTimeHead (subtract dif)++delay :: (NonNeg.C time) =>+   time -> T time body -> T time body+delay dif =+   mapTimeHead (dif+)++{- |++-}++collectCoincident :: (NonNeg.C time) => T time body -> T time [body]+collectCoincident =+   mapTimeInit TimeBodyList.collectCoincident+++flatten :: (Num time) => T time [body] -> T time body+flatten =+   Cons .+   Uniform.foldr+      (Mixed.appendUniformUniform . Uniform.fromSecondList 0)+      Mixed.consSecond    -- consTime+      Disp.empty .+--      (\(b:bs) xs -> consBody b (List.foldr (cons 0) xs bs)) empty .+   Uniform.mapSecond sum .+   Uniform.filterFirst (not . List.null) .+   decons++++mapCoincident :: (NonNeg.C time) =>+   ([a] -> [b]) -> T time a -> T time b+mapCoincident f =+   flatten . mapBody f . collectCoincident+++{- |+Analogously to the 'concat' \/ 'concatNaive' pair+we have to versions of 'filter',+where the clever implementation sums up pauses+from the beginning to the end.+-}++filter :: (Num time) =>+   (body -> Bool) ->+   T time body -> T time body+filter p = mapMaybe (\b -> toMaybe (p b) b)++mapMaybe :: (Num time) =>+   (body0 -> Maybe body1) ->+   T time body0 -> T time body1+mapMaybe f = catMaybes . mapBody f++catMaybes :: (Num time) =>+   T time (Maybe body) -> T time body+catMaybes = mapTime sum . lift Uniform.catMaybesFirst++partition :: (Num time) =>+   (body -> Bool) ->+   T time body -> (T time body, T time body)+partition p =+   mapPair (mapTime sum, mapTime sum) .+   mapPair (Cons, Cons) .+   Uniform.partitionFirst p .+   decons++{- |+Since we need it later for MIDI generation,+we will also define a slicing into equivalence classes of events.+-}+slice :: (Eq a, Num time) =>+   (body -> a) -> T time body -> [(a, T time body)]+slice = Utility.slice (fmap fst . viewBodyL . snd . viewTimeL) partition++{- |++-}++foldr :: (time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b+foldr f g x = Uniform.foldr g f x . decons++{- |++-}+++discretize :: (NonNeg.C time, RealFrac time, NonNeg.C i, Integral i) =>+   T time body -> T i body+discretize =+   flip evalState 0.5 . mapTimeM floorDiff++resample :: (NonNeg.C time, RealFrac time, NonNeg.C i, Integral i) =>+   time -> T time body -> T i body+resample rate =+   discretize . mapTime (rate*)+++toAbsoluteEventList :: (Num time) =>+   time -> T time body -> AbsoluteEventList.T time body+toAbsoluteEventList start =+   AbsoluteEventPriv.Cons . decons .+   flip evalState start .+   mapTimeM (\dur -> modify (dur+) >> get)++fromAbsoluteEventList :: (Num time) =>+   AbsoluteEventList.T time body -> T time body+fromAbsoluteEventList =+   flip evalState 0 .+   mapTimeM+      (\time -> do lastTime <- get; put time; return (time-lastTime)) .+   Cons . AbsoluteEventPriv.decons
+ src/Data/EventList/Relative/TimeTimePrivate.hs view
@@ -0,0 +1,114 @@+{- |+Copyright   :  (c) Henning Thielemann 2007++Maintainer  :  haskell@henning-thielemann.de+Stability   :  stable+Portability :  Haskell 98+-}+module Data.EventList.Relative.TimeTimePrivate where++import qualified Data.EventList.Relative.TimeBodyPrivate as TimeBodyList+import qualified Data.EventList.Relative.TimeBodyPrivate as TimeBodyPriv++import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimeList+import qualified Data.EventList.Relative.BodyTimePrivate as BodyTimePriv++-- import qualified Data.AlternatingList.List.Disparate as Disp+import qualified Data.AlternatingList.List.Uniform as Uniform+import qualified Data.AlternatingList.List.Mixed as Mixed++import Data.EventList.Utility (mapFst, mapSnd)++import qualified Control.Monad as Monad++import Test.QuickCheck (Arbitrary(..))++++newtype T time body = Cons {decons :: Uniform.T body time}+   deriving (Eq, Ord)+++instance (Show time, Show body) => Show (T time body) where+   showsPrec p = Uniform.format " ./ " " /. " p . decons++instance (Arbitrary time, Arbitrary body) =>+             Arbitrary (T time body) where+   arbitrary = Monad.liftM Cons arbitrary+   coarbitrary = undefined+++infixl 5 $~~++($~~) :: (Uniform.T body time -> a) -> (T time body -> a)+($~~) f = f . decons+++lift ::+   (Uniform.T body0 time0 -> Uniform.T body1 time1) ->+   (T time0 body0 -> T time1 body1)+lift f = Cons . f . decons++liftM :: Monad m =>+   (Uniform.T body0 time0 -> m (Uniform.T body1 time1)) ->+   (T time0 body0 -> m (T time1 body1))+liftM f = Monad.liftM Cons . f . decons++unlift ::+   (T time0 body0 -> T time1 body1) ->+   (Uniform.T body0 time0 -> Uniform.T body1 time1)+unlift f = decons . f . Cons+++++consBody :: body -> T time body -> BodyTimeList.T time body+consBody b = BodyTimePriv.Cons . Mixed.consFirst b . decons++consTime :: time -> BodyTimeList.T time body -> T time body+consTime t = Cons . Mixed.consSecond t . BodyTimePriv.decons++viewTimeL :: T time body -> (time, BodyTimeList.T time body)+viewTimeL = mapSnd BodyTimePriv.Cons . Mixed.viewSecondL . decons++viewBodyL :: BodyTimeList.T time body -> Maybe (body, T time body)+viewBodyL = fmap (mapSnd Cons) . Mixed.viewFirstL . BodyTimePriv.decons+++viewTimeR :: T time body -> (TimeBodyList.T time body, time)+viewTimeR = mapFst TimeBodyPriv.Cons . Mixed.viewSecondR . decons++viewBodyR :: TimeBodyList.T time body -> Maybe (T time body, body)+viewBodyR = fmap (mapFst Cons) . Mixed.viewFirstR . TimeBodyPriv.decons+++mapTimeL ::+   (time -> time, BodyTimeList.T time body0 -> BodyTimeList.T time body1) ->+   T time body0 -> T time body1+mapTimeL = lift . Mixed.mapSecondL . mapSnd BodyTimePriv.unlift++mapTimeHead ::+   (time -> time) ->+   T time body -> T time body+mapTimeHead = lift . Mixed.mapSecondHead++mapTimeTail ::+   (BodyTimeList.T time body0 -> BodyTimeList.T time body1) ->+   T time body0 -> T time body1+mapTimeTail = lift . Mixed.mapSecondTail . BodyTimePriv.unlift+++mapTimeR ::+   (TimeBodyList.T time body0 -> TimeBodyList.T time body1, time -> time) ->+   T time body0 -> T time body1+mapTimeR = lift . Mixed.mapSecondR . mapFst TimeBodyPriv.unlift++mapTimeLast ::+   (time -> time) ->+   T time body -> T time body+mapTimeLast = lift . Mixed.mapSecondLast++mapTimeInit ::+   (TimeBodyList.T time body0 -> TimeBodyList.T time body1) ->+   T time body0 -> T time body1+mapTimeInit = lift . Mixed.mapSecondInit . TimeBodyPriv.unlift
+ src/Data/EventList/Utility.hs view
@@ -0,0 +1,139 @@+module Data.EventList.Utility where++-- State monad could be avoided by mapAccumL+import Control.Monad.State (State(State), modify, gets)+import qualified Data.List as List++{- |+Given the time fraction that remains from the preceding event+and the current time difference,+evaluate an integer time difference and+the remaining fractional part.+If we would simply map Time to integer values+with respect to the sampling rate,+then rounding errors would accumulate.+-}++roundDiff' :: (RealFrac t, Integral i) => t -> t -> (i, t)+roundDiff' time frac =+   let x = time+frac+       n = round x+   in  (n, x - fromIntegral n)++roundDiff :: (RealFrac t, Integral i) => t -> State t i+roundDiff = State . roundDiff'++{-+We could use 'properFraction' but this is inconsistent for negative values.+-}+floorDiff :: (RealFrac t, Integral i) => t -> State t i+floorDiff t =+   do modify (t+)+      n <- gets floor+      modify (subtract (fromIntegral n))+      return n++-- Control.Arrow.***+mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)+mapPair ~(f,g) ~(x,y) = (f x, g y)++-- Control.Arrow.first+mapFst :: (a -> c) -> (a,b) -> (c,b)+mapFst f ~(x,y) = (f x, y)++-- Control.Arrow.second+mapSnd :: (b -> d) -> (a,b) -> (a,d)+mapSnd g ~(x,y) = (x, g y)+++toMaybe :: Bool -> a -> Maybe a+toMaybe False _ = Nothing+toMaybe True  x = Just x+++{-|+Given two lists that are ordered+(i.e. @p x y@ holds for subsequent @x@ and @y@)+'mergeBy' them into a list that is ordered, again.++This used for merging event lists with absolute time stamps.+-}++mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]+mergeBy p =+   let recurse xl@(x:xs) yl@(y:ys) =+         if p x y then x : recurse xs yl+                  else y : recurse xl ys+       recurse [] yl = yl+       recurse xl [] = xl+   in  recurse+++beforeBy :: (Ord time) =>+   (body -> body -> Bool) ->+   (time, body) -> (time, body) ->  Bool+beforeBy before (t0, me0) (t1, me1) =+   case compare t0 t1 of+      LT -> True+      EQ -> before me0 me1+      GT -> False+++{- |+This is a combination of 'init' and 'last'+which avoids memoizing the list+if the last element is accessed after the initial ones.++> let a = [0..10000000::Int] in (last (init a), last a)+> let a = [0..10000000::Int]; (bs,b)=splitInit a in (last bs, b)+-}+splitInit :: [a] -> ([a], a)+splitInit (x:xs) =+   if null xs+     then ([], x)+     else mapFst (x:) (splitInit xs)+splitInit [] = error "splitInit: empty list"++propSplitInit :: Eq a => [a] -> Bool+propSplitInit xs =+   splitInit xs  ==  (init xs, last xs)+++viewR :: [a] -> Maybe ([a], a)+viewR =+   foldr (\x mxs -> Just (maybe ([],x) (mapFst (x:)) mxs)) Nothing++propViewR :: Eq a => [a] -> Bool+propViewR xs =+   maybe True+      ((init xs, last xs) == )+      (viewR xs)+++composeDouble :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)+composeDouble g f x y = g (f x) (f y)++equalField :: Eq b => (a -> b) -> a -> a -> Bool+equalField = composeDouble (==)+++isMonotonic :: (Ord a) => [a] -> Bool+isMonotonic = and . isMonotonicLazy++isMonotonicLazy :: (Ord a) => [a] -> [Bool]+isMonotonicLazy xs = zipWith (<=) xs (tail xs)++++slice :: (Eq a) =>+   (eventlist -> Maybe body) ->+   ((body -> Bool) -> eventlist -> (eventlist, eventlist)) ->+   (body -> a) -> eventlist -> [(a, eventlist)]+slice hd partition f =+   List.unfoldr (\ pf ->+      fmap+         ((\ i ->+            mapPair+               ((,) i, id)+               (partition ((i==) . f) pf)) . f)+         (hd pf))