diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,4 @@ # Change log -cabal-gild follows the [Package Versioning Policy](https://pvp.haskell.org). +Gild follows the [Package Versioning Policy](https://pvp.haskell.org). You can find release notes [on GitHub](https://github.com/tfausak/cabal-gild/releases). diff --git a/LICENSE.txt b/LICENSE.txt --- a/LICENSE.txt +++ b/LICENSE.txt @@ -1,674 +1,21 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - 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. - - - Copyright (C) - - 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 . - -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: +MIT License - Copyright (C) - 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. +Copyright (c) 2024 Taylor Fausak -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". +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: - 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 -. +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. - 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 -. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,63 +1,172 @@ -# cabal-gild +# Gild -## Synopsis +[![Workflow](https://github.com/tfausak/cabal-gild/actions/workflows/workflow.yaml/badge.svg)](https://github.com/tfausak/cabal-gild/actions/workflows/workflow.yaml) +[![Hackage](https://img.shields.io/hackage/v/cabal-gild)](https://hackage.haskell.org/package/cabal-gild) +[![Stackage](https://www.stackage.org/package/cabal-gild/badge/nightly?label=stackage)](https://www.stackage.org/package/cabal-gild) -```sh -$ cabal install cabal-gild -$ ... -$ cabal-gild --inplace example.cabal +Gild is an opinionated command line utility that formats Haskell package +descriptions, which are also known as `*.cabal` files. + +## Summary + +Given a package description like this: + +``` cabal +CABAL-VERSION : 3.0 +name : example +version : 0.0.0.0 + +library + build-depends: mtl>=2.3, base + ghc-options: -Wall + if impl(ghc>=9.8) + ghc-options: -Wmissing-role-annotations ``` -## Output +Gild will produce output like this: -Turns this... +``` cabal +cabal-version: 3.0 +name: example +version: 0.0.0.0 -```cabal -cabal-version: 2.4 -name: cabal-gild -version: 0 +library + build-depends: + base, + mtl >=2.3, --- An example formatter -executable cabal-gild - default-language: Haskell2010 - hs-source-dirs: src - main-is: CabalGild.hs - -- build depends will be in - -- a nice tabular format - build-depends: base >=4.11 && <4.13, pretty >=1.1.3.6 && <1.2, bytestring, Cabal ^>=2.5, containers ^>=0.5.11.0 || ^>=0.6.0.1 - -- extensions will be sorted - other-extensions: - DeriveFunctor FlexibleContexts ExistentialQuantification OverloadedStrings - RankNTypes + ghc-options: -Wall + + if impl(ghc >= 9.8) + ghc-options: -Wmissing-role-annotations ``` -...into this: +See the [installation][] section for how to get Gild and the [usage][] section +for how to use it. -```cabal -cabal-version: 2.4 -name: cabal-gild -version: 0 +[installation]: #installation +[usage]: #usage --- An example formatter -executable cabal-gild - default-language: Haskell2010 - hs-source-dirs: src - main-is: CabalGild.hs +## Goals - -- build depends will be in - -- a nice tabular format - build-depends: - , base >=4.11 && <4.13 - , bytestring - , Cabal ^>=2.5 - , containers ^>=0.5.11.0 || ^>=0.6.0.1 - , pretty >=1.1.3.6 && <1.2 +- There should be no configuration options. As long as the output format is + reasonable, the specifics should not matter too much. This means the amount + of indentation cannot be changed, for example. - -- extensions will be sorted - other-extensions: - DeriveFunctor - ExistentialQuantification - FlexibleContexts - OverloadedStrings - RankNTypes +- The output should be diff friendly. This means things generally go on their + own line, trailing commas are used when possible, and elements are sorted + where it makes sense. + +- The output should be semantically the same as the input. This means no + normalization or canonicalization. For example, separate `build-depends` + fields are not merged together. + +- It should be possible to format other files that use the same format as + package descriptions. This means `cabal.project` files can be formatted as + well. + +- The focus is on formatting only. There should be no effort made to validate + input or provide any checks or lints. + +- The command line utility should be fast enough to run on every save. It + should not need network access. + +## Installation + +Go to the [latest release][] page and download the binary for your platform. + +[latest release]: https://github.com/tfausak/cabal-gild/releases/latest + +### From Source + +In general you should prefer downloading the appropriate binary for you +platform. However it is possible to build Gild from source. It supports Linux, +macOS, and Windows along with the three most recent versions of GHC. Any other +configurations are unsupported. + +With Cabal: + +``` sh +$ cabal install cabal-gild ``` + +With Stack: + +``` sh +$ stack install cabal-gild +``` + +## Usage + +Gild is a command line utility named `cabal-gild`. By default it reads from +standard input (STDIN) and writes to standard output (STDOUT). Its behavior can +be modified with command line options, which are described below. + +### Options + +Run `cabal-gild --help` to see the options that Gild supports. They are: + +- `--help`: Prints the help message to STDOUT then exits successfully. + +- `--version`: Prints the version number to STDOUT then exits successfully. + +- `--input=FILE`: Uses `FILE` as the input. If this is `-` (which is the + default), then the input will be read from STDIN. + +- `--mode=MODE`: Sets the mode to `MODE`, which must be either `format` (the + default) or `check`. When the mode is `format`, Gild will output the + formatted package description. When the mode is `check`, Gild will exit + successfully if the input is already formatted, otherwise it will exit + unsuccessfully. + +- `--output=FILE`: Uses `FILE` as the output. If this is `-` (which is the + default), then the output will be written to STDOUT. To modify a file in + place, use the same file as both input and output. For example: + + ``` sh + $ cabal-gild --input p.cabal --output p.cabal + ``` + + This option is ignored when the mode is `check`. + +- `--stdin=FILE`: When reading input from STDIN, use `FILE` as the effective + input file. This is useful when a file's contents are already available, like + in an editor. For example: + + ``` sh + $ cabal-gild --stdin p.cabal < p.cabal + ``` + + This option is ignored when the input is not `-`. + +### Pragmas + +Gild supports special comments in package descriptions that act as pragmas. +Each pragma starts with `-- cabal-gild:`. Pragmas must be the last comment +before a field. + +- `-- cabal-gild: discover DIRECTORY`: This pragma will discover any Haskell + files (`*.hs`) in the given directory and use those to populate the list of + modules. For example, given this input: + + ``` cabal + library + -- cabal-gild: discover source/library + exposed-modules: ... + ``` + + Assuming there is a single Haskell file at `source/library/M.hs`, Gild will + produce this output: + + ``` cabal + library + -- cabal-gild: discover source/library + exposed-modules: M + ``` + + This pragma only works with the `exposed-modules` and `other-modules` fields. + It will be ignored on all other fields. + + Any existing modules in the list will be ignored. The entire field will be + replaced. This means adding, removing, and renaming modules should be handled + automatically. diff --git a/cabal-gild.cabal b/cabal-gild.cabal --- a/cabal-gild.cabal +++ b/cabal-gild.cabal @@ -1,120 +1,131 @@ -cabal-version: 2.2 -name: cabal-gild -version: 0.2.1.1 -synopsis: Format .cabal files -category: Development -description: - Format @.cabal@ files preserving the original field ordering, and comments. - . - Tuned for Oleg's preference, but has some knobs still. - -license: GPL-3.0-or-later AND BSD-3-Clause -license-file: LICENSE.txt -author: Oleg Grenrus -maintainer: Taylor Fausak +cabal-version: 2.2 +author: Taylor Fausak +category: Development +description: Gild formats package descriptions. extra-doc-files: CHANGELOG.md README.md -extra-source-files: - fixtures/*.cabal - fixtures/*.format +license: MIT +license-file: LICENSE.txt +maintainer: Taylor Fausak +name: cabal-gild +synopsis: Formats package descriptions. +version: 0.3.0.0 source-repository head - type: git + type: git location: https://github.com/tfausak/cabal-gild flag pedantic default: False - manual: True + manual: True common library - build-depends: base ^>=4.17.2.1 || ^>=4.18.2.0 || ^>=4.19.0.0 + build-depends: base ^>=4.17.0.0 || ^>=4.18.0.0 || ^>=4.19.0.0 default-language: Haskell2010 ghc-options: - -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude - -Wno-missed-specialisations -Wno-missing-deriving-strategies - -Wno-missing-export-lists -Wno-missing-import-lists - -Wno-missing-kind-signatures -Wno-missing-safe-haskell-mode - -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe + -Weverything + -Wno-all-missed-specialisations + -Wno-implicit-prelude + -Wno-missed-specialisations + -Wno-missing-deriving-strategies + -Wno-missing-export-lists + -Wno-missing-import-lists + -Wno-missing-kind-signatures + -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module + -Wno-safe + -Wno-unsafe - if impl(ghc >=9.8) + if impl(ghc >= 9.8) ghc-options: -Wno-missing-role-annotations if flag(pedantic) ghc-options: -Werror common executable - import: library + import: library build-depends: cabal-gild - ghc-options: -rtsopts -threaded + ghc-options: + -rtsopts + -threaded library - import: library - hs-source-dirs: source/library - other-modules: Paths_cabal_gild + import: library autogen-modules: Paths_cabal_gild - - -- GHC boot libraries build-depends: - , bytestring ^>=0.11.5.3 || ^>=0.12.0.2 - , Cabal-syntax ^>=3.8.1.0 || ^>=3.10.1.0 - , containers ^>=0.6.7 - , directory ^>=1.3.7.1 - , exceptions ^>=0.10.5 - , filepath ^>=1.4.2.2 - , mtl ^>=2.2.2 || ^>=2.3.1 - , parsec ^>=3.1.16.1 - , pretty ^>=1.1.3.6 + Cabal-syntax ^>=3.8.1.0 || ^>=3.10.1.0, + bytestring ^>=0.11.3.1 || ^>=0.12.0.2, + containers ^>=0.6.6, + directory ^>=1.3.7.1, + exceptions ^>=0.10.5, + filepath ^>=1.4.2.2, + parsec ^>=3.1.16.1, + pretty ^>=1.1.3.6, + text ^>=2.0.1 || ^>=2.1, + transformers ^>=0.5.6.2 || ^>=0.6.1.0, - -- cabal-gild: expand source/library + -- cabal-gild: discover source/library exposed-modules: - CabalGild - CabalGild.Comments - CabalGild.Error - CabalGild.Fields - CabalGild.Fields.BuildDepends - CabalGild.Fields.Extensions - CabalGild.Fields.Modules - CabalGild.Fields.SourceFiles - CabalGild.Fields.TestedWith - CabalGild.FreeText - CabalGild.Glob + CabalGild.Action.AttachComments + CabalGild.Action.Discover + CabalGild.Action.ExtractComments + CabalGild.Action.Format + CabalGild.Action.GetCabalVersion + CabalGild.Action.Reindent + CabalGild.Action.RemovePositions + CabalGild.Action.Render + CabalGild.Class.MonadLog + CabalGild.Class.MonadRead + CabalGild.Class.MonadWalk + CabalGild.Class.MonadWrite + CabalGild.Compat.Cabal + CabalGild.Exception.CheckFailure + CabalGild.Exception.InvalidMode + CabalGild.Exception.InvalidOption + CabalGild.Exception.ParseError + CabalGild.Exception.UnexpectedArgument + CabalGild.Exception.UnknownOption + CabalGild.Extra.Either + CabalGild.Extra.Field + CabalGild.Extra.FieldLine + CabalGild.Extra.List + CabalGild.Extra.ModuleName + CabalGild.Extra.Name + CabalGild.Extra.SectionArg + CabalGild.Extra.String CabalGild.Main - CabalGild.Monad - CabalGild.Options - CabalGild.Parser - CabalGild.Pragma - CabalGild.Refactoring - CabalGild.Refactoring.ExpandExposedModules - CabalGild.Refactoring.Fragments - CabalGild.Refactoring.GlobFiles - CabalGild.Refactoring.Type - VersionInterval + CabalGild.Type.Block + CabalGild.Type.Chunk + CabalGild.Type.Comment + CabalGild.Type.Config + CabalGild.Type.Flag + CabalGild.Type.Line + CabalGild.Type.List + CabalGild.Type.Mode + CabalGild.Type.Pragma + CabalGild.Type.Set + CabalGild.Type.SomeParsecParser + hs-source-dirs: source/library + other-modules: Paths_cabal_gild + executable cabal-gild - import: executable + import: executable hs-source-dirs: source/executable - main-is: Main.hs + main-is: Main.hs test-suite cabal-gild-test-suite - import: executable - type: exitcode-stdio-1.0 - hs-source-dirs: source/test-suite - main-is: Main.hs - other-modules: - CabalGild.Test.Golden - CabalGild.Test.Interval - - -- dependencies in library + import: executable build-depends: - , bytestring - , Cabal-syntax - , containers - , filepath - , QuickCheck ^>=2.14.3 - , tasty ^>=1.5 - , tasty-hunit ^>=0.10.1 - , tasty-quickcheck ^>=0.10.3 + bytestring, + containers, + exceptions, + filepath, + hspec ^>=2.11.7, + transformers, --- end file comment + hs-source-dirs: source/test-suite + main-is: Main.hs + type: exitcode-stdio-1.0 diff --git a/fixtures/Cabal-notab.cabal b/fixtures/Cabal-notab.cabal deleted file mode 100644 --- a/fixtures/Cabal-notab.cabal +++ /dev/null @@ -1,653 +0,0 @@ -name: Cabal -version: 2.5.0.0 --- cabal-gild: no-tabular -copyright: 2003-2018, Cabal Development Team (see AUTHORS file) -license: BSD3 -license-file: LICENSE -author: Cabal Development Team -maintainer: cabal-devel@haskell.org -homepage: http://www.haskell.org/cabal/ -bug-reports: https://github.com/haskell/cabal/issues -synopsis: A framework for packaging Haskell software -description: - The Haskell Common Architecture for Building Applications and - Libraries: a framework defining a common interface for authors to more - easily build their Haskell applications in a portable way. - . - The Haskell Cabal is part of a larger infrastructure for distributing, - organizing, and cataloging Haskell libraries and tools. -category: Distribution -cabal-version: >=1.10 -build-type: Simple --- If we use a new Cabal feature, this needs to be changed to Custom so --- we can bootstrap. - -extra-source-files: - README.md tests/README.md ChangeLog.md - doc/bugs-and-stability.rst doc/concepts-and-development.rst - doc/conf.py doc/config-and-install.rst doc/developing-packages.rst - doc/images/Cabal-dark.png doc/index.rst doc/installing-packages.rst - doc/intro.rst doc/misc.rst doc/nix-local-build-overview.rst - doc/nix-local-build.rst doc/file-format-changelog.rst doc/README.md - doc/references.inc - - -- Generated with 'make gen-extra-source-files' - -- Do NOT edit this section manually; instead, run the script. - -- BEGIN gen-extra-source-files - tests/ParserTests/errors/common1.cabal - tests/ParserTests/errors/common1.errors - tests/ParserTests/errors/common2.cabal - tests/ParserTests/errors/common2.errors - tests/ParserTests/errors/common3.cabal - tests/ParserTests/errors/common3.errors - tests/ParserTests/errors/forward-compat.cabal - tests/ParserTests/errors/forward-compat.errors - tests/ParserTests/errors/forward-compat2.cabal - tests/ParserTests/errors/forward-compat2.errors - tests/ParserTests/errors/forward-compat3.cabal - tests/ParserTests/errors/forward-compat3.errors - tests/ParserTests/errors/issue-5055-2.cabal - tests/ParserTests/errors/issue-5055-2.errors - tests/ParserTests/errors/issue-5055.cabal - tests/ParserTests/errors/issue-5055.errors - tests/ParserTests/errors/leading-comma-2.cabal - tests/ParserTests/errors/leading-comma-2.errors - tests/ParserTests/errors/leading-comma-2b.cabal - tests/ParserTests/errors/leading-comma-2b.errors - tests/ParserTests/errors/leading-comma-2c.cabal - tests/ParserTests/errors/leading-comma-2c.errors - tests/ParserTests/errors/leading-comma.cabal - tests/ParserTests/errors/leading-comma.errors - tests/ParserTests/errors/multiple-libs.cabal - tests/ParserTests/errors/multiple-libs.errors - tests/ParserTests/errors/noVersion.cabal - tests/ParserTests/errors/noVersion.errors - tests/ParserTests/errors/noVersion2.cabal - tests/ParserTests/errors/noVersion2.errors - tests/ParserTests/errors/range-ge-wild.cabal - tests/ParserTests/errors/range-ge-wild.errors - tests/ParserTests/errors/removed-fields.cabal - tests/ParserTests/errors/removed-fields.errors - tests/ParserTests/errors/spdx-1.cabal - tests/ParserTests/errors/spdx-1.errors - tests/ParserTests/errors/spdx-2.cabal - tests/ParserTests/errors/spdx-2.errors - tests/ParserTests/errors/spdx-3.cabal - tests/ParserTests/errors/spdx-3.errors - tests/ParserTests/ipi/Includes2.cabal - tests/ParserTests/ipi/Includes2.expr - tests/ParserTests/ipi/Includes2.format - tests/ParserTests/ipi/internal-preprocessor-test.cabal - tests/ParserTests/ipi/internal-preprocessor-test.expr - tests/ParserTests/ipi/internal-preprocessor-test.format - tests/ParserTests/ipi/issue-2276-ghc-9885.cabal - tests/ParserTests/ipi/issue-2276-ghc-9885.expr - tests/ParserTests/ipi/issue-2276-ghc-9885.format - tests/ParserTests/ipi/transformers.cabal - tests/ParserTests/ipi/transformers.expr - tests/ParserTests/ipi/transformers.format - tests/ParserTests/regressions/MiniAgda.cabal - tests/ParserTests/regressions/MiniAgda.check - tests/ParserTests/regressions/Octree-0.5.cabal - tests/ParserTests/regressions/Octree-0.5.expr - tests/ParserTests/regressions/Octree-0.5.format - tests/ParserTests/regressions/bad-glob-syntax.cabal - tests/ParserTests/regressions/bad-glob-syntax.check - tests/ParserTests/regressions/cc-options-with-optimization.cabal - tests/ParserTests/regressions/cc-options-with-optimization.check - tests/ParserTests/regressions/common-conditional.cabal - tests/ParserTests/regressions/common-conditional.expr - tests/ParserTests/regressions/common-conditional.format - tests/ParserTests/regressions/common.cabal - tests/ParserTests/regressions/common.expr - tests/ParserTests/regressions/common.format - tests/ParserTests/regressions/common2.cabal - tests/ParserTests/regressions/common2.expr - tests/ParserTests/regressions/common2.format - tests/ParserTests/regressions/cxx-options-with-optimization.cabal - tests/ParserTests/regressions/cxx-options-with-optimization.check - tests/ParserTests/regressions/elif.cabal - tests/ParserTests/regressions/elif.expr - tests/ParserTests/regressions/elif.format - tests/ParserTests/regressions/elif2.cabal - tests/ParserTests/regressions/elif2.expr - tests/ParserTests/regressions/elif2.format - tests/ParserTests/regressions/encoding-0.8.cabal - tests/ParserTests/regressions/encoding-0.8.expr - tests/ParserTests/regressions/encoding-0.8.format - tests/ParserTests/regressions/extensions-paths-5054.cabal - tests/ParserTests/regressions/extensions-paths-5054.check - tests/ParserTests/regressions/generics-sop.cabal - tests/ParserTests/regressions/generics-sop.expr - tests/ParserTests/regressions/generics-sop.format - tests/ParserTests/regressions/ghc-option-j.cabal - tests/ParserTests/regressions/ghc-option-j.check - tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal - tests/ParserTests/regressions/haddock-api-2.18.1-check.check - tests/ParserTests/regressions/hidden-main-lib.cabal - tests/ParserTests/regressions/hidden-main-lib.expr - tests/ParserTests/regressions/hidden-main-lib.format - tests/ParserTests/regressions/issue-5055.cabal - tests/ParserTests/regressions/issue-5055.expr - tests/ParserTests/regressions/issue-5055.format - tests/ParserTests/regressions/issue-774.cabal - tests/ParserTests/regressions/issue-774.check - tests/ParserTests/regressions/issue-774.expr - tests/ParserTests/regressions/issue-774.format - tests/ParserTests/regressions/jaeger-flamegraph.cabal - tests/ParserTests/regressions/jaeger-flamegraph.expr - tests/ParserTests/regressions/jaeger-flamegraph.format - tests/ParserTests/regressions/leading-comma-2.cabal - tests/ParserTests/regressions/leading-comma-2.expr - tests/ParserTests/regressions/leading-comma-2.format - tests/ParserTests/regressions/leading-comma.cabal - tests/ParserTests/regressions/leading-comma.expr - tests/ParserTests/regressions/leading-comma.format - tests/ParserTests/regressions/multiple-libs-2.cabal - tests/ParserTests/regressions/multiple-libs-2.check - tests/ParserTests/regressions/multiple-libs-2.expr - tests/ParserTests/regressions/multiple-libs-2.format - tests/ParserTests/regressions/noVersion.cabal - tests/ParserTests/regressions/noVersion.expr - tests/ParserTests/regressions/noVersion.format - tests/ParserTests/regressions/nothing-unicode.cabal - tests/ParserTests/regressions/nothing-unicode.check - tests/ParserTests/regressions/nothing-unicode.expr - tests/ParserTests/regressions/nothing-unicode.format - tests/ParserTests/regressions/pre-1.6-glob.cabal - tests/ParserTests/regressions/pre-1.6-glob.check - tests/ParserTests/regressions/pre-2.4-globstar.cabal - tests/ParserTests/regressions/pre-2.4-globstar.check - tests/ParserTests/regressions/shake.cabal - tests/ParserTests/regressions/shake.expr - tests/ParserTests/regressions/shake.format - tests/ParserTests/regressions/spdx-1.cabal - tests/ParserTests/regressions/spdx-1.expr - tests/ParserTests/regressions/spdx-1.format - tests/ParserTests/regressions/spdx-2.cabal - tests/ParserTests/regressions/spdx-2.expr - tests/ParserTests/regressions/spdx-2.format - tests/ParserTests/regressions/spdx-3.cabal - tests/ParserTests/regressions/spdx-3.expr - tests/ParserTests/regressions/spdx-3.format - tests/ParserTests/regressions/th-lift-instances.cabal - tests/ParserTests/regressions/th-lift-instances.expr - tests/ParserTests/regressions/th-lift-instances.format - tests/ParserTests/regressions/wl-pprint-indef.cabal - tests/ParserTests/regressions/wl-pprint-indef.expr - tests/ParserTests/regressions/wl-pprint-indef.format - tests/ParserTests/warnings/bom.cabal - tests/ParserTests/warnings/bool.cabal - tests/ParserTests/warnings/deprecatedfield.cabal - tests/ParserTests/warnings/doubledash.cabal - tests/ParserTests/warnings/extratestmodule.cabal - tests/ParserTests/warnings/gluedop.cabal - tests/ParserTests/warnings/multiplesingular.cabal - tests/ParserTests/warnings/nbsp.cabal - tests/ParserTests/warnings/newsyntax.cabal - tests/ParserTests/warnings/oldsyntax.cabal - tests/ParserTests/warnings/subsection.cabal - tests/ParserTests/warnings/tab.cabal - tests/ParserTests/warnings/trailingfield.cabal - tests/ParserTests/warnings/unknownfield.cabal - tests/ParserTests/warnings/unknownsection.cabal - tests/ParserTests/warnings/utf8.cabal - tests/ParserTests/warnings/versiontag.cabal - tests/hackage/check.sh - tests/hackage/download.sh - tests/hackage/unpack.sh - tests/misc/ghc-supported-languages.hs - -- END gen-extra-source-files - -source-repository head - type: git - location: https://github.com/haskell/cabal/ - subdir: Cabal - -flag bundled-binary-generic - default: False - -library - build-depends: - array >= 0.4.0.1 && < 0.6, - base >= 4.6 && < 5, - bytestring >= 0.10.0.0 && < 0.11, - containers >= 0.5.0.0 && < 0.7, - deepseq >= 1.3.0.1 && < 1.5, - directory >= 1.2 && < 1.4, - filepath >= 1.3.0.1 && < 1.5, - pretty >= 1.1.1 && < 1.2, - process >= 1.1.0.2 && < 1.7, - time >= 1.4.0.1 && < 1.10 - - if flag(bundled-binary-generic) - build-depends: binary >= 0.5.1.1 && < 0.7 - else - build-depends: binary >= 0.7 && < 0.9 - - if os(windows) - build-depends: Win32 >= 2.3.0.0 && < 2.9 - else - build-depends: unix >= 2.6.0.0 && < 2.8 - - ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs - if impl(ghc >= 8.0) - ghc-options: -Wcompat -Wnoncanonical-monad-instances - -Wnoncanonical-monadfail-instances - - exposed-modules: - Distribution.Backpack - Distribution.Backpack.Configure - Distribution.Backpack.ComponentsGraph - Distribution.Backpack.ConfiguredComponent - Distribution.Backpack.DescribeUnitId - Distribution.Backpack.FullUnitId - Distribution.Backpack.LinkedComponent - Distribution.Backpack.ModSubst - Distribution.Backpack.ModuleShape - Distribution.Backpack.PreModuleShape - Distribution.CabalSpecVersion - Distribution.Utils.IOData - Distribution.Utils.LogProgress - Distribution.Utils.MapAccum - Distribution.Compat.CreatePipe - Distribution.Compat.Directory - Distribution.Compat.Environment - Distribution.Compat.Exception - Distribution.Compat.Graph - Distribution.Compat.Internal.TempFile - Distribution.Compat.Newtype - Distribution.Compat.Prelude.Internal - Distribution.Compat.Semigroup - Distribution.Compat.Stack - Distribution.Compat.Time - Distribution.Compat.DList - Distribution.Compiler - Distribution.InstalledPackageInfo - Distribution.Types.AbiDependency - Distribution.Types.ExposedModule - Distribution.Types.InstalledPackageInfo - Distribution.Types.InstalledPackageInfo.FieldGrammar - Distribution.License - Distribution.Make - Distribution.ModuleName - Distribution.Package - Distribution.PackageDescription - Distribution.PackageDescription.Check - Distribution.PackageDescription.Configuration - Distribution.PackageDescription.PrettyPrint - Distribution.PackageDescription.Utils - Distribution.ReadE - Distribution.Simple - Distribution.Simple.Bench - Distribution.Simple.Build - Distribution.Simple.Build.Macros - Distribution.Simple.Build.PathsModule - Distribution.Simple.BuildPaths - Distribution.Simple.BuildTarget - Distribution.Simple.BuildToolDepends - Distribution.Simple.CCompiler - Distribution.Simple.Command - Distribution.Simple.Compiler - Distribution.Simple.Configure - Distribution.Simple.Flag - Distribution.Simple.GHC - Distribution.Simple.GHCJS - Distribution.Simple.Haddock - Distribution.Simple.Doctest - Distribution.Simple.Glob - Distribution.Simple.HaskellSuite - Distribution.Simple.Hpc - Distribution.Simple.Install - Distribution.Simple.InstallDirs - Distribution.Simple.LocalBuildInfo - Distribution.Simple.PackageIndex - Distribution.Simple.PreProcess - Distribution.Simple.PreProcess.Unlit - Distribution.Simple.Program - Distribution.Simple.Program.Ar - Distribution.Simple.Program.Builtin - Distribution.Simple.Program.Db - Distribution.Simple.Program.Find - Distribution.Simple.Program.GHC - Distribution.Simple.Program.HcPkg - Distribution.Simple.Program.Hpc - Distribution.Simple.Program.Internal - Distribution.Simple.Program.Ld - Distribution.Simple.Program.ResponseFile - Distribution.Simple.Program.Run - Distribution.Simple.Program.Script - Distribution.Simple.Program.Strip - Distribution.Simple.Program.Types - Distribution.Simple.Register - Distribution.Simple.Setup - Distribution.Simple.SrcDist - Distribution.Simple.Test - Distribution.Simple.Test.ExeV10 - Distribution.Simple.Test.LibV09 - Distribution.Simple.Test.Log - Distribution.Simple.UHC - Distribution.Simple.UserHooks - Distribution.Simple.Utils - Distribution.SPDX - Distribution.SPDX.License - Distribution.SPDX.LicenseId - Distribution.SPDX.LicenseExceptionId - Distribution.SPDX.LicenseExpression - Distribution.SPDX.LicenseListVersion - Distribution.SPDX.LicenseReference - Distribution.System - Distribution.TestSuite - Distribution.Text - Distribution.Pretty - Distribution.Types.AbiHash - Distribution.Types.AnnotatedId - Distribution.Types.Benchmark - Distribution.Types.BenchmarkInterface - Distribution.Types.BenchmarkType - Distribution.Types.BuildInfo - Distribution.Types.BuildType - Distribution.Types.ComponentInclude - Distribution.Types.Dependency - Distribution.Types.ExeDependency - Distribution.Types.LegacyExeDependency - Distribution.Types.PkgconfigDependency - Distribution.Types.DependencyMap - Distribution.Types.ComponentId - Distribution.Types.MungedPackageId - Distribution.Types.PackageId - Distribution.Types.UnitId - Distribution.Types.Executable - Distribution.Types.ExecutableScope - Distribution.Types.Library - Distribution.Types.LibraryVisibility - Distribution.Types.ForeignLib - Distribution.Types.ForeignLibType - Distribution.Types.ForeignLibOption - Distribution.Types.Module - Distribution.Types.ModuleReexport - Distribution.Types.ModuleRenaming - Distribution.Types.ComponentName - Distribution.Types.LibraryName - Distribution.Types.MungedPackageName - Distribution.Types.PackageName - Distribution.Types.PkgconfigName - Distribution.Types.UnqualComponentName - Distribution.Types.IncludeRenaming - Distribution.Types.Mixin - Distribution.Types.SetupBuildInfo - Distribution.Types.TestSuite - Distribution.Types.TestSuiteInterface - Distribution.Types.TestType - Distribution.Types.GenericPackageDescription - Distribution.Types.Condition - Distribution.Types.CondTree - Distribution.Types.HookedBuildInfo - Distribution.Types.PackageDescription - Distribution.Types.SourceRepo - Distribution.Types.Component - Distribution.Types.ComponentLocalBuildInfo - Distribution.Types.LocalBuildInfo - Distribution.Types.ComponentRequestedSpec - Distribution.Types.TargetInfo - Distribution.Types.Version - Distribution.Types.VersionRange - Distribution.Types.VersionInterval - Distribution.Types.GivenComponent - Distribution.Types.PackageVersionConstraint - Distribution.Utils.Generic - Distribution.Utils.NubList - Distribution.Utils.ShortText - Distribution.Utils.Progress - Distribution.Verbosity - Distribution.Version - Language.Haskell.Extension - Distribution.Compat.Binary - - -- Parsec parser-related modules - build-depends: - -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity - -- See also https://github.com/ekmett/transformers-compat/issues/35 - transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.6), - mtl >= 2.1 && < 2.3, - text >= 1.2.3.0 && < 1.3, - parsec >= 3.1.13.0 && < 3.2 - exposed-modules: - Distribution.Compat.Parsing - Distribution.Compat.CharParsing - Distribution.FieldGrammar - Distribution.FieldGrammar.Class - Distribution.FieldGrammar.FieldDescrs - Distribution.FieldGrammar.Parsec - Distribution.FieldGrammar.Pretty - Distribution.PackageDescription.FieldGrammar - Distribution.PackageDescription.Parsec - Distribution.PackageDescription.Quirks - Distribution.Parsec - Distribution.Parsec.Error - Distribution.Parsec.Newtypes - Distribution.Parsec.Position - Distribution.Parsec.Warning - Distribution.Parsec.FieldLineStream - Distribution.Fields - Distribution.Fields.ConfVar - Distribution.Fields.Field - Distribution.Fields.Lexer - Distribution.Fields.LexerMonad - Distribution.Fields.ParseResult - Distribution.Fields.Parser - Distribution.Fields.Pretty - - -- Lens functionality - exposed-modules: - Distribution.Compat.Lens - Distribution.Types.Lens - Distribution.Types.Benchmark.Lens - Distribution.Types.BuildInfo.Lens - Distribution.Types.Executable.Lens - Distribution.Types.ForeignLib.Lens - Distribution.Types.GenericPackageDescription.Lens - Distribution.Types.InstalledPackageInfo.Lens - Distribution.Types.Library.Lens - Distribution.Types.PackageDescription.Lens - Distribution.Types.PackageId.Lens - Distribution.Types.SetupBuildInfo.Lens - Distribution.Types.SourceRepo.Lens - Distribution.Types.TestSuite.Lens - - other-modules: - Distribution.Backpack.PreExistingComponent - Distribution.Backpack.ReadyComponent - Distribution.Backpack.MixLink - Distribution.Backpack.ModuleScope - Distribution.Backpack.UnifyM - Distribution.Backpack.Id - Distribution.Utils.UnionFind - Distribution.Utils.Base62 - Distribution.Compat.CopyFile - Distribution.Compat.GetShortPathName - Distribution.Compat.MonadFail - Distribution.Compat.Prelude - Distribution.Compat.SnocList - Distribution.GetOpt - Distribution.Lex - Distribution.Utils.String - Distribution.Simple.GHC.EnvironmentParser - Distribution.Simple.GHC.Internal - Distribution.Simple.GHC.ImplInfo - Paths_Cabal - - if flag(bundled-binary-generic) - other-modules: - Distribution.Compat.Binary.Class - Distribution.Compat.Binary.Generic - - default-language: Haskell2010 - other-extensions: - BangPatterns - CPP - DefaultSignatures - DeriveDataTypeable - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveTraversable - ExistentialQuantification - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving - ImplicitParams - KindSignatures - NondecreasingIndentation - OverloadedStrings - RankNTypes - RecordWildCards - ScopedTypeVariables - StandaloneDeriving - Trustworthy - TypeFamilies - TypeOperators - TypeSynonymInstances - UndecidableInstances - - if impl(ghc >= 7.11) - other-extensions: PatternSynonyms - --- Small, fast running tests. -test-suite unit-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - other-modules: - Test.Laws - Test.QuickCheck.Utils - UnitTests.Distribution.Compat.CreatePipe - UnitTests.Distribution.Compat.Time - UnitTests.Distribution.Compat.Graph - UnitTests.Distribution.Simple.Glob - UnitTests.Distribution.Simple.Program.Internal - UnitTests.Distribution.Simple.Utils - UnitTests.Distribution.SPDX - UnitTests.Distribution.System - UnitTests.Distribution.Types.GenericPackageDescription - UnitTests.Distribution.Utils.Generic - UnitTests.Distribution.Utils.NubList - UnitTests.Distribution.Utils.ShortText - UnitTests.Distribution.Version - main-is: UnitTests.hs - build-depends: - array, - base, - bytestring, - containers, - directory, - filepath, - integer-logarithms >= 1.0.2 && <1.1, - tasty >= 1.1.0.3 && < 1.2, - tasty-hunit, - tasty-quickcheck, - tagged, - temporary, - text, - pretty, - QuickCheck >= 2.11.3 && < 2.12, - Cabal - ghc-options: -Wall - default-language: Haskell2010 - -test-suite parser-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: ParserTests.hs - build-depends: - base, - base-compat >=0.10.4 && <0.11, - bytestring, - directory, - filepath, - tasty >= 1.1.0.3 && < 1.2, - tasty-hunit, - tasty-quickcheck, - tasty-golden >=2.3.1.1 && <2.4, - Diff >=0.3.4 && <0.4, - Cabal - ghc-options: -Wall - default-language: Haskell2010 - - if impl(ghc >= 7.8) - build-depends: - tree-diff >= 0.0.1 && <0.1 - other-modules: - Instances.TreeDiff - Instances.TreeDiff.Language - Instances.TreeDiff.SPDX - Instances.TreeDiff.Version - -test-suite check-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: CheckTests.hs - build-depends: - base, - bytestring, - directory, - filepath, - tasty >= 1.1.0.3 && < 1.2, - tasty-golden >=2.3.1.1 && <2.4, - Diff >=0.3.4 && <0.4, - Cabal - ghc-options: -Wall - default-language: Haskell2010 - -test-suite custom-setup-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests/custom-setup - main-is: CustomSetupTests.hs - other-modules: - CabalDoctestSetup - IdrisSetup - build-depends: - Cabal, - base, - directory, - filepath, - process - default-language: Haskell2010 - -test-suite hackage-tests - type: exitcode-stdio-1.0 - main-is: HackageTests.hs - - -- TODO: need to get 01-index.tar on appveyor - if os(windows) - buildable: False - - hs-source-dirs: tests - - build-depends: - base, - Cabal, - bytestring, - deepseq, - containers, - directory, - filepath - - build-depends: - base-compat >=0.10.4 && <0.11, - base-orphans >=0.6 && <0.9, - optparse-applicative >=0.13.2.0 && <0.15, - stm >=2.4.5.0 && <2.6, - tar >=0.5.0.3 && <0.6 - - if impl(ghc >= 7.8) - build-depends: - tree-diff >= 0.0.1 && <0.1 - other-modules: - Instances.TreeDiff - Instances.TreeDiff.Language - Instances.TreeDiff.SPDX - Instances.TreeDiff.Version - - ghc-options: -Wall -rtsopts -threaded - default-extensions: CPP - default-language: Haskell2010 diff --git a/fixtures/Cabal-notab.format b/fixtures/Cabal-notab.format deleted file mode 100644 --- a/fixtures/Cabal-notab.format +++ /dev/null @@ -1,675 +0,0 @@ -name: Cabal -version: 2.5.0.0 - --- cabal-gild: no-tabular -copyright: 2003-2018, Cabal Development Team (see AUTHORS file) -license: BSD3 -license-file: LICENSE -author: Cabal Development Team -maintainer: cabal-devel@haskell.org -homepage: http://www.haskell.org/cabal/ -bug-reports: https://github.com/haskell/cabal/issues -synopsis: A framework for packaging Haskell software -description: - The Haskell Common Architecture for Building Applications and - Libraries: a framework defining a common interface for authors to more - easily build their Haskell applications in a portable way. - . - The Haskell Cabal is part of a larger infrastructure for distributing, - organizing, and cataloging Haskell libraries and tools. - -category: Distribution -cabal-version: >=1.10 -build-type: Simple - --- If we use a new Cabal feature, this needs to be changed to Custom so --- we can bootstrap. - -extra-source-files: - ChangeLog.md - doc/bugs-and-stability.rst - doc/concepts-and-development.rst - doc/conf.py - doc/config-and-install.rst - doc/developing-packages.rst - doc/file-format-changelog.rst - doc/images/Cabal-dark.png - doc/index.rst - doc/installing-packages.rst - doc/intro.rst - doc/misc.rst - doc/nix-local-build-overview.rst - doc/nix-local-build.rst - doc/README.md - doc/references.inc - README.md - tests/hackage/check.sh - tests/hackage/download.sh - tests/hackage/unpack.sh - tests/misc/ghc-supported-languages.hs - tests/ParserTests/errors/common1.cabal - tests/ParserTests/errors/common1.errors - tests/ParserTests/errors/common2.cabal - tests/ParserTests/errors/common2.errors - tests/ParserTests/errors/common3.cabal - tests/ParserTests/errors/common3.errors - tests/ParserTests/errors/forward-compat.cabal - tests/ParserTests/errors/forward-compat.errors - tests/ParserTests/errors/forward-compat2.cabal - tests/ParserTests/errors/forward-compat2.errors - tests/ParserTests/errors/forward-compat3.cabal - tests/ParserTests/errors/forward-compat3.errors - tests/ParserTests/errors/issue-5055-2.cabal - tests/ParserTests/errors/issue-5055-2.errors - tests/ParserTests/errors/issue-5055.cabal - tests/ParserTests/errors/issue-5055.errors - tests/ParserTests/errors/leading-comma-2.cabal - tests/ParserTests/errors/leading-comma-2.errors - tests/ParserTests/errors/leading-comma-2b.cabal - tests/ParserTests/errors/leading-comma-2b.errors - tests/ParserTests/errors/leading-comma-2c.cabal - tests/ParserTests/errors/leading-comma-2c.errors - tests/ParserTests/errors/leading-comma.cabal - tests/ParserTests/errors/leading-comma.errors - tests/ParserTests/errors/multiple-libs.cabal - tests/ParserTests/errors/multiple-libs.errors - tests/ParserTests/errors/noVersion.cabal - tests/ParserTests/errors/noVersion.errors - tests/ParserTests/errors/noVersion2.cabal - tests/ParserTests/errors/noVersion2.errors - tests/ParserTests/errors/range-ge-wild.cabal - tests/ParserTests/errors/range-ge-wild.errors - tests/ParserTests/errors/removed-fields.cabal - tests/ParserTests/errors/removed-fields.errors - tests/ParserTests/errors/spdx-1.cabal - tests/ParserTests/errors/spdx-1.errors - tests/ParserTests/errors/spdx-2.cabal - tests/ParserTests/errors/spdx-2.errors - tests/ParserTests/errors/spdx-3.cabal - tests/ParserTests/errors/spdx-3.errors - tests/ParserTests/ipi/Includes2.cabal - tests/ParserTests/ipi/Includes2.expr - tests/ParserTests/ipi/Includes2.format - tests/ParserTests/ipi/internal-preprocessor-test.cabal - tests/ParserTests/ipi/internal-preprocessor-test.expr - tests/ParserTests/ipi/internal-preprocessor-test.format - tests/ParserTests/ipi/issue-2276-ghc-9885.cabal - tests/ParserTests/ipi/issue-2276-ghc-9885.expr - tests/ParserTests/ipi/issue-2276-ghc-9885.format - tests/ParserTests/ipi/transformers.cabal - tests/ParserTests/ipi/transformers.expr - tests/ParserTests/ipi/transformers.format - tests/ParserTests/regressions/bad-glob-syntax.cabal - tests/ParserTests/regressions/bad-glob-syntax.check - tests/ParserTests/regressions/cc-options-with-optimization.cabal - tests/ParserTests/regressions/cc-options-with-optimization.check - tests/ParserTests/regressions/common-conditional.cabal - tests/ParserTests/regressions/common-conditional.expr - tests/ParserTests/regressions/common-conditional.format - tests/ParserTests/regressions/common.cabal - tests/ParserTests/regressions/common.expr - tests/ParserTests/regressions/common.format - tests/ParserTests/regressions/common2.cabal - tests/ParserTests/regressions/common2.expr - tests/ParserTests/regressions/common2.format - tests/ParserTests/regressions/cxx-options-with-optimization.cabal - tests/ParserTests/regressions/cxx-options-with-optimization.check - tests/ParserTests/regressions/elif.cabal - tests/ParserTests/regressions/elif.expr - tests/ParserTests/regressions/elif.format - tests/ParserTests/regressions/elif2.cabal - tests/ParserTests/regressions/elif2.expr - tests/ParserTests/regressions/elif2.format - tests/ParserTests/regressions/encoding-0.8.cabal - tests/ParserTests/regressions/encoding-0.8.expr - tests/ParserTests/regressions/encoding-0.8.format - tests/ParserTests/regressions/extensions-paths-5054.cabal - tests/ParserTests/regressions/extensions-paths-5054.check - tests/ParserTests/regressions/generics-sop.cabal - tests/ParserTests/regressions/generics-sop.expr - tests/ParserTests/regressions/generics-sop.format - tests/ParserTests/regressions/ghc-option-j.cabal - tests/ParserTests/regressions/ghc-option-j.check - tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal - tests/ParserTests/regressions/haddock-api-2.18.1-check.check - tests/ParserTests/regressions/hidden-main-lib.cabal - tests/ParserTests/regressions/hidden-main-lib.expr - tests/ParserTests/regressions/hidden-main-lib.format - tests/ParserTests/regressions/issue-5055.cabal - tests/ParserTests/regressions/issue-5055.expr - tests/ParserTests/regressions/issue-5055.format - tests/ParserTests/regressions/issue-774.cabal - tests/ParserTests/regressions/issue-774.check - tests/ParserTests/regressions/issue-774.expr - tests/ParserTests/regressions/issue-774.format - tests/ParserTests/regressions/jaeger-flamegraph.cabal - tests/ParserTests/regressions/jaeger-flamegraph.expr - tests/ParserTests/regressions/jaeger-flamegraph.format - tests/ParserTests/regressions/leading-comma-2.cabal - tests/ParserTests/regressions/leading-comma-2.expr - tests/ParserTests/regressions/leading-comma-2.format - tests/ParserTests/regressions/leading-comma.cabal - tests/ParserTests/regressions/leading-comma.expr - tests/ParserTests/regressions/leading-comma.format - tests/ParserTests/regressions/MiniAgda.cabal - tests/ParserTests/regressions/MiniAgda.check - tests/ParserTests/regressions/multiple-libs-2.cabal - tests/ParserTests/regressions/multiple-libs-2.check - tests/ParserTests/regressions/multiple-libs-2.expr - tests/ParserTests/regressions/multiple-libs-2.format - tests/ParserTests/regressions/nothing-unicode.cabal - tests/ParserTests/regressions/nothing-unicode.check - tests/ParserTests/regressions/nothing-unicode.expr - tests/ParserTests/regressions/nothing-unicode.format - tests/ParserTests/regressions/noVersion.cabal - tests/ParserTests/regressions/noVersion.expr - tests/ParserTests/regressions/noVersion.format - tests/ParserTests/regressions/Octree-0.5.cabal - tests/ParserTests/regressions/Octree-0.5.expr - tests/ParserTests/regressions/Octree-0.5.format - tests/ParserTests/regressions/pre-1.6-glob.cabal - tests/ParserTests/regressions/pre-1.6-glob.check - tests/ParserTests/regressions/pre-2.4-globstar.cabal - tests/ParserTests/regressions/pre-2.4-globstar.check - tests/ParserTests/regressions/shake.cabal - tests/ParserTests/regressions/shake.expr - tests/ParserTests/regressions/shake.format - tests/ParserTests/regressions/spdx-1.cabal - tests/ParserTests/regressions/spdx-1.expr - tests/ParserTests/regressions/spdx-1.format - tests/ParserTests/regressions/spdx-2.cabal - tests/ParserTests/regressions/spdx-2.expr - tests/ParserTests/regressions/spdx-2.format - tests/ParserTests/regressions/spdx-3.cabal - tests/ParserTests/regressions/spdx-3.expr - tests/ParserTests/regressions/spdx-3.format - tests/ParserTests/regressions/th-lift-instances.cabal - tests/ParserTests/regressions/th-lift-instances.expr - tests/ParserTests/regressions/th-lift-instances.format - tests/ParserTests/regressions/wl-pprint-indef.cabal - tests/ParserTests/regressions/wl-pprint-indef.expr - tests/ParserTests/regressions/wl-pprint-indef.format - tests/ParserTests/warnings/bom.cabal - tests/ParserTests/warnings/bool.cabal - tests/ParserTests/warnings/deprecatedfield.cabal - tests/ParserTests/warnings/doubledash.cabal - tests/ParserTests/warnings/extratestmodule.cabal - tests/ParserTests/warnings/gluedop.cabal - tests/ParserTests/warnings/multiplesingular.cabal - tests/ParserTests/warnings/nbsp.cabal - tests/ParserTests/warnings/newsyntax.cabal - tests/ParserTests/warnings/oldsyntax.cabal - tests/ParserTests/warnings/subsection.cabal - tests/ParserTests/warnings/tab.cabal - tests/ParserTests/warnings/trailingfield.cabal - tests/ParserTests/warnings/unknownfield.cabal - tests/ParserTests/warnings/unknownsection.cabal - tests/ParserTests/warnings/utf8.cabal - tests/ParserTests/warnings/versiontag.cabal - tests/README.md - --- Generated with 'make gen-extra-source-files' --- Do NOT edit this section manually; instead, run the script. --- BEGIN gen-extra-source-files --- END gen-extra-source-files - -source-repository head - type: git - location: https://github.com/haskell/cabal/ - subdir: Cabal - -flag bundled-binary-generic - default: False - -library - build-depends: - array >=0.4.0.1 && <0.6 - , base >=4.6 && <5 - , bytestring >=0.10.0.0 && <0.11 - , containers >=0.5.0.0 && <0.7 - , deepseq >=1.3.0.1 && <1.5 - , directory >=1.2 && <1.4 - , filepath >=1.3.0.1 && <1.5 - , pretty >=1.1.1 && <1.2 - , process >=1.1.0.2 && <1.7 - , time >=1.4.0.1 && <1.10 - - if flag(bundled-binary-generic) - build-depends: binary >=0.5.1.1 && <0.7 - - else - build-depends: binary >=0.7 && <0.9 - - if os(windows) - build-depends: Win32 >=2.3.0.0 && <2.9 - - else - build-depends: unix >=2.6.0.0 && <2.8 - - ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs - - if impl(ghc >=8.0) - ghc-options: - -Wcompat -Wnoncanonical-monad-instances - -Wnoncanonical-monadfail-instances - - exposed-modules: - Distribution.Backpack - Distribution.Backpack.ComponentsGraph - Distribution.Backpack.Configure - Distribution.Backpack.ConfiguredComponent - Distribution.Backpack.DescribeUnitId - Distribution.Backpack.FullUnitId - Distribution.Backpack.LinkedComponent - Distribution.Backpack.ModSubst - Distribution.Backpack.ModuleShape - Distribution.Backpack.PreModuleShape - Distribution.CabalSpecVersion - Distribution.Compat.Binary - Distribution.Compat.CreatePipe - Distribution.Compat.Directory - Distribution.Compat.DList - Distribution.Compat.Environment - Distribution.Compat.Exception - Distribution.Compat.Graph - Distribution.Compat.Internal.TempFile - Distribution.Compat.Newtype - Distribution.Compat.Prelude.Internal - Distribution.Compat.Semigroup - Distribution.Compat.Stack - Distribution.Compat.Time - Distribution.Compiler - Distribution.InstalledPackageInfo - Distribution.License - Distribution.Make - Distribution.ModuleName - Distribution.Package - Distribution.PackageDescription - Distribution.PackageDescription.Check - Distribution.PackageDescription.Configuration - Distribution.PackageDescription.PrettyPrint - Distribution.PackageDescription.Utils - Distribution.Pretty - Distribution.ReadE - Distribution.Simple - Distribution.Simple.Bench - Distribution.Simple.Build - Distribution.Simple.Build.Macros - Distribution.Simple.Build.PathsModule - Distribution.Simple.BuildPaths - Distribution.Simple.BuildTarget - Distribution.Simple.BuildToolDepends - Distribution.Simple.CCompiler - Distribution.Simple.Command - Distribution.Simple.Compiler - Distribution.Simple.Configure - Distribution.Simple.Doctest - Distribution.Simple.Flag - Distribution.Simple.GHC - Distribution.Simple.GHCJS - Distribution.Simple.Glob - Distribution.Simple.Haddock - Distribution.Simple.HaskellSuite - Distribution.Simple.Hpc - Distribution.Simple.Install - Distribution.Simple.InstallDirs - Distribution.Simple.LocalBuildInfo - Distribution.Simple.PackageIndex - Distribution.Simple.PreProcess - Distribution.Simple.PreProcess.Unlit - Distribution.Simple.Program - Distribution.Simple.Program.Ar - Distribution.Simple.Program.Builtin - Distribution.Simple.Program.Db - Distribution.Simple.Program.Find - Distribution.Simple.Program.GHC - Distribution.Simple.Program.HcPkg - Distribution.Simple.Program.Hpc - Distribution.Simple.Program.Internal - Distribution.Simple.Program.Ld - Distribution.Simple.Program.ResponseFile - Distribution.Simple.Program.Run - Distribution.Simple.Program.Script - Distribution.Simple.Program.Strip - Distribution.Simple.Program.Types - Distribution.Simple.Register - Distribution.Simple.Setup - Distribution.Simple.SrcDist - Distribution.Simple.Test - Distribution.Simple.Test.ExeV10 - Distribution.Simple.Test.LibV09 - Distribution.Simple.Test.Log - Distribution.Simple.UHC - Distribution.Simple.UserHooks - Distribution.Simple.Utils - Distribution.SPDX - Distribution.SPDX.License - Distribution.SPDX.LicenseExceptionId - Distribution.SPDX.LicenseExpression - Distribution.SPDX.LicenseId - Distribution.SPDX.LicenseListVersion - Distribution.SPDX.LicenseReference - Distribution.System - Distribution.TestSuite - Distribution.Text - Distribution.Types.AbiDependency - Distribution.Types.AbiHash - Distribution.Types.AnnotatedId - Distribution.Types.Benchmark - Distribution.Types.BenchmarkInterface - Distribution.Types.BenchmarkType - Distribution.Types.BuildInfo - Distribution.Types.BuildType - Distribution.Types.Component - Distribution.Types.ComponentId - Distribution.Types.ComponentInclude - Distribution.Types.ComponentLocalBuildInfo - Distribution.Types.ComponentName - Distribution.Types.ComponentRequestedSpec - Distribution.Types.Condition - Distribution.Types.CondTree - Distribution.Types.Dependency - Distribution.Types.DependencyMap - Distribution.Types.Executable - Distribution.Types.ExecutableScope - Distribution.Types.ExeDependency - Distribution.Types.ExposedModule - Distribution.Types.ForeignLib - Distribution.Types.ForeignLibOption - Distribution.Types.ForeignLibType - Distribution.Types.GenericPackageDescription - Distribution.Types.GivenComponent - Distribution.Types.HookedBuildInfo - Distribution.Types.IncludeRenaming - Distribution.Types.InstalledPackageInfo - Distribution.Types.InstalledPackageInfo.FieldGrammar - Distribution.Types.LegacyExeDependency - Distribution.Types.Library - Distribution.Types.LibraryName - Distribution.Types.LibraryVisibility - Distribution.Types.LocalBuildInfo - Distribution.Types.Mixin - Distribution.Types.Module - Distribution.Types.ModuleReexport - Distribution.Types.ModuleRenaming - Distribution.Types.MungedPackageId - Distribution.Types.MungedPackageName - Distribution.Types.PackageDescription - Distribution.Types.PackageId - Distribution.Types.PackageName - Distribution.Types.PackageVersionConstraint - Distribution.Types.PkgconfigDependency - Distribution.Types.PkgconfigName - Distribution.Types.SetupBuildInfo - Distribution.Types.SourceRepo - Distribution.Types.TargetInfo - Distribution.Types.TestSuite - Distribution.Types.TestSuiteInterface - Distribution.Types.TestType - Distribution.Types.UnitId - Distribution.Types.UnqualComponentName - Distribution.Types.Version - Distribution.Types.VersionInterval - Distribution.Types.VersionRange - Distribution.Utils.Generic - Distribution.Utils.IOData - Distribution.Utils.LogProgress - Distribution.Utils.MapAccum - Distribution.Utils.NubList - Distribution.Utils.Progress - Distribution.Utils.ShortText - Distribution.Verbosity - Distribution.Version - Language.Haskell.Extension - - -- Parsec parser-related modules - build-depends: - mtl >=2.1 && <2.3 - , parsec >=3.1.13.0 && <3.2 - , text >=1.2.3.0 && <1.3 - , transformers >=0.3 && <0.4 || >=0.4.1.0 && <0.6 - - -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity - -- See also https://github.com/ekmett/transformers-compat/issues/35 - exposed-modules: - Distribution.Compat.CharParsing - Distribution.Compat.Parsing - Distribution.FieldGrammar - Distribution.FieldGrammar.Class - Distribution.FieldGrammar.FieldDescrs - Distribution.FieldGrammar.Parsec - Distribution.FieldGrammar.Pretty - Distribution.Fields - Distribution.Fields.ConfVar - Distribution.Fields.Field - Distribution.Fields.Lexer - Distribution.Fields.LexerMonad - Distribution.Fields.Parser - Distribution.Fields.ParseResult - Distribution.Fields.Pretty - Distribution.PackageDescription.FieldGrammar - Distribution.PackageDescription.Parsec - Distribution.PackageDescription.Quirks - Distribution.Parsec - Distribution.Parsec.Error - Distribution.Parsec.FieldLineStream - Distribution.Parsec.Newtypes - Distribution.Parsec.Position - Distribution.Parsec.Warning - - -- Lens functionality - exposed-modules: - Distribution.Compat.Lens - Distribution.Types.Benchmark.Lens - Distribution.Types.BuildInfo.Lens - Distribution.Types.Executable.Lens - Distribution.Types.ForeignLib.Lens - Distribution.Types.GenericPackageDescription.Lens - Distribution.Types.InstalledPackageInfo.Lens - Distribution.Types.Lens - Distribution.Types.Library.Lens - Distribution.Types.PackageDescription.Lens - Distribution.Types.PackageId.Lens - Distribution.Types.SetupBuildInfo.Lens - Distribution.Types.SourceRepo.Lens - Distribution.Types.TestSuite.Lens - - other-modules: - Distribution.Backpack.Id - Distribution.Backpack.MixLink - Distribution.Backpack.ModuleScope - Distribution.Backpack.PreExistingComponent - Distribution.Backpack.ReadyComponent - Distribution.Backpack.UnifyM - Distribution.Compat.CopyFile - Distribution.Compat.GetShortPathName - Distribution.Compat.MonadFail - Distribution.Compat.Prelude - Distribution.Compat.SnocList - Distribution.GetOpt - Distribution.Lex - Distribution.Simple.GHC.EnvironmentParser - Distribution.Simple.GHC.ImplInfo - Distribution.Simple.GHC.Internal - Distribution.Utils.Base62 - Distribution.Utils.String - Distribution.Utils.UnionFind - Paths_Cabal - - if flag(bundled-binary-generic) - other-modules: - Distribution.Compat.Binary.Class - Distribution.Compat.Binary.Generic - - default-language: Haskell2010 - other-extensions: - BangPatterns - CPP - DefaultSignatures - DeriveDataTypeable - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveTraversable - ExistentialQuantification - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving - ImplicitParams - KindSignatures - NondecreasingIndentation - OverloadedStrings - RankNTypes - RecordWildCards - ScopedTypeVariables - StandaloneDeriving - Trustworthy - TypeFamilies - TypeOperators - TypeSynonymInstances - UndecidableInstances - - if impl(ghc >=7.11) - other-extensions: PatternSynonyms - --- Small, fast running tests. -test-suite unit-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - other-modules: - Test.Laws - Test.QuickCheck.Utils - UnitTests.Distribution.Compat.CreatePipe - UnitTests.Distribution.Compat.Graph - UnitTests.Distribution.Compat.Time - UnitTests.Distribution.Simple.Glob - UnitTests.Distribution.Simple.Program.Internal - UnitTests.Distribution.Simple.Utils - UnitTests.Distribution.SPDX - UnitTests.Distribution.System - UnitTests.Distribution.Types.GenericPackageDescription - UnitTests.Distribution.Utils.Generic - UnitTests.Distribution.Utils.NubList - UnitTests.Distribution.Utils.ShortText - UnitTests.Distribution.Version - - main-is: UnitTests.hs - build-depends: - array - , base - , bytestring - , Cabal - , containers - , directory - , filepath - , integer-logarithms >=1.0.2 && <1.1 - , pretty - , QuickCheck >=2.11.3 && <2.12 - , tagged - , tasty >=1.1.0.3 && <1.2 - , tasty-hunit - , tasty-quickcheck - , temporary - , text - - ghc-options: -Wall - default-language: Haskell2010 - -test-suite parser-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: ParserTests.hs - build-depends: - base - , base-compat >=0.10.4 && <0.11 - , bytestring - , Cabal - , Diff >=0.3.4 && <0.4 - , directory - , filepath - , tasty >=1.1.0.3 && <1.2 - , tasty-golden >=2.3.1.1 && <2.4 - , tasty-hunit - , tasty-quickcheck - - ghc-options: -Wall - default-language: Haskell2010 - - if impl(ghc >=7.8) - build-depends: tree-diff >=0.0.1 && <0.1 - other-modules: - Instances.TreeDiff - Instances.TreeDiff.Language - Instances.TreeDiff.SPDX - Instances.TreeDiff.Version - -test-suite check-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: CheckTests.hs - build-depends: - base - , bytestring - , Cabal - , Diff >=0.3.4 && <0.4 - , directory - , filepath - , tasty >=1.1.0.3 && <1.2 - , tasty-golden >=2.3.1.1 && <2.4 - - ghc-options: -Wall - default-language: Haskell2010 - -test-suite custom-setup-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests/custom-setup - main-is: CustomSetupTests.hs - other-modules: - CabalDoctestSetup - IdrisSetup - - build-depends: - base - , Cabal - , directory - , filepath - , process - - default-language: Haskell2010 - -test-suite hackage-tests - type: exitcode-stdio-1.0 - main-is: HackageTests.hs - - -- TODO: need to get 01-index.tar on appveyor - if os(windows) - buildable: False - - hs-source-dirs: tests - build-depends: - base - , bytestring - , Cabal - , containers - , deepseq - , directory - , filepath - - build-depends: - base-compat >=0.10.4 && <0.11 - , base-orphans >=0.6 && <0.9 - , optparse-applicative >=0.13.2.0 && <0.15 - , stm >=2.4.5.0 && <2.6 - , tar >=0.5.0.3 && <0.6 - - if impl(ghc >=7.8) - build-depends: tree-diff >=0.0.1 && <0.1 - other-modules: - Instances.TreeDiff - Instances.TreeDiff.Language - Instances.TreeDiff.SPDX - Instances.TreeDiff.Version - - ghc-options: -Wall -rtsopts -threaded - default-extensions: CPP - default-language: Haskell2010 diff --git a/fixtures/Cabal.cabal b/fixtures/Cabal.cabal deleted file mode 100644 --- a/fixtures/Cabal.cabal +++ /dev/null @@ -1,652 +0,0 @@ -name: Cabal -version: 2.5.0.0 -copyright: 2003-2018, Cabal Development Team (see AUTHORS file) -license: BSD3 -license-file: LICENSE -author: Cabal Development Team -maintainer: cabal-devel@haskell.org -homepage: http://www.haskell.org/cabal/ -bug-reports: https://github.com/haskell/cabal/issues -synopsis: A framework for packaging Haskell software -description: - The Haskell Common Architecture for Building Applications and - Libraries: a framework defining a common interface for authors to more - easily build their Haskell applications in a portable way. - . - The Haskell Cabal is part of a larger infrastructure for distributing, - organizing, and cataloging Haskell libraries and tools. -category: Distribution -cabal-version: >=1.10 -build-type: Simple --- If we use a new Cabal feature, this needs to be changed to Custom so --- we can bootstrap. - -extra-source-files: - README.md tests/README.md ChangeLog.md - doc/bugs-and-stability.rst doc/concepts-and-development.rst - doc/conf.py doc/config-and-install.rst doc/developing-packages.rst - doc/images/Cabal-dark.png doc/index.rst doc/installing-packages.rst - doc/intro.rst doc/misc.rst doc/nix-local-build-overview.rst - doc/nix-local-build.rst doc/file-format-changelog.rst doc/README.md - doc/references.inc - - -- Generated with 'make gen-extra-source-files' - -- Do NOT edit this section manually; instead, run the script. - -- BEGIN gen-extra-source-files - tests/ParserTests/errors/common1.cabal - tests/ParserTests/errors/common1.errors - tests/ParserTests/errors/common2.cabal - tests/ParserTests/errors/common2.errors - tests/ParserTests/errors/common3.cabal - tests/ParserTests/errors/common3.errors - tests/ParserTests/errors/forward-compat.cabal - tests/ParserTests/errors/forward-compat.errors - tests/ParserTests/errors/forward-compat2.cabal - tests/ParserTests/errors/forward-compat2.errors - tests/ParserTests/errors/forward-compat3.cabal - tests/ParserTests/errors/forward-compat3.errors - tests/ParserTests/errors/issue-5055-2.cabal - tests/ParserTests/errors/issue-5055-2.errors - tests/ParserTests/errors/issue-5055.cabal - tests/ParserTests/errors/issue-5055.errors - tests/ParserTests/errors/leading-comma-2.cabal - tests/ParserTests/errors/leading-comma-2.errors - tests/ParserTests/errors/leading-comma-2b.cabal - tests/ParserTests/errors/leading-comma-2b.errors - tests/ParserTests/errors/leading-comma-2c.cabal - tests/ParserTests/errors/leading-comma-2c.errors - tests/ParserTests/errors/leading-comma.cabal - tests/ParserTests/errors/leading-comma.errors - tests/ParserTests/errors/multiple-libs.cabal - tests/ParserTests/errors/multiple-libs.errors - tests/ParserTests/errors/noVersion.cabal - tests/ParserTests/errors/noVersion.errors - tests/ParserTests/errors/noVersion2.cabal - tests/ParserTests/errors/noVersion2.errors - tests/ParserTests/errors/range-ge-wild.cabal - tests/ParserTests/errors/range-ge-wild.errors - tests/ParserTests/errors/removed-fields.cabal - tests/ParserTests/errors/removed-fields.errors - tests/ParserTests/errors/spdx-1.cabal - tests/ParserTests/errors/spdx-1.errors - tests/ParserTests/errors/spdx-2.cabal - tests/ParserTests/errors/spdx-2.errors - tests/ParserTests/errors/spdx-3.cabal - tests/ParserTests/errors/spdx-3.errors - tests/ParserTests/ipi/Includes2.cabal - tests/ParserTests/ipi/Includes2.expr - tests/ParserTests/ipi/Includes2.format - tests/ParserTests/ipi/internal-preprocessor-test.cabal - tests/ParserTests/ipi/internal-preprocessor-test.expr - tests/ParserTests/ipi/internal-preprocessor-test.format - tests/ParserTests/ipi/issue-2276-ghc-9885.cabal - tests/ParserTests/ipi/issue-2276-ghc-9885.expr - tests/ParserTests/ipi/issue-2276-ghc-9885.format - tests/ParserTests/ipi/transformers.cabal - tests/ParserTests/ipi/transformers.expr - tests/ParserTests/ipi/transformers.format - tests/ParserTests/regressions/MiniAgda.cabal - tests/ParserTests/regressions/MiniAgda.check - tests/ParserTests/regressions/Octree-0.5.cabal - tests/ParserTests/regressions/Octree-0.5.expr - tests/ParserTests/regressions/Octree-0.5.format - tests/ParserTests/regressions/bad-glob-syntax.cabal - tests/ParserTests/regressions/bad-glob-syntax.check - tests/ParserTests/regressions/cc-options-with-optimization.cabal - tests/ParserTests/regressions/cc-options-with-optimization.check - tests/ParserTests/regressions/common-conditional.cabal - tests/ParserTests/regressions/common-conditional.expr - tests/ParserTests/regressions/common-conditional.format - tests/ParserTests/regressions/common.cabal - tests/ParserTests/regressions/common.expr - tests/ParserTests/regressions/common.format - tests/ParserTests/regressions/common2.cabal - tests/ParserTests/regressions/common2.expr - tests/ParserTests/regressions/common2.format - tests/ParserTests/regressions/cxx-options-with-optimization.cabal - tests/ParserTests/regressions/cxx-options-with-optimization.check - tests/ParserTests/regressions/elif.cabal - tests/ParserTests/regressions/elif.expr - tests/ParserTests/regressions/elif.format - tests/ParserTests/regressions/elif2.cabal - tests/ParserTests/regressions/elif2.expr - tests/ParserTests/regressions/elif2.format - tests/ParserTests/regressions/encoding-0.8.cabal - tests/ParserTests/regressions/encoding-0.8.expr - tests/ParserTests/regressions/encoding-0.8.format - tests/ParserTests/regressions/extensions-paths-5054.cabal - tests/ParserTests/regressions/extensions-paths-5054.check - tests/ParserTests/regressions/generics-sop.cabal - tests/ParserTests/regressions/generics-sop.expr - tests/ParserTests/regressions/generics-sop.format - tests/ParserTests/regressions/ghc-option-j.cabal - tests/ParserTests/regressions/ghc-option-j.check - tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal - tests/ParserTests/regressions/haddock-api-2.18.1-check.check - tests/ParserTests/regressions/hidden-main-lib.cabal - tests/ParserTests/regressions/hidden-main-lib.expr - tests/ParserTests/regressions/hidden-main-lib.format - tests/ParserTests/regressions/issue-5055.cabal - tests/ParserTests/regressions/issue-5055.expr - tests/ParserTests/regressions/issue-5055.format - tests/ParserTests/regressions/issue-774.cabal - tests/ParserTests/regressions/issue-774.check - tests/ParserTests/regressions/issue-774.expr - tests/ParserTests/regressions/issue-774.format - tests/ParserTests/regressions/jaeger-flamegraph.cabal - tests/ParserTests/regressions/jaeger-flamegraph.expr - tests/ParserTests/regressions/jaeger-flamegraph.format - tests/ParserTests/regressions/leading-comma-2.cabal - tests/ParserTests/regressions/leading-comma-2.expr - tests/ParserTests/regressions/leading-comma-2.format - tests/ParserTests/regressions/leading-comma.cabal - tests/ParserTests/regressions/leading-comma.expr - tests/ParserTests/regressions/leading-comma.format - tests/ParserTests/regressions/multiple-libs-2.cabal - tests/ParserTests/regressions/multiple-libs-2.check - tests/ParserTests/regressions/multiple-libs-2.expr - tests/ParserTests/regressions/multiple-libs-2.format - tests/ParserTests/regressions/noVersion.cabal - tests/ParserTests/regressions/noVersion.expr - tests/ParserTests/regressions/noVersion.format - tests/ParserTests/regressions/nothing-unicode.cabal - tests/ParserTests/regressions/nothing-unicode.check - tests/ParserTests/regressions/nothing-unicode.expr - tests/ParserTests/regressions/nothing-unicode.format - tests/ParserTests/regressions/pre-1.6-glob.cabal - tests/ParserTests/regressions/pre-1.6-glob.check - tests/ParserTests/regressions/pre-2.4-globstar.cabal - tests/ParserTests/regressions/pre-2.4-globstar.check - tests/ParserTests/regressions/shake.cabal - tests/ParserTests/regressions/shake.expr - tests/ParserTests/regressions/shake.format - tests/ParserTests/regressions/spdx-1.cabal - tests/ParserTests/regressions/spdx-1.expr - tests/ParserTests/regressions/spdx-1.format - tests/ParserTests/regressions/spdx-2.cabal - tests/ParserTests/regressions/spdx-2.expr - tests/ParserTests/regressions/spdx-2.format - tests/ParserTests/regressions/spdx-3.cabal - tests/ParserTests/regressions/spdx-3.expr - tests/ParserTests/regressions/spdx-3.format - tests/ParserTests/regressions/th-lift-instances.cabal - tests/ParserTests/regressions/th-lift-instances.expr - tests/ParserTests/regressions/th-lift-instances.format - tests/ParserTests/regressions/wl-pprint-indef.cabal - tests/ParserTests/regressions/wl-pprint-indef.expr - tests/ParserTests/regressions/wl-pprint-indef.format - tests/ParserTests/warnings/bom.cabal - tests/ParserTests/warnings/bool.cabal - tests/ParserTests/warnings/deprecatedfield.cabal - tests/ParserTests/warnings/doubledash.cabal - tests/ParserTests/warnings/extratestmodule.cabal - tests/ParserTests/warnings/gluedop.cabal - tests/ParserTests/warnings/multiplesingular.cabal - tests/ParserTests/warnings/nbsp.cabal - tests/ParserTests/warnings/newsyntax.cabal - tests/ParserTests/warnings/oldsyntax.cabal - tests/ParserTests/warnings/subsection.cabal - tests/ParserTests/warnings/tab.cabal - tests/ParserTests/warnings/trailingfield.cabal - tests/ParserTests/warnings/unknownfield.cabal - tests/ParserTests/warnings/unknownsection.cabal - tests/ParserTests/warnings/utf8.cabal - tests/ParserTests/warnings/versiontag.cabal - tests/hackage/check.sh - tests/hackage/download.sh - tests/hackage/unpack.sh - tests/misc/ghc-supported-languages.hs - -- END gen-extra-source-files - -source-repository head - type: git - location: https://github.com/haskell/cabal/ - subdir: Cabal - -flag bundled-binary-generic - default: False - -library - build-depends: - array >= 0.4.0.1 && < 0.6, - base >= 4.6 && < 5, - bytestring >= 0.10.0.0 && < 0.11, - containers >= 0.5.0.0 && < 0.7, - deepseq >= 1.3.0.1 && < 1.5, - directory >= 1.2 && < 1.4, - filepath >= 1.3.0.1 && < 1.5, - pretty >= 1.1.1 && < 1.2, - process >= 1.1.0.2 && < 1.7, - time >= 1.4.0.1 && < 1.10 - - if flag(bundled-binary-generic) - build-depends: binary >= 0.5.1.1 && < 0.7 - else - build-depends: binary >= 0.7 && < 0.9 - - if os(windows) - build-depends: Win32 >= 2.3.0.0 && < 2.9 - else - build-depends: unix >= 2.6.0.0 && < 2.8 - - ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs - if impl(ghc >= 8.0) - ghc-options: -Wcompat -Wnoncanonical-monad-instances - -Wnoncanonical-monadfail-instances - - exposed-modules: - Distribution.Backpack - Distribution.Backpack.Configure - Distribution.Backpack.ComponentsGraph - Distribution.Backpack.ConfiguredComponent - Distribution.Backpack.DescribeUnitId - Distribution.Backpack.FullUnitId - Distribution.Backpack.LinkedComponent - Distribution.Backpack.ModSubst - Distribution.Backpack.ModuleShape - Distribution.Backpack.PreModuleShape - Distribution.CabalSpecVersion - Distribution.Utils.IOData - Distribution.Utils.LogProgress - Distribution.Utils.MapAccum - Distribution.Compat.CreatePipe - Distribution.Compat.Directory - Distribution.Compat.Environment - Distribution.Compat.Exception - Distribution.Compat.Graph - Distribution.Compat.Internal.TempFile - Distribution.Compat.Newtype - Distribution.Compat.Prelude.Internal - Distribution.Compat.Semigroup - Distribution.Compat.Stack - Distribution.Compat.Time - Distribution.Compat.DList - Distribution.Compiler - Distribution.InstalledPackageInfo - Distribution.Types.AbiDependency - Distribution.Types.ExposedModule - Distribution.Types.InstalledPackageInfo - Distribution.Types.InstalledPackageInfo.FieldGrammar - Distribution.License - Distribution.Make - Distribution.ModuleName - Distribution.Package - Distribution.PackageDescription - Distribution.PackageDescription.Check - Distribution.PackageDescription.Configuration - Distribution.PackageDescription.PrettyPrint - Distribution.PackageDescription.Utils - Distribution.ReadE - Distribution.Simple - Distribution.Simple.Bench - Distribution.Simple.Build - Distribution.Simple.Build.Macros - Distribution.Simple.Build.PathsModule - Distribution.Simple.BuildPaths - Distribution.Simple.BuildTarget - Distribution.Simple.BuildToolDepends - Distribution.Simple.CCompiler - Distribution.Simple.Command - Distribution.Simple.Compiler - Distribution.Simple.Configure - Distribution.Simple.Flag - Distribution.Simple.GHC - Distribution.Simple.GHCJS - Distribution.Simple.Haddock - Distribution.Simple.Doctest - Distribution.Simple.Glob - Distribution.Simple.HaskellSuite - Distribution.Simple.Hpc - Distribution.Simple.Install - Distribution.Simple.InstallDirs - Distribution.Simple.LocalBuildInfo - Distribution.Simple.PackageIndex - Distribution.Simple.PreProcess - Distribution.Simple.PreProcess.Unlit - Distribution.Simple.Program - Distribution.Simple.Program.Ar - Distribution.Simple.Program.Builtin - Distribution.Simple.Program.Db - Distribution.Simple.Program.Find - Distribution.Simple.Program.GHC - Distribution.Simple.Program.HcPkg - Distribution.Simple.Program.Hpc - Distribution.Simple.Program.Internal - Distribution.Simple.Program.Ld - Distribution.Simple.Program.ResponseFile - Distribution.Simple.Program.Run - Distribution.Simple.Program.Script - Distribution.Simple.Program.Strip - Distribution.Simple.Program.Types - Distribution.Simple.Register - Distribution.Simple.Setup - Distribution.Simple.SrcDist - Distribution.Simple.Test - Distribution.Simple.Test.ExeV10 - Distribution.Simple.Test.LibV09 - Distribution.Simple.Test.Log - Distribution.Simple.UHC - Distribution.Simple.UserHooks - Distribution.Simple.Utils - Distribution.SPDX - Distribution.SPDX.License - Distribution.SPDX.LicenseId - Distribution.SPDX.LicenseExceptionId - Distribution.SPDX.LicenseExpression - Distribution.SPDX.LicenseListVersion - Distribution.SPDX.LicenseReference - Distribution.System - Distribution.TestSuite - Distribution.Text - Distribution.Pretty - Distribution.Types.AbiHash - Distribution.Types.AnnotatedId - Distribution.Types.Benchmark - Distribution.Types.BenchmarkInterface - Distribution.Types.BenchmarkType - Distribution.Types.BuildInfo - Distribution.Types.BuildType - Distribution.Types.ComponentInclude - Distribution.Types.Dependency - Distribution.Types.ExeDependency - Distribution.Types.LegacyExeDependency - Distribution.Types.PkgconfigDependency - Distribution.Types.DependencyMap - Distribution.Types.ComponentId - Distribution.Types.MungedPackageId - Distribution.Types.PackageId - Distribution.Types.UnitId - Distribution.Types.Executable - Distribution.Types.ExecutableScope - Distribution.Types.Library - Distribution.Types.LibraryVisibility - Distribution.Types.ForeignLib - Distribution.Types.ForeignLibType - Distribution.Types.ForeignLibOption - Distribution.Types.Module - Distribution.Types.ModuleReexport - Distribution.Types.ModuleRenaming - Distribution.Types.ComponentName - Distribution.Types.LibraryName - Distribution.Types.MungedPackageName - Distribution.Types.PackageName - Distribution.Types.PkgconfigName - Distribution.Types.UnqualComponentName - Distribution.Types.IncludeRenaming - Distribution.Types.Mixin - Distribution.Types.SetupBuildInfo - Distribution.Types.TestSuite - Distribution.Types.TestSuiteInterface - Distribution.Types.TestType - Distribution.Types.GenericPackageDescription - Distribution.Types.Condition - Distribution.Types.CondTree - Distribution.Types.HookedBuildInfo - Distribution.Types.PackageDescription - Distribution.Types.SourceRepo - Distribution.Types.Component - Distribution.Types.ComponentLocalBuildInfo - Distribution.Types.LocalBuildInfo - Distribution.Types.ComponentRequestedSpec - Distribution.Types.TargetInfo - Distribution.Types.Version - Distribution.Types.VersionRange - Distribution.Types.VersionInterval - Distribution.Types.GivenComponent - Distribution.Types.PackageVersionConstraint - Distribution.Utils.Generic - Distribution.Utils.NubList - Distribution.Utils.ShortText - Distribution.Utils.Progress - Distribution.Verbosity - Distribution.Version - Language.Haskell.Extension - Distribution.Compat.Binary - - -- Parsec parser-related modules - build-depends: - -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity - -- See also https://github.com/ekmett/transformers-compat/issues/35 - transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.6), - mtl >= 2.1 && < 2.3, - text >= 1.2.3.0 && < 1.3, - parsec >= 3.1.13.0 && < 3.2 - exposed-modules: - Distribution.Compat.Parsing - Distribution.Compat.CharParsing - Distribution.FieldGrammar - Distribution.FieldGrammar.Class - Distribution.FieldGrammar.FieldDescrs - Distribution.FieldGrammar.Parsec - Distribution.FieldGrammar.Pretty - Distribution.PackageDescription.FieldGrammar - Distribution.PackageDescription.Parsec - Distribution.PackageDescription.Quirks - Distribution.Parsec - Distribution.Parsec.Error - Distribution.Parsec.Newtypes - Distribution.Parsec.Position - Distribution.Parsec.Warning - Distribution.Parsec.FieldLineStream - Distribution.Fields - Distribution.Fields.ConfVar - Distribution.Fields.Field - Distribution.Fields.Lexer - Distribution.Fields.LexerMonad - Distribution.Fields.ParseResult - Distribution.Fields.Parser - Distribution.Fields.Pretty - - -- Lens functionality - exposed-modules: - Distribution.Compat.Lens - Distribution.Types.Lens - Distribution.Types.Benchmark.Lens - Distribution.Types.BuildInfo.Lens - Distribution.Types.Executable.Lens - Distribution.Types.ForeignLib.Lens - Distribution.Types.GenericPackageDescription.Lens - Distribution.Types.InstalledPackageInfo.Lens - Distribution.Types.Library.Lens - Distribution.Types.PackageDescription.Lens - Distribution.Types.PackageId.Lens - Distribution.Types.SetupBuildInfo.Lens - Distribution.Types.SourceRepo.Lens - Distribution.Types.TestSuite.Lens - - other-modules: - Distribution.Backpack.PreExistingComponent - Distribution.Backpack.ReadyComponent - Distribution.Backpack.MixLink - Distribution.Backpack.ModuleScope - Distribution.Backpack.UnifyM - Distribution.Backpack.Id - Distribution.Utils.UnionFind - Distribution.Utils.Base62 - Distribution.Compat.CopyFile - Distribution.Compat.GetShortPathName - Distribution.Compat.MonadFail - Distribution.Compat.Prelude - Distribution.Compat.SnocList - Distribution.GetOpt - Distribution.Lex - Distribution.Utils.String - Distribution.Simple.GHC.EnvironmentParser - Distribution.Simple.GHC.Internal - Distribution.Simple.GHC.ImplInfo - Paths_Cabal - - if flag(bundled-binary-generic) - other-modules: - Distribution.Compat.Binary.Class - Distribution.Compat.Binary.Generic - - default-language: Haskell2010 - other-extensions: - BangPatterns - CPP - DefaultSignatures - DeriveDataTypeable - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveTraversable - ExistentialQuantification - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving - ImplicitParams - KindSignatures - NondecreasingIndentation - OverloadedStrings - RankNTypes - RecordWildCards - ScopedTypeVariables - StandaloneDeriving - Trustworthy - TypeFamilies - TypeOperators - TypeSynonymInstances - UndecidableInstances - - if impl(ghc >= 7.11) - other-extensions: PatternSynonyms - --- Small, fast running tests. -test-suite unit-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - other-modules: - Test.Laws - Test.QuickCheck.Utils - UnitTests.Distribution.Compat.CreatePipe - UnitTests.Distribution.Compat.Time - UnitTests.Distribution.Compat.Graph - UnitTests.Distribution.Simple.Glob - UnitTests.Distribution.Simple.Program.Internal - UnitTests.Distribution.Simple.Utils - UnitTests.Distribution.SPDX - UnitTests.Distribution.System - UnitTests.Distribution.Types.GenericPackageDescription - UnitTests.Distribution.Utils.Generic - UnitTests.Distribution.Utils.NubList - UnitTests.Distribution.Utils.ShortText - UnitTests.Distribution.Version - main-is: UnitTests.hs - build-depends: - array, - base, - bytestring, - containers, - directory, - filepath, - integer-logarithms >= 1.0.2 && <1.1, - tasty >= 1.1.0.3 && < 1.2, - tasty-hunit, - tasty-quickcheck, - tagged, - temporary, - text, - pretty, - QuickCheck >= 2.11.3 && < 2.12, - Cabal - ghc-options: -Wall - default-language: Haskell2010 - -test-suite parser-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: ParserTests.hs - build-depends: - base, - base-compat >=0.10.4 && <0.11, - bytestring, - directory, - filepath, - tasty >= 1.1.0.3 && < 1.2, - tasty-hunit, - tasty-quickcheck, - tasty-golden >=2.3.1.1 && <2.4, - Diff >=0.3.4 && <0.4, - Cabal - ghc-options: -Wall - default-language: Haskell2010 - - if impl(ghc >= 7.8) - build-depends: - tree-diff >= 0.0.1 && <0.1 - other-modules: - Instances.TreeDiff - Instances.TreeDiff.Language - Instances.TreeDiff.SPDX - Instances.TreeDiff.Version - -test-suite check-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: CheckTests.hs - build-depends: - base, - bytestring, - directory, - filepath, - tasty >= 1.1.0.3 && < 1.2, - tasty-golden >=2.3.1.1 && <2.4, - Diff >=0.3.4 && <0.4, - Cabal - ghc-options: -Wall - default-language: Haskell2010 - -test-suite custom-setup-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests/custom-setup - main-is: CustomSetupTests.hs - other-modules: - CabalDoctestSetup - IdrisSetup - build-depends: - Cabal, - base, - directory, - filepath, - process - default-language: Haskell2010 - -test-suite hackage-tests - type: exitcode-stdio-1.0 - main-is: HackageTests.hs - - -- TODO: need to get 01-index.tar on appveyor - if os(windows) - buildable: False - - hs-source-dirs: tests - - build-depends: - base, - Cabal, - bytestring, - deepseq, - containers, - directory, - filepath - - build-depends: - base-compat >=0.10.4 && <0.11, - base-orphans >=0.6 && <0.9, - optparse-applicative >=0.13.2.0 && <0.15, - stm >=2.4.5.0 && <2.6, - tar >=0.5.0.3 && <0.6 - - if impl(ghc >= 7.8) - build-depends: - tree-diff >= 0.0.1 && <0.1 - other-modules: - Instances.TreeDiff - Instances.TreeDiff.Language - Instances.TreeDiff.SPDX - Instances.TreeDiff.Version - - ghc-options: -Wall -rtsopts -threaded - default-extensions: CPP - default-language: Haskell2010 diff --git a/fixtures/Cabal.format b/fixtures/Cabal.format deleted file mode 100644 --- a/fixtures/Cabal.format +++ /dev/null @@ -1,673 +0,0 @@ -name: Cabal -version: 2.5.0.0 -copyright: 2003-2018, Cabal Development Team (see AUTHORS file) -license: BSD3 -license-file: LICENSE -author: Cabal Development Team -maintainer: cabal-devel@haskell.org -homepage: http://www.haskell.org/cabal/ -bug-reports: https://github.com/haskell/cabal/issues -synopsis: A framework for packaging Haskell software -description: - The Haskell Common Architecture for Building Applications and - Libraries: a framework defining a common interface for authors to more - easily build their Haskell applications in a portable way. - . - The Haskell Cabal is part of a larger infrastructure for distributing, - organizing, and cataloging Haskell libraries and tools. - -category: Distribution -cabal-version: >=1.10 -build-type: Simple - --- If we use a new Cabal feature, this needs to be changed to Custom so --- we can bootstrap. - -extra-source-files: - ChangeLog.md - doc/bugs-and-stability.rst - doc/concepts-and-development.rst - doc/conf.py - doc/config-and-install.rst - doc/developing-packages.rst - doc/file-format-changelog.rst - doc/images/Cabal-dark.png - doc/index.rst - doc/installing-packages.rst - doc/intro.rst - doc/misc.rst - doc/nix-local-build-overview.rst - doc/nix-local-build.rst - doc/README.md - doc/references.inc - README.md - tests/hackage/check.sh - tests/hackage/download.sh - tests/hackage/unpack.sh - tests/misc/ghc-supported-languages.hs - tests/ParserTests/errors/common1.cabal - tests/ParserTests/errors/common1.errors - tests/ParserTests/errors/common2.cabal - tests/ParserTests/errors/common2.errors - tests/ParserTests/errors/common3.cabal - tests/ParserTests/errors/common3.errors - tests/ParserTests/errors/forward-compat.cabal - tests/ParserTests/errors/forward-compat.errors - tests/ParserTests/errors/forward-compat2.cabal - tests/ParserTests/errors/forward-compat2.errors - tests/ParserTests/errors/forward-compat3.cabal - tests/ParserTests/errors/forward-compat3.errors - tests/ParserTests/errors/issue-5055-2.cabal - tests/ParserTests/errors/issue-5055-2.errors - tests/ParserTests/errors/issue-5055.cabal - tests/ParserTests/errors/issue-5055.errors - tests/ParserTests/errors/leading-comma-2.cabal - tests/ParserTests/errors/leading-comma-2.errors - tests/ParserTests/errors/leading-comma-2b.cabal - tests/ParserTests/errors/leading-comma-2b.errors - tests/ParserTests/errors/leading-comma-2c.cabal - tests/ParserTests/errors/leading-comma-2c.errors - tests/ParserTests/errors/leading-comma.cabal - tests/ParserTests/errors/leading-comma.errors - tests/ParserTests/errors/multiple-libs.cabal - tests/ParserTests/errors/multiple-libs.errors - tests/ParserTests/errors/noVersion.cabal - tests/ParserTests/errors/noVersion.errors - tests/ParserTests/errors/noVersion2.cabal - tests/ParserTests/errors/noVersion2.errors - tests/ParserTests/errors/range-ge-wild.cabal - tests/ParserTests/errors/range-ge-wild.errors - tests/ParserTests/errors/removed-fields.cabal - tests/ParserTests/errors/removed-fields.errors - tests/ParserTests/errors/spdx-1.cabal - tests/ParserTests/errors/spdx-1.errors - tests/ParserTests/errors/spdx-2.cabal - tests/ParserTests/errors/spdx-2.errors - tests/ParserTests/errors/spdx-3.cabal - tests/ParserTests/errors/spdx-3.errors - tests/ParserTests/ipi/Includes2.cabal - tests/ParserTests/ipi/Includes2.expr - tests/ParserTests/ipi/Includes2.format - tests/ParserTests/ipi/internal-preprocessor-test.cabal - tests/ParserTests/ipi/internal-preprocessor-test.expr - tests/ParserTests/ipi/internal-preprocessor-test.format - tests/ParserTests/ipi/issue-2276-ghc-9885.cabal - tests/ParserTests/ipi/issue-2276-ghc-9885.expr - tests/ParserTests/ipi/issue-2276-ghc-9885.format - tests/ParserTests/ipi/transformers.cabal - tests/ParserTests/ipi/transformers.expr - tests/ParserTests/ipi/transformers.format - tests/ParserTests/regressions/bad-glob-syntax.cabal - tests/ParserTests/regressions/bad-glob-syntax.check - tests/ParserTests/regressions/cc-options-with-optimization.cabal - tests/ParserTests/regressions/cc-options-with-optimization.check - tests/ParserTests/regressions/common-conditional.cabal - tests/ParserTests/regressions/common-conditional.expr - tests/ParserTests/regressions/common-conditional.format - tests/ParserTests/regressions/common.cabal - tests/ParserTests/regressions/common.expr - tests/ParserTests/regressions/common.format - tests/ParserTests/regressions/common2.cabal - tests/ParserTests/regressions/common2.expr - tests/ParserTests/regressions/common2.format - tests/ParserTests/regressions/cxx-options-with-optimization.cabal - tests/ParserTests/regressions/cxx-options-with-optimization.check - tests/ParserTests/regressions/elif.cabal - tests/ParserTests/regressions/elif.expr - tests/ParserTests/regressions/elif.format - tests/ParserTests/regressions/elif2.cabal - tests/ParserTests/regressions/elif2.expr - tests/ParserTests/regressions/elif2.format - tests/ParserTests/regressions/encoding-0.8.cabal - tests/ParserTests/regressions/encoding-0.8.expr - tests/ParserTests/regressions/encoding-0.8.format - tests/ParserTests/regressions/extensions-paths-5054.cabal - tests/ParserTests/regressions/extensions-paths-5054.check - tests/ParserTests/regressions/generics-sop.cabal - tests/ParserTests/regressions/generics-sop.expr - tests/ParserTests/regressions/generics-sop.format - tests/ParserTests/regressions/ghc-option-j.cabal - tests/ParserTests/regressions/ghc-option-j.check - tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal - tests/ParserTests/regressions/haddock-api-2.18.1-check.check - tests/ParserTests/regressions/hidden-main-lib.cabal - tests/ParserTests/regressions/hidden-main-lib.expr - tests/ParserTests/regressions/hidden-main-lib.format - tests/ParserTests/regressions/issue-5055.cabal - tests/ParserTests/regressions/issue-5055.expr - tests/ParserTests/regressions/issue-5055.format - tests/ParserTests/regressions/issue-774.cabal - tests/ParserTests/regressions/issue-774.check - tests/ParserTests/regressions/issue-774.expr - tests/ParserTests/regressions/issue-774.format - tests/ParserTests/regressions/jaeger-flamegraph.cabal - tests/ParserTests/regressions/jaeger-flamegraph.expr - tests/ParserTests/regressions/jaeger-flamegraph.format - tests/ParserTests/regressions/leading-comma-2.cabal - tests/ParserTests/regressions/leading-comma-2.expr - tests/ParserTests/regressions/leading-comma-2.format - tests/ParserTests/regressions/leading-comma.cabal - tests/ParserTests/regressions/leading-comma.expr - tests/ParserTests/regressions/leading-comma.format - tests/ParserTests/regressions/MiniAgda.cabal - tests/ParserTests/regressions/MiniAgda.check - tests/ParserTests/regressions/multiple-libs-2.cabal - tests/ParserTests/regressions/multiple-libs-2.check - tests/ParserTests/regressions/multiple-libs-2.expr - tests/ParserTests/regressions/multiple-libs-2.format - tests/ParserTests/regressions/nothing-unicode.cabal - tests/ParserTests/regressions/nothing-unicode.check - tests/ParserTests/regressions/nothing-unicode.expr - tests/ParserTests/regressions/nothing-unicode.format - tests/ParserTests/regressions/noVersion.cabal - tests/ParserTests/regressions/noVersion.expr - tests/ParserTests/regressions/noVersion.format - tests/ParserTests/regressions/Octree-0.5.cabal - tests/ParserTests/regressions/Octree-0.5.expr - tests/ParserTests/regressions/Octree-0.5.format - tests/ParserTests/regressions/pre-1.6-glob.cabal - tests/ParserTests/regressions/pre-1.6-glob.check - tests/ParserTests/regressions/pre-2.4-globstar.cabal - tests/ParserTests/regressions/pre-2.4-globstar.check - tests/ParserTests/regressions/shake.cabal - tests/ParserTests/regressions/shake.expr - tests/ParserTests/regressions/shake.format - tests/ParserTests/regressions/spdx-1.cabal - tests/ParserTests/regressions/spdx-1.expr - tests/ParserTests/regressions/spdx-1.format - tests/ParserTests/regressions/spdx-2.cabal - tests/ParserTests/regressions/spdx-2.expr - tests/ParserTests/regressions/spdx-2.format - tests/ParserTests/regressions/spdx-3.cabal - tests/ParserTests/regressions/spdx-3.expr - tests/ParserTests/regressions/spdx-3.format - tests/ParserTests/regressions/th-lift-instances.cabal - tests/ParserTests/regressions/th-lift-instances.expr - tests/ParserTests/regressions/th-lift-instances.format - tests/ParserTests/regressions/wl-pprint-indef.cabal - tests/ParserTests/regressions/wl-pprint-indef.expr - tests/ParserTests/regressions/wl-pprint-indef.format - tests/ParserTests/warnings/bom.cabal - tests/ParserTests/warnings/bool.cabal - tests/ParserTests/warnings/deprecatedfield.cabal - tests/ParserTests/warnings/doubledash.cabal - tests/ParserTests/warnings/extratestmodule.cabal - tests/ParserTests/warnings/gluedop.cabal - tests/ParserTests/warnings/multiplesingular.cabal - tests/ParserTests/warnings/nbsp.cabal - tests/ParserTests/warnings/newsyntax.cabal - tests/ParserTests/warnings/oldsyntax.cabal - tests/ParserTests/warnings/subsection.cabal - tests/ParserTests/warnings/tab.cabal - tests/ParserTests/warnings/trailingfield.cabal - tests/ParserTests/warnings/unknownfield.cabal - tests/ParserTests/warnings/unknownsection.cabal - tests/ParserTests/warnings/utf8.cabal - tests/ParserTests/warnings/versiontag.cabal - tests/README.md - --- Generated with 'make gen-extra-source-files' --- Do NOT edit this section manually; instead, run the script. --- BEGIN gen-extra-source-files --- END gen-extra-source-files - -source-repository head - type: git - location: https://github.com/haskell/cabal/ - subdir: Cabal - -flag bundled-binary-generic - default: False - -library - build-depends: - array >=0.4.0.1 && <0.6 - , base >=4.6 && <5 - , bytestring >=0.10.0.0 && <0.11 - , containers >=0.5.0.0 && <0.7 - , deepseq >=1.3.0.1 && <1.5 - , directory >=1.2 && <1.4 - , filepath >=1.3.0.1 && <1.5 - , pretty >=1.1.1 && <1.2 - , process >=1.1.0.2 && <1.7 - , time >=1.4.0.1 && <1.10 - - if flag(bundled-binary-generic) - build-depends: binary >=0.5.1.1 && <0.7 - - else - build-depends: binary >=0.7 && <0.9 - - if os(windows) - build-depends: Win32 >=2.3.0.0 && <2.9 - - else - build-depends: unix >=2.6.0.0 && <2.8 - - ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs - - if impl(ghc >=8.0) - ghc-options: - -Wcompat -Wnoncanonical-monad-instances - -Wnoncanonical-monadfail-instances - - exposed-modules: - Distribution.Backpack - Distribution.Backpack.ComponentsGraph - Distribution.Backpack.Configure - Distribution.Backpack.ConfiguredComponent - Distribution.Backpack.DescribeUnitId - Distribution.Backpack.FullUnitId - Distribution.Backpack.LinkedComponent - Distribution.Backpack.ModSubst - Distribution.Backpack.ModuleShape - Distribution.Backpack.PreModuleShape - Distribution.CabalSpecVersion - Distribution.Compat.Binary - Distribution.Compat.CreatePipe - Distribution.Compat.Directory - Distribution.Compat.DList - Distribution.Compat.Environment - Distribution.Compat.Exception - Distribution.Compat.Graph - Distribution.Compat.Internal.TempFile - Distribution.Compat.Newtype - Distribution.Compat.Prelude.Internal - Distribution.Compat.Semigroup - Distribution.Compat.Stack - Distribution.Compat.Time - Distribution.Compiler - Distribution.InstalledPackageInfo - Distribution.License - Distribution.Make - Distribution.ModuleName - Distribution.Package - Distribution.PackageDescription - Distribution.PackageDescription.Check - Distribution.PackageDescription.Configuration - Distribution.PackageDescription.PrettyPrint - Distribution.PackageDescription.Utils - Distribution.Pretty - Distribution.ReadE - Distribution.Simple - Distribution.Simple.Bench - Distribution.Simple.Build - Distribution.Simple.Build.Macros - Distribution.Simple.Build.PathsModule - Distribution.Simple.BuildPaths - Distribution.Simple.BuildTarget - Distribution.Simple.BuildToolDepends - Distribution.Simple.CCompiler - Distribution.Simple.Command - Distribution.Simple.Compiler - Distribution.Simple.Configure - Distribution.Simple.Doctest - Distribution.Simple.Flag - Distribution.Simple.GHC - Distribution.Simple.GHCJS - Distribution.Simple.Glob - Distribution.Simple.Haddock - Distribution.Simple.HaskellSuite - Distribution.Simple.Hpc - Distribution.Simple.Install - Distribution.Simple.InstallDirs - Distribution.Simple.LocalBuildInfo - Distribution.Simple.PackageIndex - Distribution.Simple.PreProcess - Distribution.Simple.PreProcess.Unlit - Distribution.Simple.Program - Distribution.Simple.Program.Ar - Distribution.Simple.Program.Builtin - Distribution.Simple.Program.Db - Distribution.Simple.Program.Find - Distribution.Simple.Program.GHC - Distribution.Simple.Program.HcPkg - Distribution.Simple.Program.Hpc - Distribution.Simple.Program.Internal - Distribution.Simple.Program.Ld - Distribution.Simple.Program.ResponseFile - Distribution.Simple.Program.Run - Distribution.Simple.Program.Script - Distribution.Simple.Program.Strip - Distribution.Simple.Program.Types - Distribution.Simple.Register - Distribution.Simple.Setup - Distribution.Simple.SrcDist - Distribution.Simple.Test - Distribution.Simple.Test.ExeV10 - Distribution.Simple.Test.LibV09 - Distribution.Simple.Test.Log - Distribution.Simple.UHC - Distribution.Simple.UserHooks - Distribution.Simple.Utils - Distribution.SPDX - Distribution.SPDX.License - Distribution.SPDX.LicenseExceptionId - Distribution.SPDX.LicenseExpression - Distribution.SPDX.LicenseId - Distribution.SPDX.LicenseListVersion - Distribution.SPDX.LicenseReference - Distribution.System - Distribution.TestSuite - Distribution.Text - Distribution.Types.AbiDependency - Distribution.Types.AbiHash - Distribution.Types.AnnotatedId - Distribution.Types.Benchmark - Distribution.Types.BenchmarkInterface - Distribution.Types.BenchmarkType - Distribution.Types.BuildInfo - Distribution.Types.BuildType - Distribution.Types.Component - Distribution.Types.ComponentId - Distribution.Types.ComponentInclude - Distribution.Types.ComponentLocalBuildInfo - Distribution.Types.ComponentName - Distribution.Types.ComponentRequestedSpec - Distribution.Types.Condition - Distribution.Types.CondTree - Distribution.Types.Dependency - Distribution.Types.DependencyMap - Distribution.Types.Executable - Distribution.Types.ExecutableScope - Distribution.Types.ExeDependency - Distribution.Types.ExposedModule - Distribution.Types.ForeignLib - Distribution.Types.ForeignLibOption - Distribution.Types.ForeignLibType - Distribution.Types.GenericPackageDescription - Distribution.Types.GivenComponent - Distribution.Types.HookedBuildInfo - Distribution.Types.IncludeRenaming - Distribution.Types.InstalledPackageInfo - Distribution.Types.InstalledPackageInfo.FieldGrammar - Distribution.Types.LegacyExeDependency - Distribution.Types.Library - Distribution.Types.LibraryName - Distribution.Types.LibraryVisibility - Distribution.Types.LocalBuildInfo - Distribution.Types.Mixin - Distribution.Types.Module - Distribution.Types.ModuleReexport - Distribution.Types.ModuleRenaming - Distribution.Types.MungedPackageId - Distribution.Types.MungedPackageName - Distribution.Types.PackageDescription - Distribution.Types.PackageId - Distribution.Types.PackageName - Distribution.Types.PackageVersionConstraint - Distribution.Types.PkgconfigDependency - Distribution.Types.PkgconfigName - Distribution.Types.SetupBuildInfo - Distribution.Types.SourceRepo - Distribution.Types.TargetInfo - Distribution.Types.TestSuite - Distribution.Types.TestSuiteInterface - Distribution.Types.TestType - Distribution.Types.UnitId - Distribution.Types.UnqualComponentName - Distribution.Types.Version - Distribution.Types.VersionInterval - Distribution.Types.VersionRange - Distribution.Utils.Generic - Distribution.Utils.IOData - Distribution.Utils.LogProgress - Distribution.Utils.MapAccum - Distribution.Utils.NubList - Distribution.Utils.Progress - Distribution.Utils.ShortText - Distribution.Verbosity - Distribution.Version - Language.Haskell.Extension - - -- Parsec parser-related modules - build-depends: - mtl >=2.1 && <2.3 - , parsec >=3.1.13.0 && <3.2 - , text >=1.2.3.0 && <1.3 - , transformers >=0.3 && <0.4 || >=0.4.1.0 && <0.6 - - -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity - -- See also https://github.com/ekmett/transformers-compat/issues/35 - exposed-modules: - Distribution.Compat.CharParsing - Distribution.Compat.Parsing - Distribution.FieldGrammar - Distribution.FieldGrammar.Class - Distribution.FieldGrammar.FieldDescrs - Distribution.FieldGrammar.Parsec - Distribution.FieldGrammar.Pretty - Distribution.Fields - Distribution.Fields.ConfVar - Distribution.Fields.Field - Distribution.Fields.Lexer - Distribution.Fields.LexerMonad - Distribution.Fields.Parser - Distribution.Fields.ParseResult - Distribution.Fields.Pretty - Distribution.PackageDescription.FieldGrammar - Distribution.PackageDescription.Parsec - Distribution.PackageDescription.Quirks - Distribution.Parsec - Distribution.Parsec.Error - Distribution.Parsec.FieldLineStream - Distribution.Parsec.Newtypes - Distribution.Parsec.Position - Distribution.Parsec.Warning - - -- Lens functionality - exposed-modules: - Distribution.Compat.Lens - Distribution.Types.Benchmark.Lens - Distribution.Types.BuildInfo.Lens - Distribution.Types.Executable.Lens - Distribution.Types.ForeignLib.Lens - Distribution.Types.GenericPackageDescription.Lens - Distribution.Types.InstalledPackageInfo.Lens - Distribution.Types.Lens - Distribution.Types.Library.Lens - Distribution.Types.PackageDescription.Lens - Distribution.Types.PackageId.Lens - Distribution.Types.SetupBuildInfo.Lens - Distribution.Types.SourceRepo.Lens - Distribution.Types.TestSuite.Lens - - other-modules: - Distribution.Backpack.Id - Distribution.Backpack.MixLink - Distribution.Backpack.ModuleScope - Distribution.Backpack.PreExistingComponent - Distribution.Backpack.ReadyComponent - Distribution.Backpack.UnifyM - Distribution.Compat.CopyFile - Distribution.Compat.GetShortPathName - Distribution.Compat.MonadFail - Distribution.Compat.Prelude - Distribution.Compat.SnocList - Distribution.GetOpt - Distribution.Lex - Distribution.Simple.GHC.EnvironmentParser - Distribution.Simple.GHC.ImplInfo - Distribution.Simple.GHC.Internal - Distribution.Utils.Base62 - Distribution.Utils.String - Distribution.Utils.UnionFind - Paths_Cabal - - if flag(bundled-binary-generic) - other-modules: - Distribution.Compat.Binary.Class - Distribution.Compat.Binary.Generic - - default-language: Haskell2010 - other-extensions: - BangPatterns - CPP - DefaultSignatures - DeriveDataTypeable - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveTraversable - ExistentialQuantification - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving - ImplicitParams - KindSignatures - NondecreasingIndentation - OverloadedStrings - RankNTypes - RecordWildCards - ScopedTypeVariables - StandaloneDeriving - Trustworthy - TypeFamilies - TypeOperators - TypeSynonymInstances - UndecidableInstances - - if impl(ghc >=7.11) - other-extensions: PatternSynonyms - --- Small, fast running tests. -test-suite unit-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - other-modules: - Test.Laws - Test.QuickCheck.Utils - UnitTests.Distribution.Compat.CreatePipe - UnitTests.Distribution.Compat.Graph - UnitTests.Distribution.Compat.Time - UnitTests.Distribution.Simple.Glob - UnitTests.Distribution.Simple.Program.Internal - UnitTests.Distribution.Simple.Utils - UnitTests.Distribution.SPDX - UnitTests.Distribution.System - UnitTests.Distribution.Types.GenericPackageDescription - UnitTests.Distribution.Utils.Generic - UnitTests.Distribution.Utils.NubList - UnitTests.Distribution.Utils.ShortText - UnitTests.Distribution.Version - - main-is: UnitTests.hs - build-depends: - array - , base - , bytestring - , Cabal - , containers - , directory - , filepath - , integer-logarithms >=1.0.2 && <1.1 - , pretty - , QuickCheck >=2.11.3 && <2.12 - , tagged - , tasty >=1.1.0.3 && <1.2 - , tasty-hunit - , tasty-quickcheck - , temporary - , text - - ghc-options: -Wall - default-language: Haskell2010 - -test-suite parser-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: ParserTests.hs - build-depends: - base - , base-compat >=0.10.4 && <0.11 - , bytestring - , Cabal - , Diff >=0.3.4 && <0.4 - , directory - , filepath - , tasty >=1.1.0.3 && <1.2 - , tasty-golden >=2.3.1.1 && <2.4 - , tasty-hunit - , tasty-quickcheck - - ghc-options: -Wall - default-language: Haskell2010 - - if impl(ghc >=7.8) - build-depends: tree-diff >=0.0.1 && <0.1 - other-modules: - Instances.TreeDiff - Instances.TreeDiff.Language - Instances.TreeDiff.SPDX - Instances.TreeDiff.Version - -test-suite check-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: CheckTests.hs - build-depends: - base - , bytestring - , Cabal - , Diff >=0.3.4 && <0.4 - , directory - , filepath - , tasty >=1.1.0.3 && <1.2 - , tasty-golden >=2.3.1.1 && <2.4 - - ghc-options: -Wall - default-language: Haskell2010 - -test-suite custom-setup-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests/custom-setup - main-is: CustomSetupTests.hs - other-modules: - CabalDoctestSetup - IdrisSetup - - build-depends: - base - , Cabal - , directory - , filepath - , process - - default-language: Haskell2010 - -test-suite hackage-tests - type: exitcode-stdio-1.0 - main-is: HackageTests.hs - - -- TODO: need to get 01-index.tar on appveyor - if os(windows) - buildable: False - - hs-source-dirs: tests - build-depends: - base - , bytestring - , Cabal - , containers - , deepseq - , directory - , filepath - - build-depends: - base-compat >=0.10.4 && <0.11 - , base-orphans >=0.6 && <0.9 - , optparse-applicative >=0.13.2.0 && <0.15 - , stm >=2.4.5.0 && <2.6 - , tar >=0.5.0.3 && <0.6 - - if impl(ghc >=7.8) - build-depends: tree-diff >=0.0.1 && <0.1 - other-modules: - Instances.TreeDiff - Instances.TreeDiff.Language - Instances.TreeDiff.SPDX - Instances.TreeDiff.Version - - ghc-options: -Wall -rtsopts -threaded - default-extensions: CPP - default-language: Haskell2010 diff --git a/fixtures/cabal-fmt.cabal b/fixtures/cabal-fmt.cabal deleted file mode 100644 --- a/fixtures/cabal-fmt.cabal +++ /dev/null @@ -1,16 +0,0 @@ -cabal-version: 2.4 -name: cabal-fmt -version: 0 - --- An example formatter -executable cabal-fmt - default-language: Haskell2010 - hs-source-dirs: src - main-is: CabalFmt.hs - -- build depends will be in - -- a nice tabular format - build-depends: base >=4.11 && <4.13, pretty >=1.1.3.6 && <1.2, bytestring, Cabal ^>=2.5, containers ^>=0.5.11.0 || ^>=0.6.0.1 - -- extensions will be sorted - other-extensions: - DeriveFunctor FlexibleContexts ExistentialQuantification OverloadedStrings - RankNTypes diff --git a/fixtures/cabal-fmt.format b/fixtures/cabal-fmt.format deleted file mode 100644 --- a/fixtures/cabal-fmt.format +++ /dev/null @@ -1,26 +0,0 @@ -cabal-version: 2.4 -name: cabal-fmt -version: 0 - --- An example formatter -executable cabal-fmt - default-language: Haskell2010 - hs-source-dirs: src - main-is: CabalFmt.hs - - -- build depends will be in - -- a nice tabular format - build-depends: - , base >=4.11 && <4.13 - , bytestring - , Cabal ^>=2.5 - , containers ^>=0.5.11.0 || ^>=0.6.0.1 - , pretty >=1.1.3.6 && <1.2 - - -- extensions will be sorted - other-extensions: - DeriveFunctor - ExistentialQuantification - FlexibleContexts - OverloadedStrings - RankNTypes diff --git a/fixtures/fragment-empty.cabal b/fixtures/fragment-empty.cabal deleted file mode 100644 --- a/fixtures/fragment-empty.cabal +++ /dev/null @@ -1,10 +0,0 @@ -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - -- cabal-gild: fragment empty.fragment - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-empty.format b/fixtures/fragment-empty.format deleted file mode 100644 --- a/fixtures/fragment-empty.format +++ /dev/null @@ -1,12 +0,0 @@ --- Fragment empty.fragment is empty. -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - - -- cabal-gild: fragment empty.fragment - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-missing.cabal b/fixtures/fragment-missing.cabal deleted file mode 100644 --- a/fixtures/fragment-missing.cabal +++ /dev/null @@ -1,10 +0,0 @@ -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - -- cabal-gild: fragment missing.fragment - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-missing.format b/fixtures/fragment-missing.format deleted file mode 100644 --- a/fixtures/fragment-missing.format +++ /dev/null @@ -1,12 +0,0 @@ --- Fragment missing.fragment failed to read: "doesn't exist" -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - - -- cabal-gild: fragment missing.fragment - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-multiple.cabal b/fixtures/fragment-multiple.cabal deleted file mode 100644 --- a/fixtures/fragment-multiple.cabal +++ /dev/null @@ -1,10 +0,0 @@ -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - -- cabal-gild: fragment multiple.fragment - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-multiple.format b/fixtures/fragment-multiple.format deleted file mode 100644 --- a/fixtures/fragment-multiple.format +++ /dev/null @@ -1,12 +0,0 @@ --- Fragment multiple.fragment contains multiple fields or sections, using only the first. -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - - -- cabal-gild: fragment multiple.fragment - build-depends: base - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-section.cabal b/fixtures/fragment-section.cabal deleted file mode 100644 --- a/fixtures/fragment-section.cabal +++ /dev/null @@ -1,12 +0,0 @@ -cabal-version: 2.4 -name: fragment -version: 1 - --- cabal-gild: fragment common.fragment -common deps - -library - import: deps - exposed-modules: Example - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-section.format b/fixtures/fragment-section.format deleted file mode 100644 --- a/fixtures/fragment-section.format +++ /dev/null @@ -1,18 +0,0 @@ -cabal-version: 2.4 -name: fragment -version: 1 - --- cabal-gild: fragment common.fragment -common deps - build-depends: - , base - , bytestring - , containers - - ghc-options: -Wall - -library - import: deps - exposed-modules: Example - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-wrong-field.cabal b/fixtures/fragment-wrong-field.cabal deleted file mode 100644 --- a/fixtures/fragment-wrong-field.cabal +++ /dev/null @@ -1,10 +0,0 @@ -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - -- cabal-gild: fragment tested-with.fragment - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-wrong-field.format b/fixtures/fragment-wrong-field.format deleted file mode 100644 --- a/fixtures/fragment-wrong-field.format +++ /dev/null @@ -1,12 +0,0 @@ --- Fragment tested-with.fragment contains field "tested-with", expecting field "build-depends". -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - - -- cabal-gild: fragment tested-with.fragment - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-wrong-type.cabal b/fixtures/fragment-wrong-type.cabal deleted file mode 100644 --- a/fixtures/fragment-wrong-type.cabal +++ /dev/null @@ -1,10 +0,0 @@ -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - -- cabal-gild: fragment common.fragment - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/fragment-wrong-type.format b/fixtures/fragment-wrong-type.format deleted file mode 100644 --- a/fixtures/fragment-wrong-type.format +++ /dev/null @@ -1,12 +0,0 @@ --- Fragment common.fragment contains a section "common deps", expecting field "build-depends". -cabal-version: 2.4 -name: fragment -version: 1 - -library - exposed-modules: Example - - -- cabal-gild: fragment common.fragment - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 diff --git a/fixtures/issue29.cabal b/fixtures/issue29.cabal deleted file mode 100644 --- a/fixtures/issue29.cabal +++ /dev/null @@ -1,22 +0,0 @@ -cabal-version: 3.0 -name: issue29 -version: 0 -description: - First Paragraph - - - - - - Second Paragraph - -library - default-language: Haskell2010 - hs-source-dirs: src - build-depends: - base >=4.3 && <4.18 - - exposed-modules: - Data.Bifunctor.Assoc - Data.Bifunctor.Swap - diff --git a/fixtures/issue29.format b/fixtures/issue29.format deleted file mode 100644 --- a/fixtures/issue29.format +++ /dev/null @@ -1,15 +0,0 @@ -cabal-version: 3.0 -name: issue29 -version: 0 -description: - First Paragraph - - Second Paragraph - -library - default-language: Haskell2010 - hs-source-dirs: src - build-depends: base >=4.3 && <4.18 - exposed-modules: - Data.Bifunctor.Assoc - Data.Bifunctor.Swap diff --git a/fixtures/issue69.cabal b/fixtures/issue69.cabal deleted file mode 100644 --- a/fixtures/issue69.cabal +++ /dev/null @@ -1,18 +0,0 @@ -cabal-version: 1.12 -name: issue69 -version: 0 - -library - default-language: Haskell2010 - hs-source-dirs: src - build-depends: - base >=4.3 && <4.18 - , bifunctors >=5.5.5 && <5.6 - , tagged >=0.8.6 && <0.9 - , inline-r >1.0.0.0 - - exposed-modules: - Data.Bifunctor.Assoc - Data.Bifunctor.Swap - - other-extensions: TypeFamilies diff --git a/fixtures/issue69.format b/fixtures/issue69.format deleted file mode 100644 --- a/fixtures/issue69.format +++ /dev/null @@ -1,18 +0,0 @@ -cabal-version: 1.12 -name: issue69 -version: 0 - -library - default-language: Haskell2010 - hs-source-dirs: src - build-depends: - base >=4.3 && <4.18 - , bifunctors >=5.5.5 && <5.6 - , inline-r >=1.0.0.0.0 - , tagged >=0.8.6 && <0.9 - - exposed-modules: - Data.Bifunctor.Assoc - Data.Bifunctor.Swap - - other-extensions: TypeFamilies diff --git a/fixtures/simple-example.cabal b/fixtures/simple-example.cabal deleted file mode 100644 --- a/fixtures/simple-example.cabal +++ /dev/null @@ -1,74 +0,0 @@ -name: simple-example -version: 1 -synopsis: Simple example of cabal-doctest demonstrating a library - with doctests -description: A package skeleton, to demostrate the use of cabal-doctest -homepage: https://github.com/phadej/cabal-doctest -license: BSD3 -license-file: LICENSE -author: Oleg Grenrus -maintainer: Oleg Grenrus -copyright: (c) 2017 Oleg Grenrus -category: Example -build-type: Custom -cabal-version: 1.12 - -tested-with: - GHC==7.0.4, - GHC==7.2.2, - GHC==7.4.2, - GHC==7.6.3, - GHC==7.8.4, - GHC==7.10.3, - GHC==8.0.2, - GHC==8.2.2, - GHC==8.4.4, - GHC==8.6.3 - -custom-setup - setup-depends: - base, Cabal, cabal-doctest >=1.0.6 && <1.1 - -library - exposed-modules: Example - default-extensions: ScopedTypeVariables RankNTypes - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 - - if impl(ghcjs) - cpp-options: -DFOOBAR - - if impl(ghc) - -- cabal-gild: glob-files cbits/**/*.c - c-sources: - - -- empty interval - if impl(hugs) - build-depends: unbuildable <0 - build-depends: unbuildable <0, unbuildable2 <0 - - -- full interval - build-depends: text <1 || >=1 - build-depends: containers <1 || >=1, pretty <1 || >=1 - - -- only upper bound - build-depends: foo <1 - build-depends: foo <2 - build-depends: abc <1, def <1, ghj <2 - - -- build-tool-depends are formatted like build-depends - build-tool-depends: happy:happy - - build-tool-depends: happy:happy >=1, alex:alex >=1 - -test-suite doctests - type: exitcode-stdio-1.0 - main-is: doctests.hs - - -- cabal-gild: fragment build-depends.fragment - build-depends: - - ghc-options: -Wall -threaded - hs-source-dirs: tests - default-language: Haskell2010 diff --git a/fixtures/simple-example.format b/fixtures/simple-example.format deleted file mode 100644 --- a/fixtures/simple-example.format +++ /dev/null @@ -1,96 +0,0 @@ -name: simple-example -version: 1 -synopsis: - Simple example of cabal-doctest demonstrating a library - with doctests - -description: A package skeleton, to demostrate the use of cabal-doctest -homepage: https://github.com/phadej/cabal-doctest -license: BSD3 -license-file: LICENSE -author: Oleg Grenrus -maintainer: Oleg Grenrus -copyright: (c) 2017 Oleg Grenrus -category: Example -build-type: Custom -cabal-version: 1.12 -tested-with: - GHC ==7.0.4 - || ==7.2.2 - || ==7.4.2 - || ==7.6.3 - || ==7.8.4 - || ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.3 - -custom-setup - setup-depends: - base - , Cabal - , cabal-doctest >=1.0.6 && <1.1 - -library - exposed-modules: Example - default-extensions: - RankNTypes - ScopedTypeVariables - - build-depends: base >=4.3 && <4.13 - hs-source-dirs: src - default-language: Haskell2010 - - if impl(ghcjs) - cpp-options: -DFOOBAR - - if impl(ghc) - -- cabal-gild: glob-files cbits/**/*.c - c-sources: - cbits/source1.c - cbits/source2.c - cbits/sub/source3.c - - -- empty interval - if impl(hugs) - build-depends: unbuildable <0 - build-depends: - unbuildable <0 - , unbuildable2 <0 - - -- full interval - build-depends: text - build-depends: - containers - , pretty - - -- only upper bound - build-depends: foo <1 - build-depends: foo <2 - build-depends: - abc <1 - , def <1 - , ghj <2 - - -- build-tool-depends are formatted like build-depends - build-tool-depends: happy:happy - build-tool-depends: - alex:alex >=1 - , happy:happy >=1 - -test-suite doctests - type: exitcode-stdio-1.0 - main-is: doctests.hs - - -- cabal-gild: fragment build-depends.fragment - build-depends: - base - , doctest >=0.15 && <0.17 - , QuickCheck >=2.12 && <2.13 - , simple-example - , template-haskell - - ghc-options: -Wall -threaded - hs-source-dirs: tests - default-language: Haskell2010 diff --git a/fixtures/tree-diff.cabal b/fixtures/tree-diff.cabal deleted file mode 100644 --- a/fixtures/tree-diff.cabal +++ /dev/null @@ -1,190 +0,0 @@ -cabal-version: 2.2 -name: tree-diff -version: 0.2.2 -synopsis: Diffing of (expression) trees. -category: Data, Testing -description: - Common diff algorithm works on list structures: - . - @ - diff :: Eq a => [a] -> [a] -> [Edit a] - @ - . - This package works on trees. - . - @ - treeDiff :: Eq a => Tree a -> Tree a -> Edit (EditTree a) - @ - . - This package also provides a way to diff arbitrary ADTs, - using @Generics@-derivable helpers. - . - This package differs from , - in a two ways: @tree-diff@ doesn't have patch function, - and the "edit-script" is a tree itself, which is useful for pretty-printing. - . - @ - >>> prettyEditExpr $ ediff (Foo 42 [True, False] "old") (Foo 42 [False, False, True] "new") - Foo - \ {fooBool = [-True, +False, False, +True], - \ fooInt = 42, - \ fooString = -"old" +"new"} - @ - -homepage: https://github.com/phadej/tree-diff -bug-reports: https://github.com/phadej/tree-diff/issues -license: GPL-2.0-or-later -license-file: LICENSE -author: Oleg Grenrus -maintainer: Oleg.Grenrus -copyright: (c) 2017-2021 Oleg Grenrus -build-type: Simple -extra-source-files: - ChangeLog.md - README.md - -tested-with: - GHC ==7.4.2 - || ==7.6.3 - || ==7.8.4 - || ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 - || ==8.8.4 - || ==8.10.4 - || ==9.0.2 - || ==9.2.4 - || ==9.4.1 - , GHCJS ==8.4 - -extra-source-files: - fixtures/exfoo.expr - fixtures/MyInt1.expr - fixtures/MyInt2.expr - fixtures/MyInt3.expr - fixtures/Positional.expr - -source-repository head - type: git - location: https://github.com/phadej/tree-diff.git - -library - exposed-modules: - Data.TreeDiff - Data.TreeDiff.Class - Data.TreeDiff.Expr - Data.TreeDiff.Golden - Data.TreeDiff.List - Data.TreeDiff.OMap - Data.TreeDiff.Parser - Data.TreeDiff.Pretty - Data.TreeDiff.QuickCheck - Data.TreeDiff.Tree - - -- GHC boot libraries - build-depends: - , base >=4.5 && <4.18 - , bytestring ^>=0.9.2.1 || ^>=0.10.0.2 || ^>=0.11.0.0 - , containers ^>=0.4.2.1 || ^>=0.5.0.0 || ^>=0.6.0.1 - , deepseq ^>=1.3.0.0 || ^>=1.4.0.0 - , parsec ^>=3.1.13.0 - , pretty ^>=1.1.1.0 - , text ^>=1.2.3.0 || ^>=2.0 - , time ^>=1.4 || ^>=1.5.0.1 || ^>=1.6.0.1 || ^>=1.8.0.2 || >=1.9.3 && <1.13 - - build-depends: - , aeson ^>=1.4.6.0 || ^>=1.5.6.0 || ^>=2.0.0.0 || ^>=2.1.0.0 - , ansi-terminal >=0.10 && <0.12 - , ansi-wl-pprint ^>=0.6.8.2 - , base-compat ^>=0.10.5 || ^>=0.11.0 || ^>=0.12.0 - , bytestring-builder ^>=0.10.8.2.0 - , hashable ^>=1.2.7.0 || ^>=1.3.0.0 || ^>=1.4.0.1 - , parsers ^>=0.12.10 - , primitive ^>=0.7.1.0 - , QuickCheck ^>=2.14.2 - , scientific ^>=0.3.6.2 - , semialign ^>=1.2.0.1 - , strict ^>=0.4.0.1 - , tagged ^>=0.8.6 - , these ^>=1.1.1.1 - , unordered-containers ^>=0.2.8.0 - , uuid-types ^>=1.0.3 - , vector ^>=0.12.0.0 || ^>=0.13.0.0 - - if impl(ghc <7.5) - build-depends: ghc-prim - - if !impl(ghc >=8.0) - build-depends: semigroups >=0.19.1 && <0.21 - - if !impl(ghc >=7.8) - build-depends: generic-deriving >=1.13.1 && <1.15 - - if !impl(ghc >=7.10) - build-depends: - , nats ^>=1.1.2 - , transformers ^>=0.3.0.0 || ^>=0.4.2.0 || ^>=0.5.2.0 - , void ^>=0.7.3 - - other-extensions: - CPP - ConstraintKinds - DefaultSignatures - FlexibleContexts - GADTs - RankNTypes - ScopedTypeVariables - TypeOperators - - hs-source-dirs: src - default-language: Haskell2010 - -test-suite tree-diff-test - default-language: Haskell2010 - type: exitcode-stdio-1.0 - main-is: Tests.hs - hs-source-dirs: tests src-diff - ghc-options: -Wall -threaded - other-modules: RefDiffBy - - -- dependencies from library - build-depends: - , ansi-terminal - , ansi-wl-pprint - , base - , base-compat - , parsec - , primitive - , QuickCheck - , tagged - , tree-diff - - if impl(ghc <7.5) - build-depends: ghc-prim - - -- extra dependencies - build-depends: - , tasty ^>=1.2 || ^>=1.3.1 || ^>=1.4.2 - , tasty-golden ^>=2.3.1.1 - , tasty-quickcheck ^>=0.10.1 - , trifecta >=2 && <2.2 - -benchmark tree-diff-bench - default-language: Haskell2010 - type: exitcode-stdio-1.0 - main-is: tree-diff-bench.hs - hs-source-dirs: bench - ghc-options: -Wall -threaded - - -- dependencies from library - build-depends: - , base - , deepseq - , tree-diff - - -- extra dependencies - build-depends: - , criterion ^>=1.6.0.0 - , Diff ^>=0.4.0 diff --git a/fixtures/tree-diff.format b/fixtures/tree-diff.format deleted file mode 100644 --- a/fixtures/tree-diff.format +++ /dev/null @@ -1,190 +0,0 @@ -cabal-version: 2.2 -name: tree-diff -version: 0.2.2 -synopsis: Diffing of (expression) trees. -category: Data, Testing -description: - Common diff algorithm works on list structures: - . - @ - diff :: Eq a => [a] -> [a] -> [Edit a] - @ - . - This package works on trees. - . - @ - treeDiff :: Eq a => Tree a -> Tree a -> Edit (EditTree a) - @ - . - This package also provides a way to diff arbitrary ADTs, - using @Generics@-derivable helpers. - . - This package differs from , - in a two ways: @tree-diff@ doesn't have patch function, - and the "edit-script" is a tree itself, which is useful for pretty-printing. - . - @ - >>> prettyEditExpr $ ediff (Foo 42 [True, False] "old") (Foo 42 [False, False, True] "new") - Foo - \ {fooBool = [-True, +False, False, +True], - \ fooInt = 42, - \ fooString = -"old" +"new"} - @ - -homepage: https://github.com/phadej/tree-diff -bug-reports: https://github.com/phadej/tree-diff/issues -license: GPL-2.0-or-later -license-file: LICENSE -author: Oleg Grenrus -maintainer: Oleg.Grenrus -copyright: (c) 2017-2021 Oleg Grenrus -build-type: Simple -extra-source-files: - ChangeLog.md - README.md - -tested-with: - GHC ==7.4.2 - || ==7.6.3 - || ==7.8.4 - || ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 - || ==8.8.4 - || ==8.10.4 - || ==9.0.2 - || ==9.2.4 - || ==9.4.1 - , GHCJS ==8.4 - -extra-source-files: - fixtures/exfoo.expr - fixtures/MyInt1.expr - fixtures/MyInt2.expr - fixtures/MyInt3.expr - fixtures/Positional.expr - -source-repository head - type: git - location: https://github.com/phadej/tree-diff.git - -library - exposed-modules: - Data.TreeDiff - Data.TreeDiff.Class - Data.TreeDiff.Expr - Data.TreeDiff.Golden - Data.TreeDiff.List - Data.TreeDiff.OMap - Data.TreeDiff.Parser - Data.TreeDiff.Pretty - Data.TreeDiff.QuickCheck - Data.TreeDiff.Tree - - -- GHC boot libraries - build-depends: - , base >=4.5 && <4.18 - , bytestring ^>=0.9.2.1 || ^>=0.10.0.2 || ^>=0.11.0.0 - , containers ^>=0.4.2.1 || ^>=0.5.0.0 || ^>=0.6.0.1 - , deepseq ^>=1.3.0.0 || ^>=1.4.0.0 - , parsec ^>=3.1.13.0 - , pretty ^>=1.1.1.0 - , text ^>=1.2.3.0 || ^>=2.0 - , time ^>=1.4 || ^>=1.5.0.1 || ^>=1.6.0.1 || ^>=1.8.0.2 || ^>=1.9.3 || ^>=1.10 || ^>=1.11 || ^>=1.12 - - build-depends: - , aeson ^>=1.4.6.0 || ^>=1.5.6.0 || ^>=2.0.0.0 || ^>=2.1.0.0 - , ansi-terminal >=0.10 && <0.12 - , ansi-wl-pprint ^>=0.6.8.2 - , base-compat ^>=0.10.5 || ^>=0.11.0 || ^>=0.12.0 - , bytestring-builder ^>=0.10.8.2.0 - , hashable ^>=1.2.7.0 || ^>=1.3.0.0 || ^>=1.4.0.1 - , parsers ^>=0.12.10 - , primitive ^>=0.7.1.0 - , QuickCheck ^>=2.14.2 - , scientific ^>=0.3.6.2 - , semialign ^>=1.2.0.1 - , strict ^>=0.4.0.1 - , tagged ^>=0.8.6 - , these ^>=1.1.1.1 - , unordered-containers ^>=0.2.8.0 - , uuid-types ^>=1.0.3 - , vector ^>=0.12.0.0 || ^>=0.13.0.0 - - if impl(ghc <7.5) - build-depends: ghc-prim - - if !impl(ghc >=8.0) - build-depends: semigroups >=0.19.1 && <0.21 - - if !impl(ghc >=7.8) - build-depends: generic-deriving >=1.13.1 && <1.15 - - if !impl(ghc >=7.10) - build-depends: - , nats ^>=1.1.2 - , transformers ^>=0.3.0.0 || ^>=0.4.2.0 || ^>=0.5.2.0 - , void ^>=0.7.3 - - other-extensions: - CPP - ConstraintKinds - DefaultSignatures - FlexibleContexts - GADTs - RankNTypes - ScopedTypeVariables - TypeOperators - - hs-source-dirs: src - default-language: Haskell2010 - -test-suite tree-diff-test - default-language: Haskell2010 - type: exitcode-stdio-1.0 - main-is: Tests.hs - hs-source-dirs: tests src-diff - ghc-options: -Wall -threaded - other-modules: RefDiffBy - - -- dependencies from library - build-depends: - , ansi-terminal - , ansi-wl-pprint - , base - , base-compat - , parsec - , primitive - , QuickCheck - , tagged - , tree-diff - - if impl(ghc <7.5) - build-depends: ghc-prim - - -- extra dependencies - build-depends: - , tasty ^>=1.2 || ^>=1.3.1 || ^>=1.4.2 - , tasty-golden ^>=2.3.1.1 - , tasty-quickcheck ^>=0.10.1 - , trifecta >=2 && <2.2 - -benchmark tree-diff-bench - default-language: Haskell2010 - type: exitcode-stdio-1.0 - main-is: tree-diff-bench.hs - hs-source-dirs: bench - ghc-options: -Wall -threaded - - -- dependencies from library - build-depends: - , base - , deepseq - , tree-diff - - -- extra dependencies - build-depends: - , criterion ^>=1.6.0.0 - , Diff ^>=0.4.0 diff --git a/fixtures/with-sublibs.cabal b/fixtures/with-sublibs.cabal deleted file mode 100644 --- a/fixtures/with-sublibs.cabal +++ /dev/null @@ -1,36 +0,0 @@ -cabal-version: 3.0 -name: with-sublibs -version: 1 - -library - hs-source-dirs: src - default-language: Haskell2010 - build-depends: - test1, - test1:sub, - test2 >=1 && <3, - test2:sub >=2 && <3 - - build-depends: - test1 - - build-depends: - test2 >=1 - - build-depends: - test2:sub - - build-depends: - test2:{sub} - - build-depends: - test2:{sub1, sub2} - - build-depends: - test2:sub >=1 && <3 - - build-depends: - test2:{sub} >=2 && <3 - - build-depends: - test2:{sub1, sub2} >=3 && <4 diff --git a/fixtures/with-sublibs.format b/fixtures/with-sublibs.format deleted file mode 100644 --- a/fixtures/with-sublibs.format +++ /dev/null @@ -1,20 +0,0 @@ -Up to date -cabal-version: 3.0 -name: with-sublibs -version: 1 - -library - hs-source-dirs: src - default-language: Haskell2010 - build-depends: - , test1:{test1, sub} - , test2:{test2, sub} >=2 && <3 - - build-depends: test1 - build-depends: test2 >=1 - build-depends: test2:sub - build-depends: test2:sub - build-depends: test2:{sub1, sub2} - build-depends: test2:sub >=1 && <3 - build-depends: test2:sub >=2 && <3 - build-depends: test2:{sub1, sub2} >=3 && <4 diff --git a/source/executable/Main.hs b/source/executable/Main.hs --- a/source/executable/Main.hs +++ b/source/executable/Main.hs @@ -1,6 +1,4 @@ --- | --- License: BSD-3-Clause --- Copyright: Oleg Grenrus -module Main (CabalGild.Main.main) where - import qualified CabalGild.Main + +main :: IO () +main = CabalGild.Main.defaultMain diff --git a/source/library/CabalGild.hs b/source/library/CabalGild.hs deleted file mode 100644 --- a/source/library/CabalGild.hs +++ /dev/null @@ -1,210 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus --- --- This is a demo application of how you can make Cabal-like --- file formatter. -module CabalGild (cabalGild) where - -import CabalGild.Comments -import CabalGild.Fields -import CabalGild.Fields.BuildDepends -import CabalGild.Fields.Extensions -import CabalGild.Fields.Modules -import CabalGild.Fields.SourceFiles -import CabalGild.Fields.TestedWith -import CabalGild.FreeText -import CabalGild.Monad -import CabalGild.Options -import CabalGild.Parser -import CabalGild.Pragma -import CabalGild.Refactoring -import Control.Monad (join) -import qualified Control.Monad.Except as Except -import Control.Monad.Reader (asks, local) -import qualified Data.ByteString as BS -import qualified Data.Either as Either -import qualified Data.Foldable as Foldable -import Data.Function ((&)) -import Data.Functor (($>)) -import qualified Data.Maybe as Maybe -import qualified Distribution.CabalSpecVersion as C -import qualified Distribution.Compat.Lens as Lens -import qualified Distribution.FieldGrammar.Parsec as C -import qualified Distribution.Fields as C -import qualified Distribution.Fields.ConfVar as C -import qualified Distribution.Fields.Pretty as C -import qualified Distribution.PackageDescription.FieldGrammar as C -import qualified Distribution.Parsec as C -import qualified Distribution.Pretty as C -import qualified Distribution.Types.Condition as C -import qualified Distribution.Types.ConfVar as C -import qualified Distribution.Types.GenericPackageDescription as C -import qualified Distribution.Types.PackageDescription as C -import qualified Distribution.Types.VersionRange as C -import qualified Distribution.Utils.Generic as C -import qualified Text.PrettyPrint as PP - -------------------------------------------------------------------------------- --- Main -------------------------------------------------------------------------------- - -cabalGild :: (MonadCabalGild r m) => FilePath -> BS.ByteString -> m String -cabalGild filepath contents = do - -- determine cabal-version - cabalFile <- asks (optCabalFile . Lens.view options) - csv <- - if cabalFile - then do - gpd <- parseGpd filepath contents - return $ - C.specVersion $ - C.packageDescription gpd - else return C.cabalSpecLatest - - inputFields' <- parseFields contents - let (inputFieldsC, endComments) = attachComments contents inputFields' - - -- parse pragmas - let parse :: (MonadCabalGild r f) => (a, Comments) -> f (a, Comments, [Pragma]) - parse (pos, c) = case parsePragmas c of (ws, ps) -> Foldable.traverse_ displayWarning ws $> (pos, c, ps) - inputFieldsP' <- traverse (traverse parse) inputFieldsC - endCommentsPragmas <- case parsePragmas endComments of - (ws, ps) -> Foldable.traverse_ displayWarning ws $> ps - - -- apply refactorings - let inputFieldsP :: [C.Field CommentsPragmas] - inputFieldsP = map (fmap (fmap (snd . partitionPragmas))) inputFieldsP' - - inputFieldsR <- refactor inputFieldsP - - -- options morphisms - let pragmas :: [GlobalPragma] - pragmas = - fst $ - partitionPragmas $ - foldMap (foldMap $ \(_, _, z) -> z) inputFieldsP' <> endCommentsPragmas - - optsEndo :: OptionsMorphism - optsEndo = foldMap pragmaToOM pragmas - - local (Lens.over options $ \o -> runOptionsMorphism optsEndo $ o {optSpecVersion = csv}) $ do - indentWith <- asks (optIndent . Lens.view options) - let inputFields = inputFieldsR - - outputPrettyFields <- - genericFromParsecFields - (\n (x, _, _) -> prettyFieldLines n x) - prettySectionArgs - inputFields - - return $ - C.showFields' (fromComments . (\(_, y, _) -> y)) (const id) indentWith outputPrettyFields - & if nullComments endComments - then id - else (++ unlines ("" : [C.fromUTF8BS c | c <- unComments endComments])) - -fromComments :: Comments -> C.CommentPosition -fromComments (Comments []) = C.NoComment -fromComments (Comments bss) = C.CommentBefore (map C.fromUTF8BS bss) - -genericFromParsecFields :: - (Applicative f) => - -- | transform field contents - (C.FieldName -> ann -> [C.FieldLine ann] -> f PP.Doc) -> - -- | transform section arguments - (C.FieldName -> [C.SectionArg ann] -> f [PP.Doc]) -> - [C.Field ann] -> - f [C.PrettyField ann] -genericFromParsecFields f g = goMany - where - goMany = traverse go - - go (C.Field (C.Name ann name) fls) = C.PrettyField ann name <$> f name ann fls - go (C.Section (C.Name ann name) secargs fs) = C.PrettySection ann name <$> g name secargs <*> goMany fs - -------------------------------------------------------------------------------- --- Field prettyfying -------------------------------------------------------------------------------- - -prettyFieldLines :: (MonadCabalGild r m) => C.FieldName -> C.Position -> [C.FieldLine CommentsPragmas] -> m PP.Doc -prettyFieldLines fn pos fls = - Maybe.fromMaybe (C.prettyFieldLines fn fls) <$> knownField fn pos fls - -knownField :: (MonadCabalGild r m) => C.FieldName -> C.Position -> [C.FieldLine CommentsPragmas] -> m (Maybe PP.Doc) -knownField fn pos fls = do - opts <- asks (Lens.view options) - let v = optSpecVersion opts - let ft = fieldlinesToFreeText v pos (fmap (fmap $ \(x, _, _) -> x) fls) - let ft' = showFreeText v ft - - return $ join $ fieldDescrLookup (fieldDescrs opts) fn (Just ft') $ \p pp -> - case C.runParsecParser' v p "" (C.fieldLinesToStream fls) of - Right x -> Just (pp x) - Left _ -> Nothing - -fieldDescrs :: Options -> FieldDescrs () () -fieldDescrs opts = - buildDependsF opts - <> buildToolDependsF opts - <> setupDependsF opts - <> defaultExtensionsF - <> otherExtensionsF - <> exposedModulesF - <> otherModulesF - <> testedWithF opts - <> mconcat sourceFilesF - <> coerceFieldDescrs C.packageDescriptionFieldGrammar - <> coerceFieldDescrs C.buildInfoFieldGrammar - -------------------------------------------------------------------------------- --- Sections -------------------------------------------------------------------------------- - -prettySectionArgs :: (MonadCabalGild r m) => C.FieldName -> [C.SectionArg ann] -> m [PP.Doc] -prettySectionArgs x args = - prettySectionArgs' x args `Except.catchError` \_ -> - return (C.prettySectionArgs x args) - -prettySectionArgs' :: (MonadCabalGild r m) => a -> [C.SectionArg ann] -> m [PP.Doc] -prettySectionArgs' _ args = do - c <- runParseResult "" "" $ C.parseConditionConfVar (map (C.zeroPos <$) args) - return [ppCondition c] - -------------------------------------------------------------------------------- --- PrettyPrint condition -------------------------------------------------------------------------------- - --- This is originally from Cabal - -ppCondition :: C.Condition C.ConfVar -> PP.Doc -ppCondition (C.Var x) = ppConfVar x -ppCondition (C.Lit b) = PP.text (show b) -ppCondition (C.CNot c) = PP.char '!' PP.<> ppCondition c -ppCondition (C.COr c1 c2) = PP.parens (PP.hsep [ppCondition c1, PP.text "||", ppCondition c2]) -ppCondition (C.CAnd c1 c2) = PP.parens (PP.hsep [ppCondition c1, PP.text "&&", ppCondition c2]) - -ppConfVar :: C.ConfVar -> PP.Doc -ppConfVar (C.OS os) = PP.text "os" PP.<> PP.parens (C.pretty os) -ppConfVar (C.Arch arch) = PP.text "arch" PP.<> PP.parens (C.pretty arch) -ppConfVar (C.PackageFlag name) = PP.text "flag" PP.<> PP.parens (C.pretty name) -ppConfVar (C.Impl c v) - | v == C.anyVersion = PP.text "impl" PP.<> PP.parens (C.pretty c) - | otherwise = PP.text "impl" PP.<> PP.parens (C.pretty c PP.<+> C.pretty v) - -------------------------------------------------------------------------------- --- Pragma to OM -------------------------------------------------------------------------------- - -partitionPragmas :: [Pragma] -> ([GlobalPragma], [FieldPragma]) -partitionPragmas = Either.partitionEithers . map p - where - p (GlobalPragma x) = Left x - p (FieldPragma x) = Right x - -pragmaToOM :: GlobalPragma -> OptionsMorphism -pragmaToOM (PragmaOptIndent n) = mkOptionsMorphism $ \opts -> opts {optIndent = n} -pragmaToOM (PragmaOptTabular b) = mkOptionsMorphism $ \opts -> opts {optTabular = b} diff --git a/source/library/CabalGild/Action/AttachComments.hs b/source/library/CabalGild/Action/AttachComments.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Action/AttachComments.hs @@ -0,0 +1,78 @@ +module CabalGild.Action.AttachComments where + +import qualified CabalGild.Type.Comment as Comment +import qualified Control.Monad.Trans.State as StateT +import qualified Distribution.Fields as Fields + +run :: + (Applicative m, Ord p) => + ([Fields.Field p], [Comment.Comment p]) -> + m ([Fields.Field (p, [Comment.Comment p])], [Comment.Comment p]) +run (fs, cs) = pure $ StateT.runState (fields fs) cs + +fields :: + (Ord p) => + [Fields.Field p] -> + StateT.State [Comment.Comment p] [Fields.Field (p, [Comment.Comment p])] +fields = traverse field + +field :: + (Ord p) => + Fields.Field p -> + StateT.State [Comment.Comment p] (Fields.Field (p, [Comment.Comment p])) +field f = case f of + Fields.Field n fls -> + Fields.Field + <$> name n + <*> traverse fieldLine fls + Fields.Section n sas fs -> + Fields.Section + <$> name n + <*> traverse sectionArg sas + <*> traverse field fs + +name :: + (Ord p) => + Fields.Name p -> + StateT.State [Comment.Comment p] (Fields.Name (p, [Comment.Comment p])) +name (Fields.Name p fn) = + Fields.Name + <$> toPosition p + <*> pure fn + +fieldLine :: + (Ord p) => + Fields.FieldLine p -> + StateT.State [Comment.Comment p] (Fields.FieldLine (p, [Comment.Comment p])) +fieldLine (Fields.FieldLine p bs) = + Fields.FieldLine + <$> toPosition p + <*> pure bs + +sectionArg :: + (Ord p) => + Fields.SectionArg p -> + StateT.State [Comment.Comment p] (Fields.SectionArg (p, [Comment.Comment p])) +sectionArg sa = case sa of + Fields.SecArgName p bs -> + Fields.SecArgName + <$> toPosition p + <*> pure bs + Fields.SecArgStr p bs -> + Fields.SecArgStr + <$> toPosition p + <*> pure bs + Fields.SecArgOther p bs -> + Fields.SecArgOther + <$> toPosition p + <*> pure bs + +toPosition :: + (Ord p) => + p -> + StateT.State [Comment.Comment p] (p, [Comment.Comment p]) +toPosition p = do + cs <- StateT.get + let (xs, ys) = span ((<= p) . Comment.annotation) cs + StateT.put ys + pure (p, xs) diff --git a/source/library/CabalGild/Action/Discover.hs b/source/library/CabalGild/Action/Discover.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Action/Discover.hs @@ -0,0 +1,65 @@ +module CabalGild.Action.Discover where + +import qualified CabalGild.Class.MonadWalk as MonadWalk +import qualified CabalGild.Extra.ModuleName as ModuleName +import qualified CabalGild.Extra.Name as Name +import qualified CabalGild.Extra.String as String +import qualified CabalGild.Type.Comment as Comment +import qualified CabalGild.Type.Pragma as Pragma +import qualified Control.Monad as Monad +import qualified Control.Monad.Catch as Exception +import qualified Control.Monad.Trans.Class as Trans +import qualified Control.Monad.Trans.Maybe as MaybeT +import qualified Data.Maybe as Maybe +import qualified Data.Set as Set +import qualified Distribution.Fields as Fields +import qualified Distribution.Parsec as Parsec +import qualified Distribution.Utils.Generic as Utils +import qualified System.FilePath as FilePath + +run :: + (Exception.MonadThrow m, MonadWalk.MonadWalk m) => + FilePath -> + ([Fields.Field [Comment.Comment a]], cs) -> + m ([Fields.Field [Comment.Comment a]], cs) +run p (fs, cs) = (,) <$> fields p fs <*> pure cs + +fields :: + (Exception.MonadThrow m, MonadWalk.MonadWalk m) => + FilePath -> + [Fields.Field [Comment.Comment a]] -> + m [Fields.Field [Comment.Comment a]] +fields = mapM . field + +field :: + (Exception.MonadThrow m, MonadWalk.MonadWalk m) => + FilePath -> + Fields.Field [Comment.Comment a] -> + m (Fields.Field [Comment.Comment a]) +field p f = case f of + Fields.Field n _ -> fmap (Maybe.fromMaybe f) . MaybeT.runMaybeT $ do + Monad.guard $ Set.member (Name.value n) relevantFieldNames + c <- hoistMaybe . Utils.safeLast $ Name.annotation n + Pragma.Discover x <- hoistMaybe . Parsec.simpleParsecBS $ Comment.value c + let d = FilePath.combine (FilePath.takeDirectory p) x + fs <- Trans.lift $ MonadWalk.walk d + pure + . Fields.Field n + . fmap (ModuleName.toFieldLine []) + . Maybe.mapMaybe (ModuleName.fromFilePath . FilePath.makeRelative d) + $ Maybe.mapMaybe (FilePath.stripExtension "hs") fs + Fields.Section n sas fs -> Fields.Section n sas <$> fields p fs + +relevantFieldNames :: Set.Set Fields.FieldName +relevantFieldNames = + Set.fromList $ + fmap + String.toUtf8 + [ "exposed-modules", + "other-modules" + ] + +-- This was added in transformers-0.6.0.0. See +-- . +hoistMaybe :: (Applicative f) => Maybe a -> MaybeT.MaybeT f a +hoistMaybe = MaybeT.MaybeT . pure diff --git a/source/library/CabalGild/Action/ExtractComments.hs b/source/library/CabalGild/Action/ExtractComments.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Action/ExtractComments.hs @@ -0,0 +1,40 @@ +module CabalGild.Action.ExtractComments where + +import qualified CabalGild.Type.Comment as Comment +import qualified Control.Applicative as Applicative +import qualified Control.Monad as Monad +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Char8 as Latin1 +import qualified Data.ByteString.Internal as ByteStringInternal +import qualified Data.Maybe as Maybe +import qualified Data.Word as Word +import qualified Distribution.Parsec.Position as Position + +fromByteString :: ByteString.ByteString -> [Comment.Comment Position.Position] +fromByteString = + Maybe.mapMaybe (uncurry fromLine) + . zip [1 ..] + . Latin1.lines + +fromLine :: + (Applicative.Alternative m, Monad m) => + Int -> + ByteString.ByteString -> + m (Comment.Comment Position.Position) +fromLine row line = do + let (before, after) = breakComment line + rest <- + maybe Applicative.empty pure $ + ByteString.stripPrefix Comment.delimiter after + Monad.guard $ ByteString.all isBlank before + pure + Comment.Comment + { Comment.annotation = Position.Position row $ 1 + ByteString.length before, + Comment.value = ByteString.dropWhileEnd isBlank rest + } + +breakComment :: ByteString.ByteString -> (ByteString.ByteString, ByteString.ByteString) +breakComment = ByteString.breakSubstring Comment.delimiter + +isBlank :: Word.Word8 -> Bool +isBlank = ByteStringInternal.isSpaceWord8 diff --git a/source/library/CabalGild/Action/Format.hs b/source/library/CabalGild/Action/Format.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Action/Format.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE TypeApplications #-} + +module CabalGild.Action.Format where + +import CabalGild.Compat.Cabal () +import qualified CabalGild.Extra.FieldLine as FieldLine +import qualified CabalGild.Extra.Name as Name +import qualified CabalGild.Extra.String as String +import qualified CabalGild.Type.SomeParsecParser as SPP +import qualified Data.Functor.Identity as Identity +import qualified Data.Map as Map +import qualified Distribution.CabalSpecVersion as CabalSpecVersion +import qualified Distribution.FieldGrammar.Newtypes as Newtypes +import qualified Distribution.Fields as Fields +import qualified Distribution.ModuleName as ModuleName +import qualified Distribution.Parsec as Parsec +import qualified Distribution.Pretty as Pretty +import qualified Distribution.Types.Dependency as Dependency +import qualified Distribution.Types.ExeDependency as ExeDependency +import qualified Distribution.Types.ForeignLibOption as ForeignLibOption +import qualified Distribution.Types.LegacyExeDependency as LegacyExeDependency +import qualified Distribution.Types.Mixin as Mixin +import qualified Distribution.Types.ModuleReexport as ModuleReexport +import qualified Distribution.Types.PkgconfigDependency as PkgconfigDependency +import qualified Language.Haskell.Extension as Extension +import qualified Text.PrettyPrint as PrettyPrint + +run :: + (Applicative m, Monoid cs) => + CabalSpecVersion.CabalSpecVersion -> + ([Fields.Field cs], cs) -> + m ([Fields.Field cs], cs) +run csv (fs, cs) = pure (fields csv fs, cs) + +fields :: + (Monoid cs) => + CabalSpecVersion.CabalSpecVersion -> + [Fields.Field cs] -> + [Fields.Field cs] +fields = fmap . field + +field :: + (Monoid cs) => + CabalSpecVersion.CabalSpecVersion -> + Fields.Field cs -> + Fields.Field cs +field csv f = case f of + Fields.Field n fls -> case Map.lookup (Name.value n) parsers of + Nothing -> f + Just spp -> Fields.Field n $ fieldLines csv fls spp + Fields.Section n sas fs -> Fields.Section n sas $ fields csv fs + +fieldLines :: + (Monoid cs) => + CabalSpecVersion.CabalSpecVersion -> + [Fields.FieldLine cs] -> + SPP.SomeParsecParser -> + [Fields.FieldLine cs] +fieldLines csv fls (SPP.SomeParsecParser pp) = + case Parsec.runParsecParser' csv pp "" $ FieldLine.toFieldLineStream fls of + Left _ -> + -- Parsing failed, so simply return the field lines as is. + fls + Right r -> + fmap (\(c, l) -> Fields.FieldLine c $ String.toUtf8 l) + . zip (foldMap FieldLine.annotation fls : repeat mempty) + . lines + . PrettyPrint.renderStyle style + $ Pretty.prettyVersioned csv r + +style :: PrettyPrint.Style +style = + -- Everything should be on its own line. + PrettyPrint.Style + { PrettyPrint.mode = PrettyPrint.PageMode, + PrettyPrint.lineLength = 0, + PrettyPrint.ribbonsPerLine = 1 + } + +parsers :: Map.Map Fields.FieldName SPP.SomeParsecParser +parsers = + -- Perhaps these should use paths as keys rather than field names. That's + -- because some fields are only supposed to occur within certain sections. + -- For example, `exposed-modules` occurs in (at least) `library`. Fortunately + -- field names are unique enough for this not to be a problem. + let (=:) :: String -> SPP.SomeParsecParser -> (Fields.FieldName, SPP.SomeParsecParser) + (=:) = (,) . String.toUtf8 + in Map.fromList + [ "asm-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "asm-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT, + "autogen-includes" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT, + "autogen-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName), + "build-depends" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity Dependency.Dependency), + "build-tool-depends" =: SPP.set @Newtypes.CommaFSep @(Identity.Identity ExeDependency.ExeDependency), + "build-tools" =: SPP.set @Newtypes.CommaFSep @(Identity.Identity LegacyExeDependency.LegacyExeDependency), + "c-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT, + "cc-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "cmm-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "cmm-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT, + "code-generators" =: SPP.list @Newtypes.CommaFSep @Newtypes.Token, + "cpp-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "cxx-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "cxx-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT, + "data-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT, + "default-extensions" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension), + "exposed-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName), + "extensions" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension), + "extra-bundled-libraries" =: SPP.set @Newtypes.VCat @Newtypes.Token, + "extra-doc-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT, + "extra-dynamic-library-flavours" =: SPP.set @Newtypes.VCat @Newtypes.Token, + "extra-framework-dirs" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT, + "extra-ghci-libraries" =: SPP.set @Newtypes.VCat @Newtypes.Token, + "extra-lib-dirs-static" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT, + "extra-lib-dirs" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT, + "extra-libraries-static" =: SPP.set @Newtypes.VCat @Newtypes.Token, + "extra-libraries" =: SPP.set @Newtypes.VCat @Newtypes.Token, + "extra-library-flavours" =: SPP.set @Newtypes.VCat @Newtypes.Token, + "extra-source-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT, + "extra-tmp-files" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT, + "frameworks" =: SPP.set @Newtypes.FSep @Newtypes.Token, + "ghc-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "ghc-prof-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "ghc-shared-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "ghcjs-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "ghcjs-prof-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "ghcjs-shared-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "hs-source-dirs" =: SPP.list @Newtypes.FSep @Newtypes.FilePathNT, + "hsc2hs-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "include-dirs" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT, + "includes" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT, + "install-includes" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT, + "js-sources" =: SPP.set @Newtypes.VCat @Newtypes.FilePathNT, + "ld-options" =: SPP.list @Newtypes.NoCommaFSep @Newtypes.Token', + "license-files" =: SPP.set @Newtypes.FSep @Newtypes.FilePathNT, + "mixins" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity Mixin.Mixin), + "options" =: SPP.set @Newtypes.FSep @(Identity.Identity ForeignLibOption.ForeignLibOption), + "other-extensions" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Extension), + "other-languages" =: SPP.set @Newtypes.FSep @(Newtypes.MQuoted Extension.Language), + "other-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName), + "pkgconfig-depends" =: SPP.set @Newtypes.CommaFSep @(Identity.Identity PkgconfigDependency.PkgconfigDependency), + "reexported-modules" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity ModuleReexport.ModuleReexport), + "setup-depends" =: SPP.set @Newtypes.CommaVCat @(Identity.Identity Dependency.Dependency), + "signatures" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName), + "tested-with" =: SPP.set @Newtypes.FSep @Newtypes.TestedWith, + "virtual-modules" =: SPP.set @Newtypes.VCat @(Newtypes.MQuoted ModuleName.ModuleName) + ] diff --git a/source/library/CabalGild/Action/GetCabalVersion.hs b/source/library/CabalGild/Action/GetCabalVersion.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Action/GetCabalVersion.hs @@ -0,0 +1,34 @@ +module CabalGild.Action.GetCabalVersion where + +import qualified CabalGild.Extra.Either as Either +import qualified CabalGild.Extra.FieldLine as FieldLine +import qualified CabalGild.Extra.Name as Name +import qualified CabalGild.Extra.String as String +import qualified Data.List as List +import qualified Data.Maybe as Maybe +import qualified Distribution.CabalSpecVersion as CabalSpecVersion +import qualified Distribution.FieldGrammar.Newtypes as Newtypes +import qualified Distribution.Fields as Fields +import qualified Distribution.Parsec as Parsec + +fromFields :: [Fields.Field a] -> CabalSpecVersion.CabalSpecVersion +fromFields fs = Maybe.fromMaybe CabalSpecVersion.CabalSpecV1_0 $ do + f <- List.find isCabalVersion fs + fls <- getFieldLines f + Newtypes.getSpecVersion <$> fromFieldLines fls + +isCabalVersion :: Fields.Field a -> Bool +isCabalVersion f = case f of + Fields.Field n _ -> Name.value n == String.toUtf8 "cabal-version" + Fields.Section {} -> False + +getFieldLines :: Fields.Field a -> Maybe [Fields.FieldLine a] +getFieldLines f = case f of + Fields.Field _ fls -> Just fls + Fields.Section {} -> Nothing + +fromFieldLines :: [Fields.FieldLine a] -> Maybe Newtypes.SpecVersion +fromFieldLines = + Either.hush + . Parsec.runParsecParser Parsec.parsec "" + . FieldLine.toFieldLineStream diff --git a/source/library/CabalGild/Action/Reindent.hs b/source/library/CabalGild/Action/Reindent.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Action/Reindent.hs @@ -0,0 +1,108 @@ +module CabalGild.Action.Reindent where + +import qualified CabalGild.Extra.Field as Field +import qualified CabalGild.Extra.FieldLine as FieldLine +import qualified CabalGild.Extra.List as List +import qualified CabalGild.Extra.Name as Name +import qualified CabalGild.Extra.String as String +import qualified CabalGild.Type.Comment as Comment +import qualified Data.ByteString as ByteString +import qualified Data.Set as Set +import qualified Distribution.CabalSpecVersion as CabalSpecVersion +import qualified Distribution.Fields as Fields +import qualified Distribution.Parsec.Position as Position + +run :: + (Applicative m) => + CabalSpecVersion.CabalSpecVersion -> + ([Fields.Field (Position.Position, [Comment.Comment Position.Position])], cs) -> + m ([Fields.Field (Position.Position, [Comment.Comment Position.Position])], cs) +run csv (fs, cs) = pure (fields csv fs, cs) + +fields :: + CabalSpecVersion.CabalSpecVersion -> + [Fields.Field (Position.Position, [Comment.Comment Position.Position])] -> + [Fields.Field (Position.Position, [Comment.Comment Position.Position])] +fields csv fs = + -- Note that we want to do this after comments have been attached because we + -- want comments to come as late as possible. In other words, we don't want a + -- comment attached to a blank line. + if csv >= CabalSpecVersion.CabalSpecV3_0 + then fmap field fs + else fs + +field :: + Fields.Field (Position.Position, [Comment.Comment Position.Position]) -> + Fields.Field (Position.Position, [Comment.Comment Position.Position]) +field f = case f of + Fields.Field n fls -> + if Set.member (Name.value n) relevantFieldNames && List.compareLength fls 1 == GT + then Fields.Field n $ fieldLines f fls + else f + Fields.Section n sas fs -> Fields.Section n sas $ fmap field fs + +relevantFieldNames :: Set.Set Fields.FieldName +relevantFieldNames = + Set.fromList $ + fmap + String.toUtf8 + [ "description" + ] + +fieldLines :: + Fields.Field (Position.Position, [Comment.Comment Position.Position]) -> + [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] -> + [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] +fieldLines f = fixRows . fixCols f + +fixRows :: + [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] -> + [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] +fixRows fls = case fls of + x : y : zs -> + x + : fmap rowToFieldLine [fieldLineToLastRow x + 1 .. fieldLineToFirstRow y - 1] + <> fixRows (y : zs) + _ -> fls + +fixCols :: + Fields.Field (Position.Position, [Comment.Comment Position.Position]) -> + [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] -> + [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] +fixCols f fls = case fls of + [] -> fls + x : xs -> + let col = foldr (min . fieldLineToCol) (fieldLineToCol x) xs + in if fieldToRow f == fieldLineToFirstRow x + then x : fmap (reindent col) xs + else fmap (reindent col) fls + +fieldLineToCol :: Fields.FieldLine (Position.Position, cs) -> Int +fieldLineToCol = Position.positionCol . fst . FieldLine.annotation + +fieldLineToFirstRow :: + Fields.FieldLine (Position.Position, [Comment.Comment Position.Position]) -> + Int +fieldLineToFirstRow = + -- A field line's first row might belong to one of its comments. + Position.positionRow + . uncurry (foldr (min . Comment.annotation)) + . FieldLine.annotation + +fieldLineToLastRow :: Fields.FieldLine (Position.Position, cs) -> Int +fieldLineToLastRow = Position.positionRow . fst . FieldLine.annotation + +fieldToRow :: Fields.Field (Position.Position, cs) -> Int +fieldToRow = Position.positionRow . fst . Name.annotation . Field.name + +reindent :: + Int -> + Fields.FieldLine (Position.Position, cs) -> + Fields.FieldLine (Position.Position, cs) +reindent col (Fields.FieldLine (p, cs) b) = + Fields.FieldLine (p, cs) $ ByteString.replicate (Position.positionCol p - col) 0x20 <> b + +rowToFieldLine :: + Int -> + Fields.FieldLine (Position.Position, [c]) +rowToFieldLine r = Fields.FieldLine (Position.Position r 1, []) ByteString.empty diff --git a/source/library/CabalGild/Action/RemovePositions.hs b/source/library/CabalGild/Action/RemovePositions.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Action/RemovePositions.hs @@ -0,0 +1,60 @@ +module CabalGild.Action.RemovePositions where + +import qualified CabalGild.Type.Comment as Comment +import qualified Distribution.Fields as Fields + +run :: + (Applicative m) => + ([Fields.Field (p, [Comment.Comment p])], [Comment.Comment p]) -> + m ([Fields.Field [Comment.Comment ()]], [Comment.Comment ()]) +run (fs, cs) = pure (fields fs, comments cs) + +fields :: + [Fields.Field (p, [Comment.Comment p])] -> + [Fields.Field [Comment.Comment ()]] +fields = fmap field + +field :: + Fields.Field (p, [Comment.Comment p]) -> + Fields.Field [Comment.Comment ()] +field f = case f of + Fields.Field n fls -> Fields.Field (name n) $ fieldLines fls + Fields.Section n sas fs -> Fields.Section (name n) (sectionArgs sas) $ fields fs + +name :: + Fields.Name (p, [Comment.Comment p]) -> + Fields.Name [Comment.Comment ()] +name (Fields.Name (_, cs) x) = Fields.Name (comments cs) x + +fieldLines :: + [Fields.FieldLine (p, [Comment.Comment p])] -> + [Fields.FieldLine [Comment.Comment ()]] +fieldLines = fmap fieldLine + +fieldLine :: + Fields.FieldLine (p, [Comment.Comment p]) -> + Fields.FieldLine [Comment.Comment ()] +fieldLine (Fields.FieldLine (_, cs) x) = Fields.FieldLine (comments cs) x + +sectionArgs :: + [Fields.SectionArg (p, [Comment.Comment p])] -> + [Fields.SectionArg [Comment.Comment ()]] +sectionArgs = fmap sectionArg + +sectionArg :: + Fields.SectionArg (p, [Comment.Comment p]) -> + Fields.SectionArg [Comment.Comment ()] +sectionArg sa = case sa of + Fields.SecArgName (_, cs) x -> Fields.SecArgName (comments cs) x + Fields.SecArgStr (_, cs) x -> Fields.SecArgStr (comments cs) x + Fields.SecArgOther (_, cs) x -> Fields.SecArgOther (comments cs) x + +comments :: + [Comment.Comment p] -> + [Comment.Comment ()] +comments = fmap comment + +comment :: + Comment.Comment p -> + Comment.Comment () +comment c = c {Comment.annotation = ()} diff --git a/source/library/CabalGild/Action/Render.hs b/source/library/CabalGild/Action/Render.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Action/Render.hs @@ -0,0 +1,119 @@ +module CabalGild.Action.Render where + +import qualified CabalGild.Extra.FieldLine as FieldLine +import qualified CabalGild.Extra.Name as Name +import qualified CabalGild.Extra.SectionArg as SectionArg +import qualified CabalGild.Type.Block as Block +import qualified CabalGild.Type.Chunk as Chunk +import qualified CabalGild.Type.Comment as Comment +import qualified CabalGild.Type.Line as Line +import qualified Data.ByteString as ByteString +import qualified Distribution.Compat.Lens as Lens +import qualified Distribution.Fields as Fields + +run :: + (Applicative m) => + ([Fields.Field [Comment.Comment a]], [Comment.Comment a]) -> + m ByteString.ByteString +run = pure . uncurry toByteString + +toByteString :: + [Fields.Field [Comment.Comment a]] -> + [Comment.Comment a] -> + ByteString.ByteString +toByteString fs cs = + let i = 0 :: Int + in Block.toByteString + . Lens.set Block.lineBeforeLens False + . Lens.set Block.lineAfterLens True + $ fields i fs <> comments i cs + +fields :: Int -> [Fields.Field [Comment.Comment a]] -> Block.Block +fields = foldMap . field + +field :: Int -> Fields.Field [Comment.Comment a] -> Block.Block +field i f = case f of + Fields.Field n fls -> case fls of + [fl] + | null $ FieldLine.annotation fl -> + -- If the field only has one line and no comments, then it can be + -- rendered all on one line. + comments i (Name.annotation n) + <> ( Block.fromLine + . Lens.over Line.chunkLens (mappend $ name n <> Chunk.colon) + $ fieldLine i fl + ) + _ -> + Lens.set Block.lineAfterLens True $ + comments i (Name.annotation n) + <> Block.fromLine + Line.Line + { Line.indent = i, + Line.chunk = name n <> Chunk.colon + } + <> fieldLines (i + 1) fls + Fields.Section n sas fs -> + Lens.set Block.lineBeforeLens True + . Lens.set Block.lineAfterLens True + $ comments i (Name.annotation n) + -- Section arguments should never have comments in practice. This is + -- here simply to ensure that they aren't lost. + <> comments i (concatMap SectionArg.annotation sas) + <> Block.fromLine + Line.Line + { Line.indent = i, + Line.chunk = Lens.set Chunk.spaceAfterLens True (name n) <> sectionArgs sas + } + <> Lens.set Block.lineBeforeLens False (fields (i + 1) fs) + +name :: Fields.Name a -> Chunk.Chunk +name = Chunk.fromByteString . Name.value + +fieldLines :: Int -> [Fields.FieldLine [Comment.Comment a]] -> Block.Block +fieldLines = foldMap . fieldLineC + +fieldLineC :: Int -> Fields.FieldLine [Comment.Comment a] -> Block.Block +fieldLineC i fl = + comments i (FieldLine.annotation fl) + <> Block.fromLine (fieldLine i fl) + +fieldLine :: Int -> Fields.FieldLine a -> Line.Line +fieldLine i = + Line.Line i + . Lens.set Chunk.spaceBeforeLens True + . Chunk.fromByteString + . FieldLine.value + +sectionArgs :: [Fields.SectionArg a] -> Chunk.Chunk +sectionArgs = Lens.set Chunk.spaceBeforeLens True . foldMap sectionArg + +sectionArg :: Fields.SectionArg a -> Chunk.Chunk +sectionArg sa = case sa of + Fields.SecArgName _ bs -> + Lens.set Chunk.spaceBeforeLens True + . Lens.set Chunk.spaceAfterLens True + $ Chunk.fromByteString bs + Fields.SecArgStr _ bs -> + Lens.set Chunk.spaceBeforeLens True + . Lens.set Chunk.spaceAfterLens True + . Chunk.fromByteString + . flip ByteString.snoc 0x22 + $ ByteString.cons 0x22 bs + Fields.SecArgOther _ bs -> + let b = + bs /= ByteString.singleton 0x21 -- ! + && bs /= ByteString.singleton 0x28 -- ( + && bs /= ByteString.singleton 0x29 -- ) + in Lens.set Chunk.spaceBeforeLens b + . Lens.set Chunk.spaceAfterLens b + $ Chunk.fromByteString bs + +comments :: Int -> [Comment.Comment a] -> Block.Block +comments i cs = mempty {Block.lines = fmap (comment i) cs} + +comment :: Int -> Comment.Comment a -> Line.Line +comment i = + Line.Line i + . Chunk.fromByteString + . mappend Comment.delimiter + . Comment.value diff --git a/source/library/CabalGild/Class/MonadLog.hs b/source/library/CabalGild/Class/MonadLog.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Class/MonadLog.hs @@ -0,0 +1,10 @@ +module CabalGild.Class.MonadLog where + +class (Monad m) => MonadLog m where + log :: String -> m () + +instance MonadLog IO where + log = putStr + +logLn :: (MonadLog m) => String -> m () +logLn = CabalGild.Class.MonadLog.log . (<> "\n") diff --git a/source/library/CabalGild/Class/MonadRead.hs b/source/library/CabalGild/Class/MonadRead.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Class/MonadRead.hs @@ -0,0 +1,9 @@ +module CabalGild.Class.MonadRead where + +import qualified Data.ByteString as ByteString + +class (Monad m) => MonadRead m where + read :: Maybe FilePath -> m ByteString.ByteString + +instance MonadRead IO where + read = maybe ByteString.getContents ByteString.readFile diff --git a/source/library/CabalGild/Class/MonadWalk.hs b/source/library/CabalGild/Class/MonadWalk.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Class/MonadWalk.hs @@ -0,0 +1,21 @@ +module CabalGild.Class.MonadWalk where + +import qualified System.Directory as Directory +import qualified System.FilePath as FilePath + +class (Monad m) => MonadWalk m where + walk :: FilePath -> m [FilePath] + +instance MonadWalk IO where + walk = listDirectoryRecursively + +listDirectoryRecursively :: FilePath -> IO [FilePath] +listDirectoryRecursively d = do + es <- Directory.listDirectory d + let f e = do + let p = FilePath.combine d e + b <- Directory.doesDirectoryExist p + if b + then listDirectoryRecursively p + else pure [p] + concat <$> mapM f es diff --git a/source/library/CabalGild/Class/MonadWrite.hs b/source/library/CabalGild/Class/MonadWrite.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Class/MonadWrite.hs @@ -0,0 +1,9 @@ +module CabalGild.Class.MonadWrite where + +import qualified Data.ByteString as ByteString + +class (Monad m) => MonadWrite m where + write :: Maybe FilePath -> ByteString.ByteString -> m () + +instance MonadWrite IO where + write = maybe ByteString.putStr ByteString.writeFile diff --git a/source/library/CabalGild/Comments.hs b/source/library/CabalGild/Comments.hs deleted file mode 100644 --- a/source/library/CabalGild/Comments.hs +++ /dev/null @@ -1,160 +0,0 @@ -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Comments where - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS8 -import qualified Data.Map.Strict as Map -import qualified Data.Maybe as Maybe -import qualified Distribution.Fields as C -import qualified Distribution.Fields.Field as C -import qualified Distribution.Parsec as C - -------------------------------------------------------------------------------- --- Comments wrapper -------------------------------------------------------------------------------- - -newtype Comments = Comments [BS.ByteString] - deriving stock (Show) - deriving newtype (Semigroup, Monoid) - -unComments :: Comments -> [BS.ByteString] -unComments (Comments cs) = cs - -nullComments :: Comments -> Bool -nullComments (Comments cs) = null cs - -------------------------------------------------------------------------------- --- Attach comments -------------------------------------------------------------------------------- - --- | Returns a 'C.Field' forest with comments attached. --- --- * Comments are attached to the field after it. --- * A glitch: comments "inside" the field are attached to the field after it. --- * End-of-file comments are returned separately. -attachComments :: - -- | source with comments - BS.ByteString -> - -- | parsed source fields - [C.Field C.Position] -> - ([C.Field (C.Position, Comments)], Comments) -attachComments input inputFields = - (overAnn attach attach' inputFields, endComments) - where - inputFieldsU :: [(FieldPath, C.Field C.Position)] - inputFieldsU = fieldUniverseN inputFields - - comments :: [(Int, Comments)] - comments = extractComments input - - comments' :: Map.Map FieldPath Comments - comments' = - Map.fromListWith - (flip (<>)) - [ (path, cs) - | (l, cs) <- comments, - path <- Maybe.maybeToList (findPath C.fieldAnn l inputFieldsU) - ] - - endComments :: Comments - endComments = - mconcat - [ cs - | (l, cs) <- comments, - Maybe.isNothing (findPath C.fieldAnn l inputFieldsU) - ] - - attach :: FieldPath -> C.Position -> (C.Position, Comments) - attach fp pos = (pos, Maybe.fromMaybe mempty (Map.lookup fp comments')) - - attach' :: C.Position -> (C.Position, Comments) - attach' pos = (pos, mempty) - -overAnn :: forall a b. (FieldPath -> a -> b) -> (a -> b) -> [C.Field a] -> [C.Field b] -overAnn f h = go' id - where - go :: (FieldPath -> FieldPath) -> Int -> C.Field a -> C.Field b - go g i (C.Field (C.Name a name) fls) = - C.Field (C.Name b name) (h <$$> fls) - where - b = f (g (Nth i End)) a - go g i (C.Section (C.Name a name) args fls) = - C.Section (C.Name b name) (h <$$> args) (go' (g . Nth i) fls) - where - b = f (g (Nth i End)) a - - go' :: (FieldPath -> FieldPath) -> [C.Field a] -> [C.Field b] - go' g = zipWith (go g) [0 ..] - - (<$$>) :: (Functor f1, Functor f2) => (x -> y) -> f1 (f2 x) -> f1 (f2 y) - x <$$> y = (x <$>) <$> y - -------------------------------------------------------------------------------- --- Find comments in the input -------------------------------------------------------------------------------- - -extractComments :: BS.ByteString -> [(Int, Comments)] -extractComments = go . zip [1 ..] . map (BS.dropWhileEnd isCR . BS.dropWhile isSpace8) . BS8.lines - where - go :: [(Int, BS.ByteString)] -> [(Int, Comments)] - go [] = [] - go ((n, bs) : rest) - | isComment bs = case span ((isComment .|| BS.null) . snd) rest of - (h, t) -> (n, Comments $ bs : map snd h) : go t - | otherwise = go rest - - (.||) :: (t -> Bool) -> (t -> Bool) -> t -> Bool - (f .|| g) x = f x || g x - - isSpace8 :: (Eq a, Num a) => a -> Bool - isSpace8 w = w == 9 || w == 32 - - isCR :: (Eq a, Num a) => a -> Bool - isCR = (==) 13 - - isComment :: BS.ByteString -> Bool - isComment = BS.isPrefixOf "--" - -------------------------------------------------------------------------------- --- FieldPath -------------------------------------------------------------------------------- - --- | Paths input paths. Essentially a list of offsets. Own type ofr safety. -data FieldPath - = End - | Nth Int FieldPath -- nth field - deriving (Eq, Ord, Show) - -fieldUniverseN :: [C.Field ann] -> [(FieldPath, C.Field ann)] -fieldUniverseN = concat . zipWith g [0 ..] - where - g :: Int -> C.Field ann -> [(FieldPath, C.Field ann)] - g n f' = [(Nth n p, f'') | (p, f'') <- fieldUniverse f'] - -fieldUniverse :: C.Field ann -> [(FieldPath, C.Field ann)] -fieldUniverse f@(C.Section _ _ fs) = (End, f) : concat (zipWith g [0 ..] fs) - where - g :: Int -> C.Field ann -> [(FieldPath, C.Field ann)] - g n f' = [(Nth n p, f'') | (p, f'') <- fieldUniverse f'] -fieldUniverse f@(C.Field _ _) = [(End, f)] - --- note: fieldUniverse* should produce 'FieldPath's in increasing order --- that helps -findPath :: (a -> C.Position) -> Int -> [(FieldPath, a)] -> Maybe FieldPath -findPath _ _ [] = Nothing -findPath f l [(p, x)] - | C.Position k _ <- f x = - if l < k then Just p else Nothing -findPath f l ((_, x) : rest@((p, x') : _)) - | C.Position k _ <- f x, - C.Position k' _ <- f x' = - if k < l && l < k' - then Just p - else findPath f l rest diff --git a/source/library/CabalGild/Compat/Cabal.hs b/source/library/CabalGild/Compat/Cabal.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Compat/Cabal.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module CabalGild.Compat.Cabal where + +#if !MIN_VERSION_Cabal_syntax(3, 10, 1) +import qualified Distribution.Types.Dependency as Dependency +import qualified Distribution.Types.VersionRange.Internal as VersionRange +import qualified Distribution.Types.ExeDependency as ExeDependency +import qualified Distribution.Types.LegacyExeDependency as LegacyExeDependency +import qualified Distribution.Types.ForeignLibOption as ForeignLibOption +import qualified Distribution.Types.PkgconfigDependency as PkgconfigDependency +import qualified Distribution.Types.PkgconfigVersionRange as PkgconfigVersionRange +import qualified Distribution.Types.ModuleReexport as ModuleReexport +import qualified Language.Haskell.Extension as Extension + +deriving instance Ord Dependency.Dependency +deriving instance Ord ForeignLibOption.ForeignLibOption +deriving instance Ord ExeDependency.ExeDependency +deriving instance Ord Extension.Language +deriving instance Ord LegacyExeDependency.LegacyExeDependency +deriving instance Ord ModuleReexport.ModuleReexport +deriving instance Ord PkgconfigDependency.PkgconfigDependency +deriving instance Ord PkgconfigVersionRange.PkgconfigVersionRange +deriving instance Ord VersionRange.VersionRange +#endif diff --git a/source/library/CabalGild/Error.hs b/source/library/CabalGild/Error.hs deleted file mode 100644 --- a/source/library/CabalGild/Error.hs +++ /dev/null @@ -1,128 +0,0 @@ --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Error (Error (..), renderError) where - -import Control.Exception (Exception) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS8 -import Data.List.NonEmpty (NonEmpty) -import qualified Distribution.Parsec as C -import qualified Distribution.Types.Version as C -import qualified Distribution.Utils.Generic as C (fromUTF8BS) -import System.FilePath (normalise) -import System.IO (hPutStr, hPutStrLn, stderr) -import Text.Parsec.Error (ParseError) - -data Error - = SomeError String - | CabalParseError FilePath BS.ByteString (NonEmpty C.PError) (Maybe C.Version) [C.PWarning] - | PanicCannotParseInput ParseError - | WarningError String - deriving (Show) - -instance Exception Error - -renderError :: Error -> IO () -renderError (SomeError err) = hPutStrLn stderr $ "error: " ++ err -renderError (PanicCannotParseInput err) = hPutStrLn stderr $ "panic! " ++ show err -renderError (CabalParseError filepath contents errors _ warnings) = - hPutStr stderr $ renderParseError filepath contents errors warnings -renderError (WarningError w) = hPutStrLn stderr $ "error (-Werror): " ++ w - -------------------------------------------------------------------------------- --- Rendering of Cabal parser error -------------------------------------------------------------------------------- - --- | Render parse error highlighting the part of the input file. -renderParseError :: - FilePath -> - BS.ByteString -> - NonEmpty C.PError -> - [C.PWarning] -> - String -renderParseError filepath contents errors warnings = - unlines $ - [ "Errors encountered when parsing cabal file " <> filepath <> ":" - ] - ++ renderedErrors - ++ renderedWarnings - where - filepath' = normalise filepath - - -- lines of the input file. 'lines' is taken, so they are called rows - -- contents, line number, whether it's empty line - rows :: [(String, Int, Bool)] - rows = zipWith f (BS8.lines contents) [1 ..] - where - f :: BS8.ByteString -> b -> (String, b, Bool) - f bs i = let s = C.fromUTF8BS bs in (s, i, isEmptyOrComment s) - - rowsZipper = listToZipper rows - - isEmptyOrComment :: String -> Bool - isEmptyOrComment s = case dropWhile (== ' ') s of - "" -> True -- empty - ('-' : '-' : _) -> True -- comment - _ -> False - - renderedErrors = concatMap renderError' errors - renderedWarnings = concatMap renderWarning warnings - - renderError' :: C.PError -> [String] - renderError' (C.PError pos@(C.Position row col) msg) - -- if position is 0:0, then it doesn't make sense to show input - -- looks like, Parsec errors have line-feed in them - | pos == C.zeroPos = msgs - | otherwise = msgs ++ formatInput row col - where - msgs = ["", filepath' ++ ":" ++ C.showPos pos ++ ": error:", trimLF msg, ""] - - renderWarning :: C.PWarning -> [String] - renderWarning (C.PWarning _ pos@(C.Position row col) msg) - | pos == C.zeroPos = msgs - | otherwise = msgs ++ formatInput row col - where - msgs = ["", filepath' ++ ":" ++ C.showPos pos ++ ": warning:", trimLF msg, ""] - - -- sometimes there are (especially trailing) newlines. - trimLF :: String -> String - trimLF = dropWhile (== '\n') . reverse . dropWhile (== '\n') . reverse - - -- format line: prepend the given line number - formatInput :: Int -> Int -> [String] - formatInput row col = case advance (row - 1) rowsZipper of - Zipper xs ys -> before ++ after - where - before = case span (\(_, _, b) -> b) xs of - (_, []) -> [] - (zs, z : _) -> map formatInputLine $ z : reverse zs - - after = case ys of - [] -> [] - (z : _zs) -> - [ formatInputLine z, -- error line - " | " ++ replicate (col - 1) ' ' ++ "^" -- pointer: ^ - ] - -- do we need rows after? - -- ++ map formatInputLine (take 1 zs) -- one row after - - formatInputLine :: (String, Int, Bool) -> String - formatInputLine (str, row, _) = leftPadShow row ++ " | " ++ str - - -- hopefully we don't need to work with over 99999 lines .cabal files - -- at that point small glitches in error messages are hopefully fine. - leftPadShow :: Int -> String - leftPadShow n = let s = show n in replicate (5 - length s) ' ' ++ s - -data Zipper a = Zipper [a] [a] - -listToZipper :: [a] -> Zipper a -listToZipper = Zipper [] - -advance :: Int -> Zipper a -> Zipper a -advance n z@(Zipper xs ys) - | n <= 0 = z - | otherwise = case ys of - [] -> z - (y : ys') -> advance (n - 1) $ Zipper (y : xs) ys' diff --git a/source/library/CabalGild/Exception/CheckFailure.hs b/source/library/CabalGild/Exception/CheckFailure.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Exception/CheckFailure.hs @@ -0,0 +1,10 @@ +module CabalGild.Exception.CheckFailure where + +import qualified Control.Monad.Catch as Exception + +data CheckFailure + = CheckFailure + deriving (Eq, Show) + +instance Exception.Exception CheckFailure where + displayException = const "input is not formatted" diff --git a/source/library/CabalGild/Exception/InvalidMode.hs b/source/library/CabalGild/Exception/InvalidMode.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Exception/InvalidMode.hs @@ -0,0 +1,13 @@ +module CabalGild.Exception.InvalidMode where + +import qualified Control.Monad.Catch as Exception + +newtype InvalidMode + = InvalidMode String + deriving (Eq, Show) + +instance Exception.Exception InvalidMode where + displayException (InvalidMode s) = "invalid mode: " <> s + +fromString :: String -> InvalidMode +fromString = InvalidMode diff --git a/source/library/CabalGild/Exception/InvalidOption.hs b/source/library/CabalGild/Exception/InvalidOption.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Exception/InvalidOption.hs @@ -0,0 +1,15 @@ +module CabalGild.Exception.InvalidOption where + +import qualified Control.Monad.Catch as Exception +import qualified Data.Char as Char +import qualified Data.List as List + +newtype InvalidOption + = InvalidOption String + deriving (Eq, Show) + +instance Exception.Exception InvalidOption where + displayException (InvalidOption s) = "invalid option: " <> s + +fromString :: String -> InvalidOption +fromString = InvalidOption . List.dropWhileEnd Char.isSpace diff --git a/source/library/CabalGild/Exception/ParseError.hs b/source/library/CabalGild/Exception/ParseError.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Exception/ParseError.hs @@ -0,0 +1,15 @@ +module CabalGild.Exception.ParseError where + +import qualified Control.Monad.Catch as Exception +import qualified Text.Parsec.Error as Parsec + +-- This type only exists to add an `Exception` instance to the `ParseError` +-- type. That instance was added in parsec-3.17.0.0. See: +-- . +newtype ParseError = ParseError + { unwrap :: Parsec.ParseError + } + deriving (Eq, Show) + +instance Exception.Exception ParseError where + displayException = mappend "parse error: " . show . unwrap diff --git a/source/library/CabalGild/Exception/UnexpectedArgument.hs b/source/library/CabalGild/Exception/UnexpectedArgument.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Exception/UnexpectedArgument.hs @@ -0,0 +1,13 @@ +module CabalGild.Exception.UnexpectedArgument where + +import qualified Control.Monad.Catch as Exception + +newtype UnexpectedArgument + = UnexpectedArgument String + deriving (Eq, Show) + +instance Exception.Exception UnexpectedArgument where + displayException (UnexpectedArgument s) = "unexpected argument: " <> s + +fromString :: String -> UnexpectedArgument +fromString = UnexpectedArgument diff --git a/source/library/CabalGild/Exception/UnknownOption.hs b/source/library/CabalGild/Exception/UnknownOption.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Exception/UnknownOption.hs @@ -0,0 +1,13 @@ +module CabalGild.Exception.UnknownOption where + +import qualified Control.Monad.Catch as Exception + +newtype UnknownOption + = UnknownOption String + deriving (Eq, Show) + +instance Exception.Exception UnknownOption where + displayException (UnknownOption s) = "unknown option: " <> s + +fromString :: String -> UnknownOption +fromString = UnknownOption diff --git a/source/library/CabalGild/Extra/Either.hs b/source/library/CabalGild/Extra/Either.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Extra/Either.hs @@ -0,0 +1,4 @@ +module CabalGild.Extra.Either where + +hush :: Either x a -> Maybe a +hush = either (const Nothing) Just diff --git a/source/library/CabalGild/Extra/Field.hs b/source/library/CabalGild/Extra/Field.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Extra/Field.hs @@ -0,0 +1,8 @@ +module CabalGild.Extra.Field where + +import qualified Distribution.Fields as Fields + +name :: Fields.Field a -> Fields.Name a +name f = case f of + Fields.Field n _ -> n + Fields.Section n _ _ -> n diff --git a/source/library/CabalGild/Extra/FieldLine.hs b/source/library/CabalGild/Extra/FieldLine.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Extra/FieldLine.hs @@ -0,0 +1,17 @@ +module CabalGild.Extra.FieldLine where + +import qualified Data.ByteString as ByteString +import qualified Distribution.Fields as Fields +import qualified Distribution.Parsec.FieldLineStream as FieldLineStream + +annotation :: Fields.FieldLine a -> a +annotation (Fields.FieldLine x _) = x + +value :: Fields.FieldLine a -> ByteString.ByteString +value (Fields.FieldLine _ x) = x + +toFieldLineStream :: [Fields.FieldLine a] -> FieldLineStream.FieldLineStream +toFieldLineStream fls = case fls of + [] -> FieldLineStream.FLSLast ByteString.empty + [x] -> FieldLineStream.FLSLast $ value x + x : xs -> FieldLineStream.FLSCons (value x) $ toFieldLineStream xs diff --git a/source/library/CabalGild/Extra/List.hs b/source/library/CabalGild/Extra/List.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Extra/List.hs @@ -0,0 +1,9 @@ +module CabalGild.Extra.List where + +compareLength :: [a] -> Int -> Ordering +compareLength xs n = + if n < 0 + then GT + else case xs of + [] -> compare 0 n + _ : ys -> compareLength ys $ n - 1 diff --git a/source/library/CabalGild/Extra/ModuleName.hs b/source/library/CabalGild/Extra/ModuleName.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Extra/ModuleName.hs @@ -0,0 +1,15 @@ +module CabalGild.Extra.ModuleName where + +import qualified CabalGild.Extra.String as String +import qualified Data.List as List +import qualified Distribution.Fields as Fields +import qualified Distribution.ModuleName as ModuleName +import qualified Distribution.Parsec as Parsec +import qualified Distribution.Pretty as Pretty +import qualified System.FilePath as FilePath + +fromFilePath :: FilePath -> Maybe ModuleName.ModuleName +fromFilePath = Parsec.simpleParsec . List.intercalate "." . FilePath.splitDirectories + +toFieldLine :: a -> ModuleName.ModuleName -> Fields.FieldLine a +toFieldLine a = Fields.FieldLine a . String.toUtf8 . Pretty.prettyShow diff --git a/source/library/CabalGild/Extra/Name.hs b/source/library/CabalGild/Extra/Name.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Extra/Name.hs @@ -0,0 +1,9 @@ +module CabalGild.Extra.Name where + +import qualified Distribution.Fields as Fields + +annotation :: Fields.Name a -> a +annotation (Fields.Name x _) = x + +value :: Fields.Name a -> Fields.FieldName +value (Fields.Name _ x) = x diff --git a/source/library/CabalGild/Extra/SectionArg.hs b/source/library/CabalGild/Extra/SectionArg.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Extra/SectionArg.hs @@ -0,0 +1,9 @@ +module CabalGild.Extra.SectionArg where + +import qualified Distribution.Fields as Fields + +annotation :: Fields.SectionArg a -> a +annotation sa = case sa of + Fields.SecArgName x _ -> x + Fields.SecArgStr x _ -> x + Fields.SecArgOther x _ -> x diff --git a/source/library/CabalGild/Extra/String.hs b/source/library/CabalGild/Extra/String.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Extra/String.hs @@ -0,0 +1,8 @@ +module CabalGild.Extra.String where + +import qualified Data.ByteString as ByteString +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Encoding + +toUtf8 :: String -> ByteString.ByteString +toUtf8 = Encoding.encodeUtf8 . Text.pack diff --git a/source/library/CabalGild/Fields.hs b/source/library/CabalGild/Fields.hs deleted file mode 100644 --- a/source/library/CabalGild/Fields.hs +++ /dev/null @@ -1,117 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE UndecidableInstances #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Fields - ( FieldDescrs, - fieldDescrLookup, - coerceFieldDescrs, - singletonF, - ) -where - -import qualified Data.Map.Strict as Map -import qualified Distribution.Compat.Newtype as Newtype -import qualified Distribution.FieldGrammar as C -import qualified Distribution.Fields.Field as C -import qualified Distribution.Parsec as C -import qualified Distribution.Pretty as C -import qualified Text.PrettyPrint as PP - -------------------------------------------------------------------------------- --- FieldDescr variant -------------------------------------------------------------------------------- - --- strict pair -data SP where - FreeText :: SP - SP :: - !(f -> PP.Doc) -> - !(forall m. (C.CabalParsing m) => m f) -> - SP - --- | Lookup both pretty-printer and value parser. --- --- As the value of the field is unknown, we have to work with it universally. -fieldDescrLookup :: - (C.CabalParsing m) => - FieldDescrs s a -> - C.FieldName -> - r -> -- field is freetext - (forall f. m f -> (f -> PP.Doc) -> r) -> - Maybe r -fieldDescrLookup (F m) fn ft kont = kont' <$> Map.lookup fn m - where - kont' (SP a b) = kont b a - kont' FreeText = ft - --- | A collection field parsers and pretty-printers. -newtype FieldDescrs s a = F {runF :: Map.Map C.FieldName SP} - deriving (Functor) - -coerceFieldDescrs :: FieldDescrs s a -> FieldDescrs () () -coerceFieldDescrs (F a) = F a - -instance Semigroup (FieldDescrs s a) where - F a <> F b = F (a <> b) - -instance Monoid (FieldDescrs s a) where - mempty = F Map.empty - mappend = (<>) - -instance Applicative (FieldDescrs s) where - pure _ = F mempty - f <*> x = F (mappend (runF f) (runF x)) - -singletonF :: - C.FieldName -> - (f -> PP.Doc) -> - (forall m. (C.CabalParsing m) => m f) -> - FieldDescrs s a -singletonF fn f g = F $ Map.singleton fn (SP f g) - -instance C.FieldGrammar PrettyParsec FieldDescrs where - blurFieldGrammar _ (F m) = F m - - booleanFieldDef fn _ _def = singletonF fn f C.parsec - where - f :: Bool -> PP.Doc - f s = PP.text (show s) - - uniqueFieldAla fn _pack _ = - singletonF fn (C.pretty . Newtype.pack' _pack) (Newtype.unpack' _pack <$> C.parsec) - - optionalFieldAla fn _pack _ = - singletonF fn (C.pretty . Newtype.pack' _pack) (Newtype.unpack' _pack <$> C.parsec) - - optionalFieldDefAla fn _pack _ def = - singletonF fn f (Newtype.unpack' _pack <$> C.parsec) - where - f s - | s == def = PP.empty - | otherwise = C.pretty (Newtype.pack' _pack s) - - monoidalFieldAla fn _pack _ = - singletonF fn (C.pretty . Newtype.pack' _pack) (Newtype.unpack' _pack <$> C.parsec) - - freeTextField fn _ = F $ Map.singleton fn FreeText - freeTextFieldDef fn _ = F $ Map.singleton fn FreeText - freeTextFieldDefST fn _ = F $ Map.singleton fn FreeText - - prefixedFields _fnPfx _l = F mempty - knownField _ = pure () - deprecatedSince _ _ x = x - removedIn _ _ x = x - availableSince _ _ = id - hiddenField _ = F mempty - -class (C.Pretty a, C.Parsec a) => PrettyParsec a - -instance (C.Pretty a, C.Parsec a) => PrettyParsec a diff --git a/source/library/CabalGild/Fields/BuildDepends.hs b/source/library/CabalGild/Fields/BuildDepends.hs deleted file mode 100644 --- a/source/library/CabalGild/Fields/BuildDepends.hs +++ /dev/null @@ -1,162 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-deprecations #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Fields.BuildDepends - ( buildDependsF, - setupDependsF, - buildToolDependsF, - ) -where - -import CabalGild.Fields -import CabalGild.Options -import Control.Arrow ((&&&)) -import qualified Data.Char as Char -import Data.List (dropWhileEnd) -import qualified Data.List as List -import qualified Distribution.CabalSpecVersion as C -import qualified Distribution.Compat.Newtype as Newtype -import qualified Distribution.FieldGrammar as C -import qualified Distribution.Parsec as C -import qualified Distribution.Pretty as C -import qualified Distribution.Types.Dependency as C -import qualified Distribution.Types.DependencyMap as C -import qualified Distribution.Types.ExeDependency as C -import qualified Distribution.Types.VersionRange as C -import qualified Text.PrettyPrint as PP -import VersionInterval (ConversionProblem (..), normaliseVersionRange) - -setupDependsF :: Options -> FieldDescrs () () -setupDependsF opts = singletonF "setup-depends" (pretty opts) parse - -buildDependsF :: Options -> FieldDescrs () () -buildDependsF opts = singletonF "build-depends" (pretty opts) parse - -buildToolDependsF :: Options -> FieldDescrs () () -buildToolDependsF opts = singletonF "build-tool-depends" (prettyExe opts) parseExe - -parse :: (C.CabalParsing m) => m [C.Dependency] -parse = Newtype.unpack' (C.alaList C.CommaVCat) <$> C.parsec - -parseExe :: (C.CabalParsing m) => m [C.ExeDependency] -parseExe = Newtype.unpack' (C.alaList C.CommaVCat) <$> C.parsec - -normaliseVersionRange' :: C.VersionRange -> C.VersionRange -normaliseVersionRange' vr = either fromConversionProblem id (normaliseVersionRange vr) - where - fromConversionProblem :: ConversionProblem -> C.VersionRange - fromConversionProblem IntervalsEmpty = C.noVersion - fromConversionProblem OtherConversionProblem = vr - -pretty :: Options -> [C.Dependency] -> PP.Doc -pretty opts deps = case deps of - [] -> PP.empty - [dep] -> PP.text (prettyDepNoVersion dep) PP.<+> prettyVR vr' - where - vr' = normaliseVersionRange' (C.depVerRange dep) - - prettyVR vr - | vr == C.anyVersion = PP.empty - | vr == C.noVersion = PP.text "<0" - | otherwise = C.pretty vr - _ -> prettyMany opts deps' - where - deps' :: [(String, C.VersionRange)] - deps' = - List.sortOn (map Char.toLower . fst) $ - map (prettyDepNoVersion &&& C.depVerRange) $ - C.fromDepMap . C.toDepMap $ -- this combines duplicate packages - deps - where - prettyDepNoVersion :: C.Dependency -> String - prettyDepNoVersion (C.Dependency pkg _ libs) = - C.prettyShow (C.Dependency pkg C.anyVersion libs) - -prettyExe :: Options -> [C.ExeDependency] -> PP.Doc -prettyExe opts deps = case deps of - [] -> PP.empty - [dep] -> PP.text (exeDepExeName dep) PP.<+> prettyVR vr' - where - vr' = normaliseVersionRange' (exeDepVerRange dep) - - prettyVR vr - | vr == C.anyVersion = PP.empty - | vr == C.noVersion = PP.text "<0" - | otherwise = C.pretty vr - _ -> prettyMany opts deps' - where - deps' :: [(String, C.VersionRange)] - deps' = - List.sortOn (map Char.toLower . fst) $ - map - (exeDepExeName &&& exeDepVerRange) - -- C.fromDepMap . C.toDepMap -- this combines duplicate packages - deps - -exeDepExeName :: C.ExeDependency -> String -exeDepExeName (C.ExeDependency name exe _) = - C.prettyShow name ++ ":" ++ C.prettyShow exe - -exeDepVerRange :: C.ExeDependency -> C.VersionRange -exeDepVerRange (C.ExeDependency _ _ vr) = vr - -prettyMany :: Options -> [(String, C.VersionRange)] -> PP.Doc -prettyMany Options {optSpecVersion = v, optTabular = tab} deps' = - PP.vcat $ - map PP.text $ - tbl $ - zipWith cols (True : repeat False) deps' - where - cols :: Bool -> (String, C.VersionRange) -> [String] - cols isFirst (name, vr) - | full vr' = [comma, name] - | otherwise = comma : name : "" : words (C.prettyShow vr') - where - vr' = normaliseVersionRange' vr - - comma :: String - comma - | isFirst, v < C.CabalSpecV2_2 = " " - | otherwise = "," - - full :: C.VersionRange -> Bool - full vr = vr == C.anyVersion - - tbl :: [[String]] -> [String] - tbl = if tab then table else map (concatSpaces . unwords) - --- returns rows. -table :: [[String]] -> [String] -table cells = map strip rows - where - cols :: Int - rowWidths :: [Int] - rows :: [String] - - (cols, rowWidths, rows) = foldr go (0, repeat 0, []) cells - - go :: [String] -> (Int, [Int], [String]) -> (Int, [Int], [String]) - go xs (c, w, yss) = - ( max c (length xs), - zipWith max w (map length xs ++ repeat 0), - unwords (take cols (zipWith fill xs rowWidths)) - : yss - ) - - fill :: String -> Int -> String - fill s n = s ++ replicate (n - length s) ' ' - -strip :: String -> String -strip = dropWhileEnd (' ' ==) - -concatSpaces :: String -> String -concatSpaces [] = [] -concatSpaces (' ' : s) = ' ' : concatSpaces s -concatSpaces (c0 : s0) = c0 : go s0 - where - go (' ' : ' ' : s) = go (' ' : s) - go (c : s) = c : go s - go [] = [] diff --git a/source/library/CabalGild/Fields/Extensions.hs b/source/library/CabalGild/Fields/Extensions.hs deleted file mode 100644 --- a/source/library/CabalGild/Fields/Extensions.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Fields.Extensions - ( otherExtensionsF, - defaultExtensionsF, - ) -where - -import CabalGild.Fields -import qualified Data.List as List -import qualified Distribution.Compat.Newtype as Newtype -import qualified Distribution.FieldGrammar as C -import qualified Distribution.Parsec as C -import qualified Distribution.Pretty as C -import qualified Language.Haskell.Extension as C -import qualified Text.PrettyPrint as PP - -otherExtensionsF :: FieldDescrs () () -otherExtensionsF = singletonF "other-extensions" pretty parse - -defaultExtensionsF :: FieldDescrs () () -defaultExtensionsF = singletonF "default-extensions" pretty parse - -parse :: (C.CabalParsing m) => m [C.Extension] -parse = Newtype.unpack' (C.alaList' C.FSep C.MQuoted) <$> C.parsec - -pretty :: [C.Extension] -> PP.Doc -pretty = PP.vcat . map C.pretty . List.sortOn C.prettyShow diff --git a/source/library/CabalGild/Fields/Modules.hs b/source/library/CabalGild/Fields/Modules.hs deleted file mode 100644 --- a/source/library/CabalGild/Fields/Modules.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Fields.Modules - ( otherModulesF, - exposedModulesF, - ) -where - -import CabalGild.Fields -import qualified Data.Char as Char -import qualified Data.Function as Function -import qualified Data.List as List -import qualified Distribution.Compat.Newtype as Newtype -import qualified Distribution.FieldGrammar as C -import qualified Distribution.ModuleName as C -import qualified Distribution.Parsec as C -import qualified Distribution.Pretty as C -import qualified Text.PrettyPrint as PP - -exposedModulesF :: FieldDescrs () () -exposedModulesF = singletonF "exposed-modules" pretty parse - -otherModulesF :: FieldDescrs () () -otherModulesF = singletonF "other-modules" pretty parse - -parse :: (C.CabalParsing m) => m [C.ModuleName] -parse = Newtype.unpack' (C.alaList' C.VCat C.MQuoted) <$> C.parsec - -pretty :: [C.ModuleName] -> PP.Doc -pretty = - PP.vcat - . map C.pretty - . List.nub - . List.sortBy (cmp `Function.on` map strToLower . C.components) - where - cmp :: (Ord a) => [a] -> [a] -> Ordering - cmp a b = case dropCommonPrefix a b of - ([], []) -> EQ - ([], _ : _) -> LT - (_ : _, []) -> GT - (a', b') -> compare a' b' - -strToLower :: String -> String -strToLower = map Char.toLower - -dropCommonPrefix :: (Eq a) => [a] -> [a] -> ([a], [a]) -dropCommonPrefix [] [] = ([], []) -dropCommonPrefix [] ys = ([], ys) -dropCommonPrefix xs [] = (xs, []) -dropCommonPrefix xs@(x : xs') ys@(y : ys') - | x == y = dropCommonPrefix xs' ys' - | otherwise = (xs, ys) diff --git a/source/library/CabalGild/Fields/SourceFiles.hs b/source/library/CabalGild/Fields/SourceFiles.hs deleted file mode 100644 --- a/source/library/CabalGild/Fields/SourceFiles.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Fields.SourceFiles - ( sourceFilesF, - fileFields, - ) -where - --- Make sure we explicitly use Posix's splitDirectories --- when parsing glob syntax since only `/` is valid, and not '\\' - -import CabalGild.Fields -import qualified Data.Char as Char -import qualified Data.Function as Function -import qualified Data.List as List -import qualified Distribution.Compat.Newtype as Newtype -import qualified Distribution.FieldGrammar as C -import qualified Distribution.Fields as C -import qualified Distribution.Parsec as C -import qualified Distribution.Pretty as C -import qualified System.FilePath.Posix as Posix (splitDirectories) -import qualified Text.PrettyPrint as PP - -sourceFilesF :: [FieldDescrs () ()] -sourceFilesF = - [ singletonF f pretty parse - | f <- fileFields - ] - -fileFields :: [C.FieldName] -fileFields = - [ "extra-source-files", - "extra-doc-files", - "data-files", - "license-files", - "asm-sources", - "cmm-sources", - "c-sources", - "cxx-sources", - "js-sources", - "includes", - "install-includes" - ] - -parse :: (C.CabalParsing m) => m [FilePath] -parse = Newtype.unpack' (C.alaList' C.VCat C.FilePathNT) <$> C.parsec - -pretty :: [FilePath] -> PP.Doc -pretty = - PP.vcat - . map C.showFilePath - . List.nub - . List.sortBy (cmp `Function.on` map strToLower . Posix.splitDirectories) - where - cmp :: (Ord a) => [a] -> [a] -> Ordering - cmp a b = case dropCommonPrefix a b of - ([], []) -> EQ - ([], _ : _) -> LT - (_ : _, []) -> GT - (a', b') -> compare a' b' - -strToLower :: String -> String -strToLower = map Char.toLower - -dropCommonPrefix :: (Eq a) => [a] -> [a] -> ([a], [a]) -dropCommonPrefix [] [] = ([], []) -dropCommonPrefix [] ys = ([], ys) -dropCommonPrefix xs [] = (xs, []) -dropCommonPrefix xs@(x : xs') ys@(y : ys') - | x == y = dropCommonPrefix xs' ys' - | otherwise = (xs, ys) diff --git a/source/library/CabalGild/Fields/TestedWith.hs b/source/library/CabalGild/Fields/TestedWith.hs deleted file mode 100644 --- a/source/library/CabalGild/Fields/TestedWith.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Fields.TestedWith - ( testedWithF, - ) -where - -import CabalGild.Fields -import CabalGild.Options -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set -import qualified Distribution.CabalSpecVersion as C -import qualified Distribution.Compat.Newtype as Newtype -import qualified Distribution.Compiler as C -import qualified Distribution.FieldGrammar as C -import qualified Distribution.Parsec as C -import qualified Distribution.Pretty as C -import qualified Distribution.Version as C -import qualified Text.PrettyPrint as PP - -testedWithF :: Options -> FieldDescrs () () -testedWithF Options {optSpecVersion = ver} = singletonF "tested-with" pretty parse - where - parse :: (C.CabalParsing m) => m [(C.CompilerFlavor, C.VersionRange)] - parse = Newtype.unpack' (C.alaList' C.FSep C.TestedWith) <$> C.parsec - - pretty :: [(C.CompilerFlavor, C.VersionRange)] -> PP.Doc - pretty tw0 = - leadingComma - ver - [ prettyC c PP.<+> prettyVr vr - | (c, vr) <- Map.toList tw1 - ] - where - tw1 :: Map.Map C.CompilerFlavor C.VersionRange - tw1 = Map.fromListWith C.unionVersionRanges tw0 - - -- TODO: Cabal 3.0 formatting! - prettyVr vr = case isVersionSet vr of - Just vs -> PP.sep $ mapTail (\doc -> PP.nest (-3) $ PP.text "||" PP.<+> doc) [C.pretty (C.thisVersion v) | v <- Set.toList vs] - Nothing -> C.pretty vr - - prettyC C.GHC = PP.text "GHC" - prettyC C.GHCJS = PP.text "GHCJS" - prettyC c = C.pretty c - -leadingComma :: C.CabalSpecVersion -> [PP.Doc] -> PP.Doc -leadingComma _ [] = PP.empty -leadingComma _ [x] = x -leadingComma v xs = PP.vcat $ zipWith comma (True : repeat False) xs - where - comma :: Bool -> PP.Doc -> PP.Doc - comma isFirst doc - | isFirst, v < C.CabalSpecV3_0 = PP.char ' ' PP.<+> doc - | otherwise = PP.char ',' PP.<+> doc - -isVersionSet :: C.VersionRange -> Maybe (Set.Set C.Version) -isVersionSet vr = go Set.empty (C.asVersionIntervals vr) - where - go !acc [] = Just acc - go acc (C.VersionInterval (C.LowerBound v C.InclusiveBound) (C.UpperBound u C.InclusiveBound) : vis) - | v == u = go (Set.insert v acc) vis - go _ _ = Nothing - -mapTail :: (a -> a) -> [a] -> [a] -mapTail _ [] = [] -mapTail f (x : xs) = x : map f xs diff --git a/source/library/CabalGild/FreeText.hs b/source/library/CabalGild/FreeText.hs deleted file mode 100644 --- a/source/library/CabalGild/FreeText.hs +++ /dev/null @@ -1,86 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module CabalGild.FreeText - ( fieldlinesToFreeText, - showFreeText, - ) -where - -import Data.List (foldl') -import qualified Data.List as List -import qualified Distribution.CabalSpecVersion as C -import qualified Distribution.Fields.Field as C -import qualified Distribution.Parsec as C -import qualified Distribution.Parsec.Position as C -import qualified Distribution.Pretty as C -import Distribution.Utils.Generic (fromUTF8BS) -import qualified Distribution.Utils.String as C (trim) -import qualified Text.PrettyPrint as PP - -showFreeText :: C.CabalSpecVersion -> String -> PP.Doc -showFreeText v - | v >= C.CabalSpecV3_0 = - C.showFreeTextV3 - | otherwise = - C.showFreeText - --- This should perfectly be exported from Cabal-syntax -fieldlinesToFreeText :: C.CabalSpecVersion -> C.Position -> [C.FieldLine C.Position] -> String -fieldlinesToFreeText v - | v >= C.CabalSpecV3_0 = - fieldlinesToFreeText3 - | otherwise = - const fieldlinesToFreeText2 - -fieldlinesToFreeText2 :: [C.FieldLine C.Position] -> String -fieldlinesToFreeText2 [C.FieldLine _ "."] = "." -fieldlinesToFreeText2 fls = List.intercalate "\n" (map go fls) - where - go :: C.FieldLine ann -> String - go (C.FieldLine _ bs) - | s == "." = "" - | otherwise = s - where - s = C.trim (fromUTF8BS bs) - -fieldlinesToFreeText3 :: C.Position -> [C.FieldLine C.Position] -> String -fieldlinesToFreeText3 _ [] = "" -fieldlinesToFreeText3 _ [C.FieldLine _ bs] = fromUTF8BS bs -fieldlinesToFreeText3 pos (C.FieldLine pos1 bs1 : fls2@(C.FieldLine pos2 _ : _)) - -- if first line is on the same line with field name: - -- the indentation level is either - -- 1. the indentation of left most line in rest fields - -- 2. the indentation of the first line - -- whichever is leftmost - | C.positionRow pos == C.positionRow pos1 = - concat $ - fromUTF8BS bs1 - : mealy (mk mcol1) pos1 fls2 - -- otherwise, also indent the first line - | otherwise = - concat $ - replicate (C.positionCol pos1 - mcol2) ' ' - : fromUTF8BS bs1 - : mealy (mk mcol2) pos1 fls2 - where - mcol1 = foldl' (\a b -> min a $ C.positionCol $ C.fieldLineAnn b) (min (C.positionCol pos1) (C.positionCol pos2)) fls2 - mcol2 = foldl' (\a b -> min a $ C.positionCol $ C.fieldLineAnn b) (C.positionCol pos1) fls2 - - mk :: Int -> C.Position -> C.FieldLine C.Position -> (C.Position, String) - mk col p (C.FieldLine q bs) = - ( q, - -- in Cabal-syntax there is no upper limit, i.e. no min - -- we squash multiple empty lines to one - replicate (min 2 newlines) '\n' - ++ replicate indent ' ' - ++ fromUTF8BS bs - ) - where - newlines = C.positionRow q - C.positionRow p - indent = C.positionCol q - col - -mealy :: (s -> a -> (s, b)) -> s -> [a] -> [b] -mealy f = go - where - go _ [] = [] - go s (x : xs) = let ~(s', y) = f s x in y : go s' xs diff --git a/source/library/CabalGild/Glob.hs b/source/library/CabalGild/Glob.hs deleted file mode 100644 --- a/source/library/CabalGild/Glob.hs +++ /dev/null @@ -1,69 +0,0 @@ -module CabalGild.Glob where - -import Data.List (isInfixOf) -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NonEmpty -import qualified System.FilePath as Native (splitDirectories) -import qualified System.FilePath.Posix as Posix (splitDirectories) - -data Glob = Glob FilePath [GlobPiece] - deriving (Show) - -data GlobPiece - = GlobStarStar - | GlobPiece (NonEmpty GlobChar) - deriving (Show) - -data GlobChar - = GlobStar - | GlobChar Char - deriving (Show) - --- | Match glob --- --- >>> let Right g = parseGlob "cbits/**/*.c" --- --- >>> map (match g) ["foo", "cbits/header.h", "cbits/source.c", "cbits/dir/source.c"] --- [False,False,True,True] -match :: Glob -> FilePath -> Bool -match (Glob g1 gs0) fp = go0 (Native.splitDirectories fp) - where - go0 [] = False - go0 (p : ps) = p == g1 && go ps gs0 - - go :: [FilePath] -> [GlobPiece] -> Bool - go [] [] = True - go [] (_ : _) = False - go (_ : _) [] = False - go (s : ss) (GlobStarStar : gs) = go (s : ss) gs || go ss (GlobStarStar : gs) - go (s : ss) (GlobPiece cs : gs) = matches s (NonEmpty.toList cs) && go ss gs - - matches :: FilePath -> [GlobChar] -> Bool - matches [] [] = True - matches (_ : _) [] = False - matches [] (_ : _) = False - matches (x : xs) (GlobStar : cs) = matches (x : xs) cs || matches xs (GlobStar : cs) - matches (x : xs) (GlobChar c : cs) = x == c && matches xs cs - -parseGlob :: String -> Either String Glob -parseGlob input = case Posix.splitDirectories input of - [] -> Left "empty path" - (x : xs) -> do - p <- parseFirstPiece x - ps <- traverse parsePiece xs - return (Glob p ps) - where - parseFirstPiece :: String -> Either String FilePath - parseFirstPiece "" = Left "empty path segment" - parseFirstPiece s | "*" `isInfixOf` s = Left "wild card in first path segment" - parseFirstPiece s = Right s - - parsePiece :: String -> Either String GlobPiece - parsePiece "" = Left "empty path segment" - parsePiece "**" = Right GlobStarStar - parsePiece s | "**" `isInfixOf` s = Left $ "** inside path segment: " ++ s - parsePiece (c : cs) = Right (GlobPiece (parseChar c :| map parseChar cs)) - - parseChar :: Char -> GlobChar - parseChar '*' = GlobStar - parseChar c = GlobChar c diff --git a/source/library/CabalGild/Main.hs b/source/library/CabalGild/Main.hs --- a/source/library/CabalGild/Main.hs +++ b/source/library/CabalGild/Main.hs @@ -1,153 +1,93 @@ --- | --- License: BSD-3-Clause --- Copyright: Oleg Grenrus -module CabalGild.Main (main) where +module CabalGild.Main where -import CabalGild (cabalGild) -import CabalGild.Error (Error (SomeError), renderError) -import CabalGild.Monad (runCabalGildIO) -import CabalGild.Options +import qualified CabalGild.Action.AttachComments as AttachComments +import qualified CabalGild.Action.Discover as Discover +import qualified CabalGild.Action.ExtractComments as ExtractComments +import qualified CabalGild.Action.Format as Format +import qualified CabalGild.Action.GetCabalVersion as GetCabalVersion +import qualified CabalGild.Action.Reindent as Reindent +import qualified CabalGild.Action.RemovePositions as RemovePositions +import qualified CabalGild.Action.Render as Render +import qualified CabalGild.Class.MonadLog as MonadLog +import qualified CabalGild.Class.MonadRead as MonadRead +import qualified CabalGild.Class.MonadWalk as MonadWalk +import qualified CabalGild.Class.MonadWrite as MonadWrite +import qualified CabalGild.Exception.CheckFailure as CheckFailure +import qualified CabalGild.Exception.ParseError as ParseError +import qualified CabalGild.Type.Config as Config +import qualified CabalGild.Type.Flag as Flag +import qualified CabalGild.Type.Mode as Mode import qualified Control.Monad as Monad import qualified Control.Monad.Catch as Exception -import qualified Data.ByteString as BS import qualified Data.Maybe as Maybe -import Data.Traversable (for) import qualified Data.Version as Version -import Distribution.Utils.Generic (toUTF8BS) +import qualified Distribution.Fields as Fields import qualified Paths_cabal_gild as This import qualified System.Console.GetOpt as GetOpt import qualified System.Environment as Environment -import System.Exit (exitFailure) import qualified System.Exit as Exit -import System.FilePath (takeDirectory) -import System.IO (hPutStrLn, stderr) -import qualified Text.Read as Read +import qualified System.IO as IO -main :: IO () -main = do +defaultMain :: IO () +defaultMain = Exception.handle onException $ do + name <- Environment.getProgName arguments <- Environment.getArgs - let (flags, filepaths, unknowns, invalids) = GetOpt.getOpt' GetOpt.Permute flagOptions arguments - mapM_ (Exception.throwM . userError . mappend "unknown option: ") unknowns - mapM_ (Exception.throwM . userError . mappend "invalid option: ") invalids - config <- flagsToConfig flags - let opts = configOptions config - - Monad.when (configHelp config) $ do - name <- Environment.getProgName - putStr $ GetOpt.usageInfo name flagOptions - Exit.exitSuccess - - Monad.when (configVersion config) $ do - putStrLn $ Version.showVersion This.version - Exit.exitSuccess - - notFormatted <- - Maybe.catMaybes <$> case filepaths of - [] -> fmap pure $ BS.getContents >>= main' opts Nothing - (_ : _) -> for filepaths $ \filepath -> do - contents <- BS.readFile filepath - main' opts (Just filepath) contents - - Monad.when ((optMode opts == ModeCheck) && not (null notFormatted)) $ do - Monad.forM_ notFormatted $ \filepath -> - hPutStrLn stderr $ "error: Input " <> filepath <> " is not formatted." - exitFailure - -main' :: Options -> Maybe FilePath -> BS.ByteString -> IO (Maybe FilePath) -main' opts mfilepath input = do - -- name of the input - let filepath = Maybe.fromMaybe "" mfilepath - - mroot <- - fmap takeDirectory <$> case (mfilepath, optStdinInputFile opts) of - (Just _, Just _) -> do - renderError $ SomeError "cannot pass both --stdin-input-file and FILE" - exitFailure - (Just f, Nothing) -> pure $ Just f - (Nothing, Just f) -> pure $ Just f - (Nothing, Nothing) -> pure Nothing - - -- process - res <- runCabalGildIO mroot opts (cabalGild filepath input) - - case res of - Right output -> do - let outputBS = toUTF8BS output - formatted = outputBS == input - - case optMode opts of - ModeStdout -> BS.putStr outputBS - ModeInplace -> case mfilepath of - Nothing -> BS.putStr outputBS - Just _ -> Monad.unless formatted $ BS.writeFile filepath outputBS - _ -> return () - - return $ if formatted then Nothing else Just filepath - Left err -> do - renderError err - exitFailure - -------------------------------------------------------------------------------- --- Options parser -------------------------------------------------------------------------------- + mainWith name arguments -data Flag - = FlagCabalFile Bool - | FlagError Bool - | FlagHelp - | FlagIndent String - | FlagMode Mode - | FlagStdinInputFile String - | FlagTabular Bool - | FlagVersion - deriving (Eq, Show) +onException :: Exception.SomeException -> IO a +onException e = case Exception.fromException e of + Just exitCode -> Exit.exitWith exitCode + Nothing -> do + IO.hPutStrLn IO.stderr $ Exception.displayException e + Exit.exitFailure -flagOptions :: [GetOpt.OptDescr Flag] -flagOptions = - [ GetOpt.Option [] ["Werror"] (GetOpt.NoArg $ FlagError True) "Treat warnings as errors", - GetOpt.Option [] ["Wno-error"] (GetOpt.NoArg $ FlagError False) "", - GetOpt.Option [] ["indent"] (GetOpt.ReqArg FlagIndent "N") "Indentation", - GetOpt.Option [] ["tabular"] (GetOpt.NoArg $ FlagTabular True) "Tabular formatting", - GetOpt.Option [] ["no-tabular"] (GetOpt.NoArg $ FlagTabular False) "", - GetOpt.Option [] ["cabal-file"] (GetOpt.NoArg $ FlagCabalFile True) "", - GetOpt.Option ['n'] ["no-cabal-file"] (GetOpt.NoArg $ FlagCabalFile False) "Don't parse as .cabal file", - GetOpt.Option [] ["stdout"] (GetOpt.NoArg $ FlagMode ModeStdout) "Write output to stdout (default)", - GetOpt.Option ['i'] ["inplace"] (GetOpt.NoArg $ FlagMode ModeInplace) "Process files in-place", - GetOpt.Option ['c'] ["check"] (GetOpt.NoArg $ FlagMode ModeCheck) "Fail with non-zero exit code if input is not formatted", - GetOpt.Option [] ["stdin-input-file"] (GetOpt.ReqArg FlagStdinInputFile "FILE") "When reading from STDIN, use this file path to resolve relative references", - GetOpt.Option ['h'] ["help"] (GetOpt.NoArg FlagHelp) "Show this help text", - GetOpt.Option [] ["version"] (GetOpt.NoArg FlagVersion) "Show version" - ] +mainWith :: + ( MonadLog.MonadLog m, + MonadRead.MonadRead m, + Exception.MonadThrow m, + MonadWalk.MonadWalk m, + MonadWrite.MonadWrite m + ) => + String -> + [String] -> + m () +mainWith name arguments = do + flags <- Flag.fromArguments arguments + config <- Config.fromFlags flags + let version = Version.showVersion This.version -data Config = Config - { configHelp :: Bool, - configOptions :: Options, - configVersion :: Bool - } - deriving (Show) + Monad.when (Config.help config) $ do + let header = + unlines + [ name <> " version " <> version, + "", + "" + ] + MonadLog.log $ GetOpt.usageInfo header Flag.options + Exception.throwM Exit.ExitSuccess -initialConfig :: Config -initialConfig = - Config - { configHelp = False, - configOptions = defaultOptions, - configVersion = False - } + Monad.when (Config.version config) $ do + MonadLog.logLn version + Exception.throwM Exit.ExitSuccess -applyFlag :: (Exception.MonadThrow m) => Config -> Flag -> m Config -applyFlag c f = case f of - FlagCabalFile b -> pure c {configOptions = (configOptions c) {optCabalFile = b}} - FlagError b -> pure c {configOptions = (configOptions c) {optError = b}} - FlagHelp -> pure c {configHelp = True} - FlagIndent s -> do - i <- case Read.readMaybe s of - Nothing -> Exception.throwM . userError $ "invalid indent: " <> show s - Just i -> pure i - pure c {configOptions = (configOptions c) {optIndent = i}} - FlagMode m -> pure c {configOptions = (configOptions c) {optMode = m}} - FlagStdinInputFile s -> pure c {configOptions = (configOptions c) {optStdinInputFile = Just s}} - FlagTabular b -> pure c {configOptions = (configOptions c) {optTabular = b}} - FlagVersion -> pure c {configVersion = True} + input <- MonadRead.read $ Config.input config + fields <- + either (Exception.throwM . ParseError.ParseError) pure $ + Fields.readFields input + let csv = GetCabalVersion.fromFields fields + comments = ExtractComments.fromByteString input + output <- + ( AttachComments.run + Monad.>=> Reindent.run csv + Monad.>=> RemovePositions.run + Monad.>=> Discover.run (Maybe.fromMaybe (Config.stdin config) $ Config.input config) + Monad.>=> Format.run csv + Monad.>=> Render.run + ) + (fields, comments) -flagsToConfig :: (Exception.MonadThrow m) => [Flag] -> m Config -flagsToConfig = Monad.foldM applyFlag initialConfig + case Config.mode config of + Mode.Check -> + Monad.when (output /= input) $ + Exception.throwM CheckFailure.CheckFailure + Mode.Format -> MonadWrite.write (Config.output config) output diff --git a/source/library/CabalGild/Monad.hs b/source/library/CabalGild/Monad.hs deleted file mode 100644 --- a/source/library/CabalGild/Monad.hs +++ /dev/null @@ -1,226 +0,0 @@ -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Monad - ( -- * Monad class - MonadCabalGild (..), - getFiles, - Contents (..), - - -- * Pure implementation - CabalGild, - runCabalGild, - - -- * IO implementation - CabalGildIO, - runCabalGildIO, - ) -where - -import CabalGild.Error -import CabalGild.Options -import Control.Exception - ( IOException, - catch, - displayException, - throwIO, - try, - ) -import Control.Monad (when) -import Control.Monad.Except (MonadError (..)) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Reader (MonadReader (..), ReaderT (..), asks, runReaderT) -import Control.Monad.Writer (WriterT, runWriterT, tell) -import Data.Bifunctor (first) -import qualified Data.ByteString as BS -import Data.List (isPrefixOf, stripPrefix) -import qualified Data.Map as Map -import Data.Maybe (mapMaybe) -import qualified System.Directory as D -import System.Exit (exitFailure) -import System.FilePath (pathSeparator, ()) -import System.IO (hPutStrLn, stderr) - -------------------------------------------------------------------------------- --- Class -------------------------------------------------------------------------------- - --- | @cabal-gild@ interface. --- --- * reader of 'Options' --- * errors of 'Error' --- * can list directories -class (HasOptions r, MonadReader r m, MonadError Error m) => MonadCabalGild r m | m -> r where - listDirectory :: FilePath -> m [FilePath] - doesDirectoryExist :: FilePath -> m Bool - - readFileBS :: FilePath -> m Contents - - displayWarning :: String -> m () - -data Contents - = Contents BS.ByteString - | NoIO - | IOError String - -------------------------------------------------------------------------------- --- Pure -------------------------------------------------------------------------------- - --- | Pure 'MonadCabalGild'. --- --- 'listDirectory' always return empty list. -newtype CabalGild a = CabalGild {unCabalGild :: ReaderT (Options, Map.Map FilePath BS.ByteString) (WriterT [String] (Either Error)) a} - deriving newtype (Functor, Applicative, Monad, MonadError Error) - -instance MonadReader Options CabalGild where - ask = CabalGild $ asks fst - - local f (CabalGild m) = CabalGild $ local (first f) m - -instance MonadCabalGild Options CabalGild where - listDirectory dir = CabalGild $ do - files <- asks snd - return $ mapMaybe f (Map.keys files) - where - f :: FilePath -> Maybe FilePath - f fp = do - rest <- stripPrefix (dir ++ [pathSeparator]) fp - return $ takeWhile (/= pathSeparator) rest - - doesDirectoryExist dir = CabalGild $ do - files <- asks snd - return (any (isPrefixOf (dir ++ [pathSeparator])) (Map.keys files)) - - readFileBS p = CabalGild $ do - files <- asks snd - return (maybe (IOError "doesn't exist") Contents $ Map.lookup p files) - - displayWarning w = do - werror <- asks optError - if werror - then throwError $ WarningError w - else CabalGild $ tell [w] - -runCabalGild :: - Map.Map FilePath BS.ByteString -> - Options -> - CabalGild a -> - Either Error (a, [String]) -runCabalGild files opts m = runWriterT (runReaderT (unCabalGild m) (opts, files)) - -------------------------------------------------------------------------------- --- IO -------------------------------------------------------------------------------- - --- | Options with root for directory traversals -data Options' = Options' - { optRootDir :: Maybe FilePath, - optOpt :: Options - } - -instance HasOptions Options' where - options f (Options' mfp o) = Options' mfp <$> f o - -newtype CabalGildIO a = CabalGildIO {unCabalGildIO :: ReaderT Options' IO a} - deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader Options') - -instance MonadError Error CabalGildIO where - throwError = liftIO . throwIO - catchError m h = CabalGildIO $ ReaderT $ \r -> - catch (unCabalGildIO' r m) (unCabalGildIO' r . h) - where - unCabalGildIO' :: Options' -> CabalGildIO a -> IO a - unCabalGildIO' r m' = runReaderT (unCabalGildIO m') r - -instance MonadCabalGild Options' CabalGildIO where - listDirectory p = do - rd <- asks optRootDir - case rd of - Nothing -> return [] - Just d -> liftIO (D.listDirectory (d p)) - doesDirectoryExist p = do - rd <- asks optRootDir - case rd of - Nothing -> return False - Just d -> liftIO (D.doesDirectoryExist (d p)) - readFileBS p = do - rd <- asks optRootDir - case rd of - Nothing -> return NoIO - Just d -> liftIO $ catchIOError $ BS.readFile (d p) - displayWarning w = do - werror <- asks (optError . optOpt) - liftIO $ do - hPutStrLn stderr $ (if werror then "ERROR: " else "WARNING: ") ++ w - when werror exitFailure - -catchIOError :: IO BS.ByteString -> IO Contents -catchIOError m = catch (fmap Contents m) handler - where - handler :: IOException -> IO Contents - handler exc = return (IOError (displayException exc)) - -runCabalGildIO :: Maybe FilePath -> Options -> CabalGildIO a -> IO (Either Error a) -runCabalGildIO mfp opts m = try $ runReaderT (unCabalGildIO m) (Options' mfp opts) - -------------------------------------------------------------------------------- --- Files -------------------------------------------------------------------------------- - -getFiles :: (MonadCabalGild r m) => FilePath -> m [FilePath] -getFiles = getDirectoryContentsRecursive' check - where - check "dist-newstyle" = False - check ('.' : _) = False - check _ = True - --- | List all the files in a directory and all subdirectories. --- --- The order places files in sub-directories after all the files in their --- parent directories. The list is generated lazily so is not well defined if --- the source directory structure changes before the list is used. --- --- /Note:/ From @Cabal@'s "Distribution.Simple.Utils" -getDirectoryContentsRecursive' :: - forall m r. - (MonadCabalGild r m) => - -- | Check, whether to recurse - (FilePath -> Bool) -> - -- | top dir - FilePath -> - m [FilePath] -getDirectoryContentsRecursive' ignore' topdir = recurseDirectories [""] - where - recurseDirectories :: [FilePath] -> m [FilePath] - recurseDirectories [] = return [] - recurseDirectories (dir : dirs) = do - (files, dirs') <- collect [] [] =<< listDirectory (topdir dir) - files' <- recurseDirectories (dirs' ++ dirs) - return (files ++ files') - where - collect :: [FilePath] -> [FilePath] -> [[Char]] -> m ([FilePath], [FilePath]) - collect files dirs' [] = - return - ( reverse files, - reverse dirs' - ) - collect files dirs' (entry : entries) - | ignore entry = - collect files dirs' entries - collect files dirs' (entry : entries) = do - let dirEntry = dir entry - isDirectory <- doesDirectoryExist (topdir dirEntry) - if isDirectory - then collect files (dirEntry : dirs') entries - else collect (dirEntry : files) dirs' entries - - ignore ['.'] = True - ignore ['.', '.'] = True - ignore x = not (ignore' x) diff --git a/source/library/CabalGild/Options.hs b/source/library/CabalGild/Options.hs deleted file mode 100644 --- a/source/library/CabalGild/Options.hs +++ /dev/null @@ -1,66 +0,0 @@ --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Options - ( Mode (..), - Options (..), - defaultOptions, - OptionsMorphism, - mkOptionsMorphism, - runOptionsMorphism, - HasOptions (..), - ) -where - -import qualified Distribution.CabalSpecVersion as C -import Distribution.Compat.Lens (LensLike') - -data Mode - = ModeStdout - | ModeInplace - | ModeCheck - deriving (Eq, Show) - -data Options = Options - { optError :: !Bool, - optIndent :: !Int, - optTabular :: !Bool, - optCabalFile :: !Bool, - optSpecVersion :: !C.CabalSpecVersion, - optMode :: !Mode, - optStdinInputFile :: !(Maybe FilePath) - } - deriving (Show) - -defaultOptions :: Options -defaultOptions = - Options - { optError = False, - optIndent = 2, - optTabular = True, - optCabalFile = True, - optSpecVersion = C.cabalSpecLatest, - optMode = ModeStdout, - optStdinInputFile = Nothing - } - -newtype OptionsMorphism = OM (Options -> Options) - -runOptionsMorphism :: OptionsMorphism -> Options -> Options -runOptionsMorphism (OM f) = f - -mkOptionsMorphism :: (Options -> Options) -> OptionsMorphism -mkOptionsMorphism = OM - -instance Semigroup OptionsMorphism where - OM f <> OM g = OM (g . f) - -instance Monoid OptionsMorphism where - mempty = OM id - mappend = (<>) - -class HasOptions e where - options :: (Functor f) => LensLike' f e Options - -instance HasOptions Options where - options = id diff --git a/source/library/CabalGild/Parser.hs b/source/library/CabalGild/Parser.hs deleted file mode 100644 --- a/source/library/CabalGild/Parser.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Parser where - -import CabalGild.Error -import CabalGild.Monad -import qualified Control.Monad.Except as Except -import qualified Data.ByteString as BS -import qualified Distribution.Fields as C -import qualified Distribution.PackageDescription.Parsec as C -import qualified Distribution.Parsec as C -import qualified Distribution.Types.GenericPackageDescription as C - -runParseResult :: (MonadCabalGild r m) => FilePath -> BS.ByteString -> C.ParseResult a -> m a -runParseResult filepath contents pr = case result of - Right gpd -> return gpd - Left (mspecVersion, errors) -> Except.throwError $ CabalParseError filepath contents errors mspecVersion warnings - where - (warnings, result) = C.runParseResult pr - -parseGpd :: (MonadCabalGild r m) => FilePath -> BS.ByteString -> m C.GenericPackageDescription -parseGpd filepath contents = runParseResult filepath contents $ C.parseGenericPackageDescription contents - -parseFields :: (MonadCabalGild r m) => BS.ByteString -> m [C.Field C.Position] -parseFields contents = case C.readFields contents of - Left err -> Except.throwError $ PanicCannotParseInput err - Right x -> return x diff --git a/source/library/CabalGild/Pragma.hs b/source/library/CabalGild/Pragma.hs deleted file mode 100644 --- a/source/library/CabalGild/Pragma.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module CabalGild.Pragma where - -import CabalGild.Comments -import CabalGild.Glob -import qualified Data.Bifunctor as Bifunctor -import qualified Data.ByteString as BS -import qualified Data.Either as Either -import qualified Data.Maybe as Maybe -import qualified Distribution.Compat.CharParsing as C -import qualified Distribution.ModuleName as C -import qualified Distribution.Parsec as C -import qualified Distribution.Parsec.FieldLineStream as C - -------------------------------------------------------------------------------- --- Types -------------------------------------------------------------------------------- - -data Pragma - = FieldPragma FieldPragma - | GlobalPragma GlobalPragma - deriving (Show) - --- | Pragmas applied per field -data FieldPragma - = PragmaExpandModules FilePath [C.ModuleName] - | PragmaGlobFiles Glob - | PragmaFragment FilePath - deriving (Show) - --- | Pragmas affecting global output -data GlobalPragma - = PragmaOptIndent Int - | PragmaOptTabular Bool - deriving (Show) - -------------------------------------------------------------------------------- --- Parser -------------------------------------------------------------------------------- - --- | Parse pragma from 'ByteString'. --- --- An error ('Left') is reported only if input 'ByteString' starts with @-- cabal-gild:@. -parsePragma :: BS.ByteString -> Either String (Maybe Pragma) -parsePragma bs = case dropPrefix bs of - Nothing -> Right Nothing - Just bs' -> Bifunctor.bimap show Just $ C.runParsecParser parser "" $ C.fieldLineStreamFromBS bs' - where - dropPrefix bs0 = do - bs1 <- BS.stripPrefix "--" bs0 - bs2 <- BS.stripPrefix "cabal-gild:" (stripWhitespace bs1) - return (stripWhitespace bs2) - - parser :: C.ParsecParser Pragma - parser = do - t <- C.parsecToken - case t of - "expand" -> expandModules - "indent" -> indent - "glob-files" -> globFiles - "tabular" -> return $ GlobalPragma $ PragmaOptTabular True - "no-tabular" -> return $ GlobalPragma $ PragmaOptTabular False - "fragment" -> fragment - _ -> fail $ "Unknown pragma " ++ t - - expandModules :: C.ParsecParser Pragma - expandModules = do - C.spaces - dir <- C.parsecToken - mns <- C.many (C.space *> C.spaces *> C.char '-' *> C.parsec) - return $ FieldPragma $ PragmaExpandModules dir mns - - indent :: C.ParsecParser Pragma - indent = do - C.spaces - GlobalPragma . PragmaOptIndent <$> C.integral - - fragment :: C.ParsecParser Pragma - fragment = do - C.spaces - FieldPragma . PragmaFragment <$> C.parsecToken - - globFiles :: C.ParsecParser Pragma - globFiles = do - C.spaces - t <- C.parsecToken - case parseGlob t of - Right g -> return $ FieldPragma $ PragmaGlobFiles g - Left e -> C.unexpected e - -stripWhitespace :: BS.ByteString -> BS.ByteString -stripWhitespace bs = case BS.uncons bs of - Nothing -> bs - Just (w, bs') - | w == 32 -> stripWhitespace bs' - | otherwise -> bs - -parsePragmas :: Comments -> ([String], [Pragma]) -parsePragmas = fmap Maybe.catMaybes . Either.partitionEithers . map parsePragma . unComments diff --git a/source/library/CabalGild/Refactoring.hs b/source/library/CabalGild/Refactoring.hs deleted file mode 100644 --- a/source/library/CabalGild/Refactoring.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Refactoring - ( CommentsPragmas, - refactor, - ) -where - -import CabalGild.Fields.SourceFiles -import CabalGild.Monad -import CabalGild.Refactoring.ExpandExposedModules -import CabalGild.Refactoring.Fragments -import CabalGild.Refactoring.GlobFiles -import CabalGild.Refactoring.Type -import qualified Distribution.Fields as C - -------------------------------------------------------------------------------- --- Refactorings -------------------------------------------------------------------------------- - -refactor :: forall m r. (MonadCabalGild r m) => [C.Field CommentsPragmas] -> m [C.Field CommentsPragmas] -refactor = rewriteFields rewrite - where - rewrite :: C.Field CommentsPragmas -> m (Maybe (C.Field CommentsPragmas)) - rewrite f@(C.Field (C.Name _ n) _) - | n == "exposed-modules" || n == "other-modules" = - combine - [ refactoringFragments, - refactoringExpandExposedModules - ] - f - | n `elem` fileFields = - combine - [ refactoringFragments, - refactoringGlobFiles - ] - f - | otherwise = - combine - [ refactoringFragments - ] - f - rewrite f@C.Section {} = - combine - [ refactoringFragments - ] - f - --- | Try refactorings in turn, --- considering it done if one applies. -combine :: - (Monad m) => - [C.Field CommentsPragmas -> m (Maybe (C.Field CommentsPragmas))] -> - C.Field CommentsPragmas -> - m (Maybe (C.Field CommentsPragmas)) -combine [] _ = return Nothing -combine (r : rs) f = do - m <- r f - case m of - Nothing -> combine rs f - Just f' -> return (Just f') diff --git a/source/library/CabalGild/Refactoring/ExpandExposedModules.hs b/source/library/CabalGild/Refactoring/ExpandExposedModules.hs deleted file mode 100644 --- a/source/library/CabalGild/Refactoring/ExpandExposedModules.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -Wno-deprecations #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Refactoring.ExpandExposedModules - ( refactoringExpandExposedModules, - ) -where - -import CabalGild.Monad -import CabalGild.Pragma -import CabalGild.Refactoring.Type -import qualified Data.List as List -import qualified Data.Maybe as Maybe -import qualified Distribution.Compat.Lens as Lens -import qualified Distribution.Fields as C -import qualified Distribution.ModuleName as C -import Distribution.Utils.Generic (toUTF8BS) -import qualified System.FilePath as FilePath - -refactoringExpandExposedModules :: FieldRefactoring -refactoringExpandExposedModules C.Section {} = pure Nothing -refactoringExpandExposedModules (C.Field name@(C.Name (_, _, pragmas) _n) fls) = do - dirs <- parse pragmas - files <- (traverse . Lens._1) getFiles dirs - - let newModules :: [C.FieldLine CommentsPragmas] - newModules = - Maybe.catMaybes - [ return $ C.FieldLine emptyCommentsPragmas $ toUTF8BS $ List.intercalate "." parts - | (files', mns) <- files, - file <- files', - let parts = FilePath.splitDirectories $ FilePath.dropExtension file, - all C.validModuleComponent parts, - let mn = C.fromComponents parts, -- TODO: don't use fromComponents - mn `notElem` mns - ] - - pure $ case newModules of - [] -> Nothing - _ -> Just (C.Field name (newModules ++ fls)) - where - parse :: (MonadCabalGild r m) => [FieldPragma] -> m [(FilePath, [C.ModuleName])] - parse = fmap mconcat . traverse go - where - go :: (MonadCabalGild r m) => FieldPragma -> m [(FilePath, [C.ModuleName])] - go (PragmaExpandModules fp mns) = return [(fp, mns)] - go p = do - displayWarning $ "Skipped pragma " ++ show p - return [] diff --git a/source/library/CabalGild/Refactoring/Fragments.hs b/source/library/CabalGild/Refactoring/Fragments.hs deleted file mode 100644 --- a/source/library/CabalGild/Refactoring/Fragments.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Refactoring.Fragments - ( refactoringFragments, - ) -where - -import CabalGild.Comments -import CabalGild.Monad -import CabalGild.Parser -import CabalGild.Pragma -import CabalGild.Refactoring.Type -import qualified Control.Monad as Monad -import qualified Data.Foldable as Foldable -import qualified Distribution.Fields as C -import qualified Distribution.Fields.Field as C -import qualified Distribution.Fields.Pretty as C -import qualified Distribution.Parsec as C -import Distribution.Utils.Generic (fromUTF8BS) -import Text.PrettyPrint (hsep, render) - --- | Expand fragments. --- --- Applies to all fields and sections -refactoringFragments :: FieldRefactoring -refactoringFragments field = do - mp <- parse (getPragmas field) - case mp of - Nothing -> pure Nothing - Just p -> - readFileBS p >>= \mcontents -> case mcontents of - NoIO -> pure Nothing - IOError err -> do - displayWarning $ "Fragment " ++ p ++ " failed to read: " ++ show err - pure Nothing - Contents c -> do - fields <- parseFields c - case (field, fields) of - (_, []) -> do - displayWarning $ "Fragment " ++ p ++ " is empty." - pure Nothing - (C.Field (C.Name _ n) _, C.Section name@(C.Name _ _) arg _ : _) -> do - displayWarning $ "Fragment " ++ p ++ " contains a section " ++ showSection name arg ++ ", expecting field " ++ show n ++ "." - pure Nothing - (C.Section name@(C.Name _ _) arg _, C.Field (C.Name _ n') _ : _) -> do - displayWarning $ "Fragment " ++ p ++ " contains a field " ++ show n' ++ ", expecting section " ++ showSection name arg ++ "." - pure Nothing - (C.Field name@(C.Name _ n) _, C.Field (C.Name _ n') fls' : rest) -> do - Monad.unless (null rest) $ - displayWarning $ - "Fragment " ++ p ++ " contains multiple fields or sections, using only the first." - if n == n' - then do - -- everything is fine, replace - pure (Just (C.Field name (noCommentsPragmas fls'))) - else do - displayWarning $ "Fragment " ++ p ++ " contains field " ++ show n' ++ ", expecting field " ++ show n ++ "." - pure Nothing - (C.Section name@(C.Name _ _) arg _, C.Section name'@(C.Name _ _) arg' fs' : rest) -> do - Monad.unless (null rest) $ - displayWarning $ - "Fragment " ++ p ++ " contains multiple fields or sections, using only the first." - - if Monad.void name == Monad.void name' && map Monad.void arg == map Monad.void arg' - then do - pure (Just (C.Section name arg (noCommentsPragmas fs'))) - else do - displayWarning $ "Fragment " ++ p ++ " contains a section " ++ showSection name arg ++ ", expecting section " ++ showSection name' arg' ++ "." - pure Nothing - where - noCommentsPragmas :: (Functor f) => [f ann] -> [f CommentsPragmas] - noCommentsPragmas = map ((C.zeroPos, Comments [], []) <$) - - getPragmas :: C.Field CommentsPragmas -> [FieldPragma] - getPragmas = (\(_, _, z) -> z) . C.fieldAnn - - showSection :: C.Name ann -> [C.SectionArg ann] -> String - showSection (C.Name _ n) [] = show n - showSection (C.Name _ n) args = show (fromUTF8BS n ++ " " ++ render (hsep (C.prettySectionArgs n args))) - - parse :: (MonadCabalGild r m) => [FieldPragma] -> m (Maybe FilePath) - parse = fmap Foldable.asum . traverse go - where - go :: (Monad m) => FieldPragma -> m (Maybe FilePath) - go (PragmaFragment f) = return (Just f) - go _ = return Nothing diff --git a/source/library/CabalGild/Refactoring/GlobFiles.hs b/source/library/CabalGild/Refactoring/GlobFiles.hs deleted file mode 100644 --- a/source/library/CabalGild/Refactoring/GlobFiles.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Refactoring.GlobFiles - ( refactoringGlobFiles, - ) -where - -import CabalGild.Glob -import CabalGild.Monad -import CabalGild.Pragma -import CabalGild.Refactoring.Type -import qualified Data.Maybe as Maybe -import qualified Distribution.Fields as C -import Distribution.Utils.Generic (toUTF8BS) -import qualified System.FilePath as Native -import qualified System.FilePath.Posix as Posix - -refactoringGlobFiles :: FieldRefactoring -refactoringGlobFiles C.Section {} = pure Nothing -refactoringGlobFiles (C.Field name@(C.Name (_, _, pragmas) _n) fls) = do - globs <- parse pragmas - files <- fmap concat (traverse match' globs) - - let newFiles :: [C.FieldLine CommentsPragmas] - newFiles = - Maybe.catMaybes - [ return $ C.FieldLine emptyCommentsPragmas $ toUTF8BS file - | file <- files - ] - - pure $ case files of - [] -> Nothing - _ -> Just (C.Field name (newFiles ++ fls)) - where - parse :: (MonadCabalGild r m) => [FieldPragma] -> m [Glob] - parse = fmap mconcat . traverse go - where - go :: (MonadCabalGild r m) => FieldPragma -> m [Glob] - go (PragmaGlobFiles g) = return [g] - go p = do - displayWarning $ "Skipped pragma " ++ show p - return [] - - match' :: (MonadCabalGild r m) => Glob -> m [FilePath] - match' g@(Glob dir _) = do - files <- map (dir Native.) <$> getFiles dir - return $ map toPosix $ filter (match g) files - - toPosix :: FilePath -> FilePath - toPosix = Posix.joinPath . Native.splitDirectories diff --git a/source/library/CabalGild/Refactoring/Type.hs b/source/library/CabalGild/Refactoring/Type.hs deleted file mode 100644 --- a/source/library/CabalGild/Refactoring/Type.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE RankNTypes #-} - --- | --- License: GPL-3.0-or-later --- Copyright: Oleg Grenrus -module CabalGild.Refactoring.Type - ( FieldRefactoring, - CommentsPragmas, - emptyCommentsPragmas, - rewriteFields, - ) -where - -import CabalGild.Comments -import CabalGild.Monad -import CabalGild.Pragma -import qualified Distribution.Fields as C -import qualified Distribution.Parsec as C - -------------------------------------------------------------------------------- --- Refactoring type -------------------------------------------------------------------------------- - -type CommentsPragmas = (C.Position, Comments, [FieldPragma]) - -emptyCommentsPragmas :: CommentsPragmas -emptyCommentsPragmas = (C.zeroPos, mempty, mempty) - -type FieldRefactoring = - forall r m. - (MonadCabalGild r m) => - (C.Field CommentsPragmas -> m (Maybe (C.Field CommentsPragmas))) - -------------------------------------------------------------------------------- --- Traversing refactoring -------------------------------------------------------------------------------- - --- | A top-to-bottom rewrite of sections and fields -rewriteFields :: - (MonadCabalGild r m) => - (C.Field CommentsPragmas -> m (Maybe (C.Field CommentsPragmas))) -> - [C.Field CommentsPragmas] -> - m [C.Field CommentsPragmas] -rewriteFields f = goMany - where - goMany = traverse go - - go x = do - m <- f x - case m of - Just y -> return y - Nothing -> case x of - C.Field {} -> return x - C.Section name args fs -> C.Section name args <$> goMany fs diff --git a/source/library/CabalGild/Type/Block.hs b/source/library/CabalGild/Type/Block.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/Block.hs @@ -0,0 +1,57 @@ +module CabalGild.Type.Block where + +import qualified CabalGild.Type.Line as Line +import qualified Data.ByteString as ByteString +import qualified Distribution.Compat.Lens as Lens +import Prelude hiding (lines) + +data Block = Block + { lineBefore :: Bool, + lines :: [Line.Line], + lineAfter :: Bool + } + deriving (Eq, Show) + +instance Semigroup Block where + x <> y = + let s = [Line.empty | lineAfter x || lineBefore y] + z = + Block + { lineBefore = lineBefore x, + lines = lines x <> s <> lines y, + lineAfter = lineAfter y + } + in if isEmpty x then y else if isEmpty y then x else z + +instance Monoid Block where + mempty = + Block + { lineBefore = False, + lines = [], + lineAfter = False + } + +fromLine :: Line.Line -> Block +fromLine l = mempty {lines = [l]} + +isEmpty :: Block -> Bool +isEmpty = null . lines + +lineAfterLens :: Lens.Lens' Block Bool +lineAfterLens f s = fmap (\a -> s {lineAfter = a}) . f $ lineAfter s + +lineBeforeLens :: Lens.Lens' Block Bool +lineBeforeLens f s = fmap (\a -> s {lineBefore = a}) . f $ lineBefore s + +toByteString :: Block -> ByteString.ByteString +toByteString b = + if isEmpty b + then ByteString.empty + else + ByteString.intercalate (ByteString.singleton 0x0a) + . fmap Line.toByteString + $ concat + [ [Line.empty | lineBefore b], + lines b, + [Line.empty | lineAfter b] + ] diff --git a/source/library/CabalGild/Type/Chunk.hs b/source/library/CabalGild/Type/Chunk.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/Chunk.hs @@ -0,0 +1,48 @@ +module CabalGild.Type.Chunk where + +import qualified Data.ByteString as ByteString +import qualified Distribution.Compat.Lens as Lens + +data Chunk = Chunk + { spaceBefore :: Bool, + value :: ByteString.ByteString, + spaceAfter :: Bool + } + deriving (Eq, Show) + +instance Semigroup Chunk where + x <> y = + let s = + if spaceAfter x && spaceBefore y + then ByteString.singleton 0x20 + else ByteString.empty + z = + Chunk + { spaceBefore = spaceBefore x, + value = value x <> s <> value y, + spaceAfter = spaceAfter y + } + in if isEmpty x then y else if isEmpty y then x else z + +instance Monoid Chunk where + mempty = + Chunk + { spaceBefore = False, + value = ByteString.empty, + spaceAfter = False + } + +colon :: Chunk +colon = Lens.set spaceAfterLens True . fromByteString $ ByteString.singleton 0x3a + +fromByteString :: ByteString.ByteString -> Chunk +fromByteString bs = mempty {value = bs} + +isEmpty :: Chunk -> Bool +isEmpty = ByteString.null . value + +spaceAfterLens :: Lens.Lens' Chunk Bool +spaceAfterLens f s = fmap (\a -> s {spaceAfter = a}) . f $ spaceAfter s + +spaceBeforeLens :: Lens.Lens' Chunk Bool +spaceBeforeLens f s = fmap (\a -> s {spaceBefore = a}) . f $ spaceBefore s diff --git a/source/library/CabalGild/Type/Comment.hs b/source/library/CabalGild/Type/Comment.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/Comment.hs @@ -0,0 +1,13 @@ +module CabalGild.Type.Comment where + +import qualified CabalGild.Extra.String as String +import qualified Data.ByteString as ByteString + +data Comment a = Comment + { annotation :: a, + value :: ByteString.ByteString + } + deriving (Eq, Show) + +delimiter :: ByteString.ByteString +delimiter = String.toUtf8 "--" diff --git a/source/library/CabalGild/Type/Config.hs b/source/library/CabalGild/Type/Config.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/Config.hs @@ -0,0 +1,45 @@ +module CabalGild.Type.Config where + +import qualified CabalGild.Type.Flag as Flag +import qualified CabalGild.Type.Mode as Mode +import qualified Control.Monad as Monad +import qualified Control.Monad.Catch as Exception + +data Config = Config + { help :: Bool, + input :: Maybe FilePath, + mode :: Mode.Mode, + output :: Maybe FilePath, + stdin :: FilePath, + version :: Bool + } + deriving (Eq, Show) + +initial :: Config +initial = + Config + { help = False, + input = Nothing, + mode = Mode.Format, + output = Nothing, + stdin = ".", + version = False + } + +applyFlag :: (Exception.MonadThrow m) => Config -> Flag.Flag -> m Config +applyFlag config flag = case flag of + Flag.Help b -> pure config {help = b} + Flag.Input s -> case s of + "-" -> pure config {input = Nothing} + _ -> pure config {input = Just s} + Flag.Mode s -> do + m <- Mode.fromString s + pure config {mode = m} + Flag.Output s -> case s of + "-" -> pure config {output = Nothing} + _ -> pure config {output = Just s} + Flag.Stdin s -> pure config {stdin = s} + Flag.Version b -> pure config {version = b} + +fromFlags :: (Exception.MonadThrow m) => [Flag.Flag] -> m Config +fromFlags = Monad.foldM applyFlag initial diff --git a/source/library/CabalGild/Type/Flag.hs b/source/library/CabalGild/Type/Flag.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/Flag.hs @@ -0,0 +1,68 @@ +module CabalGild.Type.Flag where + +import qualified CabalGild.Exception.InvalidOption as InvalidOption +import qualified CabalGild.Exception.UnexpectedArgument as UnexpectedArgument +import qualified CabalGild.Exception.UnknownOption as UnknownOption +import qualified Control.Monad.Catch as Exception +import qualified System.Console.GetOpt as GetOpt + +data Flag + = Help Bool + | Input String + | Mode String + | Output String + | Stdin String + | Version Bool + deriving (Eq, Show) + +options :: [GetOpt.OptDescr Flag] +options = + [ GetOpt.Option + ['h', '?'] + ["help"] + (GetOpt.NoArg $ Help True) + "Shows this help message.", + GetOpt.Option + [] + ["no-help"] + (GetOpt.NoArg $ Help False) + "", + GetOpt.Option + ['v'] + ["version"] + (GetOpt.NoArg $ Version True) + "Shows the version number.", + GetOpt.Option + [] + ["no-version"] + (GetOpt.NoArg $ Version False) + "", + GetOpt.Option + ['i'] + ["input"] + (GetOpt.ReqArg Input "FILE") + "Sets the input file. Use '-' for standard input (STDIN).\nDefault: '-'", + GetOpt.Option + ['m'] + ["mode"] + (GetOpt.ReqArg Mode "MODE") + "Sets the mode. Must be either 'check' or 'format'.\nDefault: 'format'", + GetOpt.Option + ['o'] + ["output"] + (GetOpt.ReqArg Output "FILE") + "Sets the output file. Use '-' for standard output (STDOUT).\nDefault: '-'", + GetOpt.Option + ['s'] + ["stdin"] + (GetOpt.ReqArg Stdin "FILE") + "Sets the path to the input file when using STDIN.\nDefault: '.'" + ] + +fromArguments :: (Exception.MonadThrow m) => [String] -> m [Flag] +fromArguments arguments = do + let (flgs, args, opts, errs) = GetOpt.getOpt' GetOpt.Permute options arguments + mapM_ (Exception.throwM . UnexpectedArgument.fromString) args + mapM_ (Exception.throwM . InvalidOption.fromString) errs + mapM_ (Exception.throwM . UnknownOption.fromString) opts + pure flgs diff --git a/source/library/CabalGild/Type/Line.hs b/source/library/CabalGild/Type/Line.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/Line.hs @@ -0,0 +1,33 @@ +module CabalGild.Type.Line where + +import qualified CabalGild.Type.Chunk as Chunk +import qualified Data.ByteString as ByteString +import qualified Distribution.Compat.Lens as Lens + +data Line = Line + { indent :: Int, + chunk :: Chunk.Chunk + } + deriving (Eq, Show) + +chunkLens :: Lens.Lens' Line Chunk.Chunk +chunkLens f s = fmap (\a -> s {chunk = a}) . f $ chunk s + +empty :: Line +empty = + Line + { indent = 0, + chunk = mempty + } + +isEmpty :: Line -> Bool +isEmpty = Chunk.isEmpty . chunk + +toByteString :: Line -> ByteString.ByteString +toByteString l = + if isEmpty l + then ByteString.empty + else + mappend (ByteString.replicate (2 * indent l) 0x20) + . Chunk.value + $ chunk l diff --git a/source/library/CabalGild/Type/List.hs b/source/library/CabalGild/Type/List.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/List.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module CabalGild.Type.List where + +import qualified CabalGild.Extra.List as List +import qualified Data.Proxy as Proxy +import qualified Distribution.CabalSpecVersion as CabalSpecVersion +import qualified Distribution.Compat.Newtype as Newtype +import qualified Distribution.FieldGrammar.Newtypes as Newtypes +import qualified Distribution.Parsec as Parsec +import qualified Distribution.Pretty as Pretty +import qualified Text.PrettyPrint as PrettyPrint + +newtype List s b a = List + { unwrap :: Newtypes.List s b a + } + +instance Newtype.Newtype [a] (List s b a) where + pack = List . Newtype.pack + unpack = Newtype.unpack . unwrap + +instance + ( Newtype.Newtype a b, + Parsec.Parsec b, + Newtypes.Sep s + ) => + Parsec.Parsec (List s b a) + where + parsec = List <$> Parsec.parsec + +instance + ( Newtype.Newtype a b, + Pretty.Pretty b, + Newtypes.Sep s + ) => + Pretty.Pretty (List s b a) + where + pretty = Pretty.prettyVersioned CabalSpecVersion.CabalSpecV1_0 + prettyVersioned v = + Newtypes.prettySep (Proxy.Proxy @s) + . fmap (Pretty.prettyVersioned @b v . Newtype.pack) + . Newtype.unpack + +instance + {-# OVERLAPPING #-} + ( Newtype.Newtype a b, + Pretty.Pretty b + ) => + Pretty.Pretty (List Newtypes.CommaFSep b a) + where + pretty = Pretty.prettyVersioned CabalSpecVersion.CabalSpecV1_0 + prettyVersioned v = + ( \xs -> + if List.compareLength xs 1 == GT && v >= CabalSpecVersion.CabalSpecV2_2 + then PrettyPrint.fsep $ fmap (<> PrettyPrint.comma) xs + else Newtypes.prettySep (Proxy.Proxy @Newtypes.CommaFSep) xs + ) + . fmap (Pretty.prettyVersioned @b v . Newtype.pack) + . Newtype.unpack diff --git a/source/library/CabalGild/Type/Mode.hs b/source/library/CabalGild/Type/Mode.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/Mode.hs @@ -0,0 +1,15 @@ +module CabalGild.Type.Mode where + +import qualified CabalGild.Exception.InvalidMode as InvalidMode +import qualified Control.Monad.Catch as Exception + +data Mode + = Check + | Format + deriving (Eq, Show) + +fromString :: (Exception.MonadThrow m) => String -> m Mode +fromString s = case s of + "check" -> pure Check + "format" -> pure Format + _ -> Exception.throwM $ InvalidMode.fromString s diff --git a/source/library/CabalGild/Type/Pragma.hs b/source/library/CabalGild/Type/Pragma.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/Pragma.hs @@ -0,0 +1,19 @@ +module CabalGild.Type.Pragma where + +import qualified Control.Monad as Monad +import qualified Distribution.Compat.CharParsing as CharParsing +import qualified Distribution.FieldGrammar.Newtypes as Newtypes +import qualified Distribution.Parsec as Parsec + +newtype Pragma + = Discover FilePath + deriving (Eq, Show) + +instance Parsec.Parsec Pragma where + parsec = do + CharParsing.spaces + Monad.void $ CharParsing.string "cabal-gild:" + CharParsing.spaces + Monad.void $ CharParsing.string "discover" + CharParsing.skipSpaces1 + Discover . Newtypes.getFilePathNT <$> Parsec.parsec diff --git a/source/library/CabalGild/Type/Set.hs b/source/library/CabalGild/Type/Set.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/Set.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module CabalGild.Type.Set where + +import qualified CabalGild.Extra.List as List +import qualified Data.Proxy as Proxy +import qualified Data.Set as Set +import qualified Distribution.CabalSpecVersion as CabalSpecVersion +import qualified Distribution.Compat.Newtype as Newtype +import qualified Distribution.FieldGrammar.Newtypes as Newtypes +import qualified Distribution.Parsec as Parsec +import qualified Distribution.Pretty as Pretty +import qualified Text.PrettyPrint as PrettyPrint + +newtype Set s b a = Set + { unwrap :: Newtypes.Set' s b a + } + +instance Newtype.Newtype (Set.Set a) (Set s b a) where + pack = Set . Newtype.pack + unpack = Newtype.unpack . unwrap + +instance + ( Newtype.Newtype a b, + Ord a, + Parsec.Parsec b, + Newtypes.Sep s + ) => + Parsec.Parsec (Set s b a) + where + parsec = Set <$> Parsec.parsec + +instance + ( Newtype.Newtype a b, + Pretty.Pretty b, + Newtypes.Sep s + ) => + Pretty.Pretty (Set s b a) + where + pretty = Pretty.prettyVersioned CabalSpecVersion.CabalSpecV1_0 + prettyVersioned v = + Newtypes.prettySep (Proxy.Proxy @s) + . fmap (Pretty.prettyVersioned @b v . Newtype.pack) + . Set.toAscList + . Newtype.unpack + +instance + {-# OVERLAPPING #-} + ( Newtype.Newtype a b, + Pretty.Pretty b + ) => + Pretty.Pretty (Set Newtypes.CommaFSep b a) + where + pretty = Pretty.prettyVersioned CabalSpecVersion.CabalSpecV1_0 + prettyVersioned v = + ( \xs -> + if List.compareLength xs 1 == GT && v >= CabalSpecVersion.CabalSpecV2_2 + then PrettyPrint.fsep $ fmap (<> PrettyPrint.comma) xs + else Newtypes.prettySep (Proxy.Proxy @Newtypes.CommaFSep) xs + ) + . fmap (Pretty.prettyVersioned @b v . Newtype.pack) + . Set.toAscList + . Newtype.unpack + +instance + {-# OVERLAPPING #-} + ( Newtype.Newtype a b, + Pretty.Pretty b + ) => + Pretty.Pretty (Set Newtypes.CommaVCat b a) + where + pretty = Pretty.prettyVersioned CabalSpecVersion.CabalSpecV1_0 + prettyVersioned v = + ( \xs -> + if List.compareLength xs 1 == GT && v >= CabalSpecVersion.CabalSpecV2_2 + then PrettyPrint.vcat $ fmap (<> PrettyPrint.comma) xs + else Newtypes.prettySep (Proxy.Proxy @Newtypes.CommaVCat) xs + ) + . fmap (Pretty.prettyVersioned @b v . Newtype.pack) + . Set.toAscList + . Newtype.unpack diff --git a/source/library/CabalGild/Type/SomeParsecParser.hs b/source/library/CabalGild/Type/SomeParsecParser.hs new file mode 100644 --- /dev/null +++ b/source/library/CabalGild/Type/SomeParsecParser.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module CabalGild.Type.SomeParsecParser where + +import qualified CabalGild.Type.List as List +import qualified CabalGild.Type.Set as Set +import qualified Distribution.Parsec as Parsec +import qualified Distribution.Pretty as Pretty + +data SomeParsecParser + = forall c s b a. + (Parsec.Parsec (c s b a), Pretty.Pretty (c s b a)) => + SomeParsecParser (Parsec.ParsecParser (c s b a)) + +list :: + forall s b a. + (Parsec.Parsec (List.List s b a), Pretty.Pretty (List.List s b a)) => + SomeParsecParser +list = SomeParsecParser $ Parsec.parsec @(List.List s b a) + +set :: + forall s b a. + (Parsec.Parsec (Set.Set s b a), Pretty.Pretty (Set.Set s b a)) => + SomeParsecParser +set = SomeParsecParser $ Parsec.parsec @(Set.Set s b a) diff --git a/source/library/VersionInterval.hs b/source/library/VersionInterval.hs deleted file mode 100644 --- a/source/library/VersionInterval.hs +++ /dev/null @@ -1,448 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - --- | --- --- Author: Oleg Grenrus --- SPDX-License-Id: GPL-2.0-or-later --- --- This module implements a view of a 'VersionRange' as a finite --- list of separated version intervals. --- --- In conversion from and to 'VersionRange' it makes some effort to --- preserve the caret operator @^>=x.y@. This constraint a priori --- specifies the same interval as @==x.y.*@, but indicates that newer --- versions could be acceptable (@allow-newer: ^@). -module VersionInterval - ( -- * Version intervals - VersionIntervals, - - -- * Conversions - toVersionIntervals, - fromVersionIntervals, - ConversionProblem (..), - - -- ** Normalisation - normaliseVersionRange, - - -- * Version intervals view - VersionInterval (..), - LB (..), - MB (..), - UB (..), - Bound (..), - - -- * For testing - validVersionInterval, - validVersionIntervals, - intersectInterval, - stage1, - stage2, - stage3, - ) -where - -import Control.Monad (join) -import Data.List (sortOn) -import Data.List.NonEmpty (NonEmpty (..), cons) -import Data.Maybe (catMaybes) -import Distribution.Types.Version - ( Version, - mkVersion, - validVersion, - version0, - versionNumbers, - ) -import Distribution.Types.VersionRange.Internal - ( VersionRange, - VersionRangeF (..), - cataVersionRange, - earlierVersion, - intersectVersionRanges, - majorBoundVersion, - majorUpperBound, - noVersion, - orLaterVersion, - thisVersion, - unionVersionRanges, - ) - -singleton :: a -> NonEmpty a -singleton x = x :| [] - -------------------------------------------------------------------------------- --- Data -------------------------------------------------------------------------------- - --- | A complementary representation of a 'VersionRange'. Instead of a boolean --- version predicate it uses an increasing sequence of non-overlapping, --- non-empty intervals. --- --- This version is different than in @Cabal-3.8@ and previous, --- as it tries to preserve @^>=@ version ranges under default and @transformCaretUpper@ semantics. --- Slighly simplifying, 'normalizeVersionRange' shouldn't destroy @^>=@ in version range expressions. -newtype VersionIntervals = VersionIntervals [VersionInterval] - deriving (Eq, Show) - --- | Version interval. --- --- Invariants: --- --- * Interval is non-empty --- * 'MB' is between 'LB' and 'UB'. -data VersionInterval = VI !LB !MB !UB - deriving (Eq, Show) - --- | Lower bound. For intervals it always exist: 'zeroLB' i.e. @>= 0@. --- --- All lower bound intervals are inclusive, i.e. @>=v@. @>x.y.z@ is converted into @>=x.y.z.0@. -newtype LB = LB Version - deriving (Eq, Ord, Show) - --- | Upper bound. --- --- All upper bounds are exclusive, i.e. @=@ or @<=@ - Incl - | -- | exclusive: @>@ or @<@ - Excl - deriving (Eq, Ord, Show) - --- | Middle bound. -data MB - = -- | major bound. - MB !Version - | -- | no major bound (i.e. infinite) - NoMB - deriving (Eq, Ord, Show) - --- | @>=0@ -zeroLB :: LB -zeroLB = LB version0 - --- | Whether the version is @0@. -isVersion0 :: Version -> Bool -isVersion0 = (==) version0 - --- | Versions are not separated type. -succVersion :: Version -> Version -succVersion v = mkVersion (versionNumbers v ++ [0]) - -------------------------------------------------------------------------------- --- Stage1 -------------------------------------------------------------------------------- - -stage1 :: ([VersionInterval] -> [VersionInterval]) -> VersionRange -> [VersionInterval] -stage1 opt = cataVersionRange alg - where - -- version range leafs transform into singleton intervals - alg (ThisVersionF v) = [VI (LB v) (MB (succVersion v)) (UB (succVersion v))] - alg (LaterVersionF v) = [VI (LB (succVersion v)) NoMB NoUB] - alg (OrLaterVersionF v) = [VI (LB v) NoMB NoUB] - alg (EarlierVersionF v) - | isVersion0 v = [] - | otherwise = [VI zeroLB (MB v) (UB v)] - alg (OrEarlierVersionF v) = [VI zeroLB (MB (succVersion v)) (UB (succVersion v))] - -- \^>= version-range's upper bound should be MajorBound - alg (MajorBoundVersionF v) = [VI (LB v) (MB (majorUpperBound v)) NoUB] - -- union: just merge the version intervals - alg (UnionVersionRangesF v1 v2) = v1 ++ v2 - -- intersection: pairwise intersect. Strip empty intervals. Sort to restore the invariant. - alg (IntersectVersionRangesF v1 v2) = catMaybes $ intersectInterval <$> opt v1 <*> opt v2 - -------------------------------------------------------------------------------- --- Stage2 -------------------------------------------------------------------------------- - -stage2 :: [VersionInterval] -> [VersionInterval] -stage2 = sortOn (\(VI l _ _) -> l) - -------------------------------------------------------------------------------- --- Postprocess -------------------------------------------------------------------------------- - -stage2and3 :: [VersionInterval] -> [VersionInterval] -stage2and3 = stage3 . stage2 - -stage3 :: [VersionInterval] -> [VersionInterval] -stage3 [] = [] -stage3 (VI l m u : rest) = stage3go l m u rest - -stage3go :: LB -> MB -> UB -> [VersionInterval] -> [VersionInterval] -stage3go l m u [] = [VI l m u] -stage3go l m u (VI l' m' u' : is) - | l == l' = stage3go l' (unionMB m m') (unionUB u u') is - | otherwise = case overlap m u l' of - NoOverlap -> VI l m u : stage3go l' m' u' is - OverlapU -> viCons (VI l m (trimLB u l')) (stage3go l' m' (unionUB u u') is) - OverlapM -> stage3go l (unionMB m m') (unionUB u u') is - where - viCons :: VersionInterval -> [VersionInterval] -> [VersionInterval] - viCons i | nonEmptyVI i = (i :) - viCons _ = id - -trimLB :: UB -> LB -> UB -trimLB _ (LB l) = UB l - -------------------------------------------------------------------------------- --- Intersections -------------------------------------------------------------------------------- - -intersectInterval :: VersionInterval -> VersionInterval -> Maybe VersionInterval -intersectInterval (VI xl xm xu) (VI yl ym yu) - | nonEmptyVI xy = Just xy - | otherwise = Nothing - where - l = intersectLB xl yl - m = intersectMB xm ym - u = intersectUB xu yu - - -- make middle bound be between l and u - m' = rtrimMB (ltrimMB l m) u - - xy = VI l m' u - -ltrimMB :: LB -> MB -> MB -ltrimMB _ NoMB = NoMB -ltrimMB (LB l) (MB m) = case compare l m of - LT -> MB m - EQ -> MB m - GT -> MB l - -rtrimMB :: MB -> UB -> MB -rtrimMB m NoUB = m -rtrimMB NoMB (UB u) = MB u -rtrimMB (MB m) (UB u) = MB (min m u) - -intersectLB :: LB -> LB -> LB -intersectLB (LB v) (LB u) = LB (max v u) - -intersectMB :: MB -> MB -> MB -intersectMB NoMB b = b -intersectMB b NoMB = b -intersectMB (MB v) (MB u) = MB (min v u) - -intersectUB :: UB -> UB -> UB -intersectUB NoUB b = b -intersectUB b NoUB = b -intersectUB (UB v) (UB u) = UB (min v u) - -intersectMBandUB :: MB -> UB -> UB -intersectMBandUB NoMB b = b -intersectMBandUB (MB v) NoUB = UB v -intersectMBandUB (MB v) (UB u) = UB (min v u) - -------------------------------------------------------------------------------- --- Unions -------------------------------------------------------------------------------- - -unionMB :: MB -> MB -> MB -unionMB NoMB _ = NoMB -unionMB _ NoMB = NoMB -unionMB (MB v) (MB u) = MB (max v u) - -unionUB :: UB -> UB -> UB -unionUB NoUB _ = NoUB -unionUB _ NoUB = NoUB -unionUB (UB v) (UB u) = UB (max v u) - -------------------------------------------------------------------------------- --- Helpers -------------------------------------------------------------------------------- - --- | Overlaps. -data Overlap - = -- | no overlap, next interval's @l@ is greater than @u@ - NoOverlap - | -- | overlaps, next interval's @l@ is less than @m@ - OverlapM - | -- | overlaps, next interval's @l@ is less than @u@ (but greater than @m@) - OverlapU - deriving (Eq, Show) - -overlap :: MB -> UB -> LB -> Overlap -overlap _ (UB u) (LB l) | u < l = NoOverlap -overlap (MB m) _ (LB l) | m < l = OverlapU -overlap _ _ _ = OverlapM - -------------------------------------------------------------------------------- --- Invariants -------------------------------------------------------------------------------- - --- | 'VersionIntervals' invariant: --- --- * all intervals are valid (lower bound is less then upper bound, middle bound is in between) --- * intervals doesn't touch each other (distinct) -validVersionIntervals :: VersionIntervals -> Bool -validVersionIntervals (VersionIntervals intervals) = - all validVersionInterval intervals - && all doesNotTouch' (pairs intervals) - where - doesNotTouch' :: (VersionInterval, VersionInterval) -> Bool - doesNotTouch' (VI l m u, VI l' _ _) = - l < l' && case overlap m u l' of - NoOverlap -> True - OverlapM -> False - OverlapU -> case u of - NoUB -> True - UB uv -> case l' of LB lv -> uv == lv - -pairs :: [a] -> [(a, a)] -pairs xs = zip xs (drop 1 xs) - -validLB :: LB -> Bool -validLB (LB v) = validVersion v - -validUB :: UB -> Bool -validUB NoUB = True -validUB (UB v) = validVersion v - -validMB :: MB -> Bool -validMB NoMB = True -validMB (MB v) = validVersion v - -validVersionInterval :: VersionInterval -> Bool -validVersionInterval i@(VI l m u) = validLB l && validMB m && validUB u && nonEmptyVI i && lbLessThanMB l m && mbLessThanUB m u - -mbLessThanUB :: MB -> UB -> Bool -mbLessThanUB (MB m) (UB u) = m <= u -mbLessThanUB NoMB (UB _) = False -mbLessThanUB _ NoUB = True - -lbLessThanMB :: LB -> MB -> Bool -lbLessThanMB _ NoMB = True -lbLessThanMB (LB l) (MB m) = l <= m - --- Check an interval is non-empty --- -nonEmptyVI :: VersionInterval -> Bool -nonEmptyVI (VI (LB _) _ NoUB) = True -nonEmptyVI (VI (LB l) _ (UB u)) = l < u - -------------------------------------------------------------------------------- --- Conversions -------------------------------------------------------------------------------- - --- | Convert a 'VersionRange' to a sequence of version intervals. -toVersionIntervals :: VersionRange -> VersionIntervals -toVersionIntervals = VersionIntervals . stage2and3 . stage1 stage2and3 - -data ConversionProblem - = IntervalsEmpty - | OtherConversionProblem - deriving (Eq, Show) - --- | Convert a 'VersionIntervals' value back into a 'VersionRange' expression --- representing the version intervals. -fromVersionIntervals :: VersionIntervals -> Either ConversionProblem VersionRange -fromVersionIntervals (VersionIntervals []) = Right noVersion -fromVersionIntervals (VersionIntervals (x : xs)) = - case join <$> traverse intervalToVersionRange (preprocess x xs) of - Just vrs -> Right (foldr1 unionVersionRanges vrs) - Nothing -> - Left $ - if all seemsEmpty (x : xs) - then IntervalsEmpty - else OtherConversionProblem - where - -- we can remove upper bounds, if they touch next interval, and the next interval doesn't have upper bound - preprocess :: VersionInterval -> [VersionInterval] -> NonEmpty VersionInterval - preprocess i [] = i :| [] - preprocess i@(VI l m u) (j : js) = case u' of - NoUB | touchesUB u l' -> cons (VI l m NoUB) js' - _ -> cons i js' - where - js'@(VI l' _ u' :| _) = preprocess j js - - seemsEmpty :: VersionInterval -> Bool - seemsEmpty (VI l m u) = not (nonEmptyVI (VI l NoMB (intersectMBandUB m u))) - -touchesUB :: UB -> LB -> Bool -touchesUB NoUB _ = True -touchesUB (UB u) (LB l) = u >= l - -lbToVR :: LB -> VersionRange -lbToVR (LB l) = orLaterVersion l - -ubToVR :: UB -> VersionRange -> VersionRange -ubToVR NoUB vr = vr -ubToVR (UB u) vr = intersectVersionRanges vr (earlierVersion u) - -mbEqUB :: MB -> UB -> Bool -mbEqUB NoMB NoUB = True -mbEqUB NoMB (UB _) = False -mbEqUB (MB m) (UB u) = m == u -mbEqUB (MB _) NoUB = False - --- return the unions of version ranges. -intervalToVersionRange :: VersionInterval -> Maybe (NonEmpty VersionRange) -intervalToVersionRange (VI l m u) | mbEqUB m u = Just (singleton (intervalToVersionRange1 l u)) -intervalToVersionRange (VI l m u) = fmap (fmap (ubToVR u)) (intervalToVersionRange2 l m) - -intervalToVersionRange1 :: LB -> UB -> VersionRange -intervalToVersionRange1 (LB v) upper' = case upper' of - NoUB -> - lowerBound - UB u - | succVersion v == u -> - thisVersion v - UB u -> withLowerBound (makeUpperBound u) - where - lowerBound :: VersionRange - lowerBound = lbToVR (LB v) - - withLowerBound :: VersionRange -> VersionRange - withLowerBound vr - | isVersion0 v = vr - | otherwise = intersectVersionRanges lowerBound vr - - makeUpperBound :: Version -> VersionRange - makeUpperBound = earlierVersion - -intervalToVersionRange2 :: LB -> MB -> Maybe (NonEmpty VersionRange) -intervalToVersionRange2 (LB l) NoMB = Just (singleton lowerBound) - where - lowerBound :: VersionRange - lowerBound = lbToVR (LB l) -intervalToVersionRange2 (LB l) (MB m) - | supermajor l == supermajor m = - go (l :|) (majorUpperBound l) - | [a, b] <- versionNumbers m, - let m' = mkVersion [a, b - 1], - b >= 1, - m' > l = - Just $ - ubToVR (UB m') (lbToVR (LB l)) - :| [majorBoundVersion (mkVersion [a, b - 1])] - | otherwise = - Nothing - where - go :: ([Version] -> NonEmpty Version) -> Version -> Maybe (NonEmpty VersionRange) - go !acc v = case compare v m of - LT -> go (snoc acc v) (majorUpperBound v) - EQ -> Just (fmap majorBoundVersion (acc [])) - GT -> Nothing - - snoc :: ([a] -> c) -> a -> [a] -> c - snoc xs x = xs . (x :) - - supermajor :: Version -> Int - supermajor v = case versionNumbers v of - [] -> -1 - s : _ -> s - -------------------------------------------------------------------------------- --- Normalisation -------------------------------------------------------------------------------- - --- | Convert 'VersionRange' to 'VersionIntervals' and back. -normaliseVersionRange :: VersionRange -> Either ConversionProblem VersionRange -normaliseVersionRange = fromVersionIntervals . toVersionIntervals diff --git a/source/test-suite/CabalGild/Test/Golden.hs b/source/test-suite/CabalGild/Test/Golden.hs deleted file mode 100644 --- a/source/test-suite/CabalGild/Test/Golden.hs +++ /dev/null @@ -1,87 +0,0 @@ -module CabalGild.Test.Golden (tests) where - -import CabalGild (cabalGild) -import CabalGild.Monad (runCabalGild) -import CabalGild.Options (defaultOptions) -import qualified Control.Exception as Exception -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS8 -import qualified Data.Map as Map -import Distribution.Utils.Generic (toUTF8BS) -import System.FilePath ((-<.>), ()) -import Test.Tasty (TestTree, testGroup) -import qualified Test.Tasty.HUnit as HUnit - -tests :: TestTree -tests = - testGroup - "tests" - [ goldenTest' "cabal-fmt", - goldenTest' "Cabal", - goldenTest' "Cabal-notab", - goldenTest' "simple-example", - goldenTest' "tree-diff", - goldenTest' "fragment-missing", - goldenTest' "fragment-empty", - goldenTest' "fragment-wrong-field", - goldenTest' "fragment-wrong-type", - goldenTest' "fragment-multiple", - goldenTest' "fragment-section", - goldenTest' "issue69", - goldenTest' "issue29" - ] - -goldenTest' :: String -> TestTree -goldenTest' n = - testGroup - n - [ HUnit.testCase "successfully formats" $ do - input <- BS.readFile inputPath - (output, warnings) <- - either Exception.throwIO pure - . runCabalGild files defaultOptions - $ cabalGild inputPath input - expected <- readFile goldenPath - let actual = unlines (fmap ("-- " <>) warnings) <> output - actual HUnit.@?= expected, - HUnit.testCase "round trips" $ do - input <- BS.readFile inputPath - (expected, _) <- - either Exception.throwIO pure - . runCabalGild files defaultOptions - $ cabalGild inputPath input - (actual, _) <- - either Exception.throwIO pure - . runCabalGild files defaultOptions - . cabalGild inputPath - $ toUTF8BS expected - actual HUnit.@?= expected - ] - where - goldenPath = "fixtures" n -<.> "format" - inputPath = "fixtures" n -<.> "cabal" - -files :: Map.Map FilePath BS.ByteString -files = - Map.fromList - [ p "empty.fragment" "", - p - "build-depends.fragment" - "build-depends: base, doctest >=0.15 && <0.17, QuickCheck >=2.12 && <2.13, simple-example, template-haskell", - p - "tested-with.fragment" - "tested-with: GHC ==8.0.2", - p - "common.fragment" - "common deps\n build-depends: base, bytestring, containers\n ghc-options: -Wall", - p - "multiple.fragment" - "build-depends: base\nghc-options: -Wall", - p ("cbits" "header.h") "...", - p ("cbits" "source1.c") "...", - p ("cbits" "source2.c") "...", - p ("cbits" "sub" "source3.c") "..." - ] - where - p :: a -> String -> (a, BS.ByteString) - p x y = (x, BS8.pack y) diff --git a/source/test-suite/CabalGild/Test/Interval.hs b/source/test-suite/CabalGild/Test/Interval.hs deleted file mode 100644 --- a/source/test-suite/CabalGild/Test/Interval.hs +++ /dev/null @@ -1,387 +0,0 @@ -{-# OPTIONS_GHC -Wno-orphans #-} - -module CabalGild.Test.Interval where - -import Control.Monad (replicateM) -import Distribution.Parsec (eitherParsec) -import Distribution.Types.Version - ( Version, - mkVersion, - validVersion, - versionNumbers, - ) -import Distribution.Types.VersionRange - ( VersionRange, - VersionRangeF (..), - anyVersion, - earlierVersion, - intersectVersionRanges, - laterVersion, - majorBoundVersion, - notThisVersion, - orEarlierVersion, - orLaterVersion, - projectVersionRange, - thisVersion, - unionVersionRanges, - withinRange, - withinVersion, - ) -import Distribution.Version (transformCaretUpper) -import Test.QuickCheck (Arbitrary (..), (===)) -import qualified Test.QuickCheck as QC -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (testCase, (@?=)) -import Test.Tasty.QuickCheck (testProperty) -import VersionInterval - -tests :: TestTree -tests = - testGroup - "version-interval" - [ testGroup - "Validity" - [ testProperty "validVersion" validVersion, - testProperty "validVersionInterval" validVersionInterval, - testProperty "validVersionIntervals" $ \vr -> - let intervals = toVersionIntervals vr - in QC.counterexample (show intervals) $ validVersionIntervals intervals - ], - testGroup - "VersionInterval" - [ testProperty "intersect valid" $ \a b -> - let ab = intersectInterval a b - in maybe (QC.property True) (\ab' -> QC.counterexample ("intersection: " ++ show ab') $ validVersionInterval ab') ab, - testProperty "intersect complete" intersectComplete, - testProperty "intersect complete lax" intersectCompleteLax - ], - testGroup - "stage1" - [ testProperty "valid" stage1_valid, - testProperty "complete" stage1_complete, - testProperty "complete lax" stage1_complete_lax, - testProperty "valid ex1" $ - stage1_valid - (intersectVersionRanges (majorBoundVersion (mkVersion [0])) (thisVersion (mkVersion [1]))), - testProperty "valid ex2" $ - stage1_valid - (intersectVersionRanges (majorBoundVersion (mkVersion [0])) (orLaterVersion (mkVersion [1]))), - testProperty "complete ex1" $ - stage1_complete - (intersectVersionRanges (majorBoundVersion (mkVersion [0])) (thisVersion (mkVersion [6]))) - (mkVersion [6]), - testProperty "complete ex2" $ - stage1_complete - (intersectVersionRanges (majorBoundVersion (mkVersion [0])) (orLaterVersion (mkVersion [1]))), - testProperty "complete lax ex2" $ - stage1_complete_lax - (intersectVersionRanges (majorBoundVersion (mkVersion [0])) (orLaterVersion (mkVersion [1]))) - ], - testGroup - "stage2" - [ testProperty "valid" stage2_valid, - testProperty "involutive" stage2_involutive, - testProperty "complete" stage2_complete, - testProperty "complete_lax" stage2_complete_lax - ], - testGroup - "stage3" - [ testProperty "valid" stage3_valid, - testProperty "involutive" stage3_involutive, - testProperty "complete" stage3_complete, - testProperty "complete_lax" stage3_complete_lax, - testProperty "complete ex1" $ - stage3_complete - [VI (LB (mkVersion [0])) (MB (mkVersion [0])) NoUB, VI (LB (mkVersion [0, 0])) NoMB NoUB] - (mkVersion [0]), - testProperty "complete lax ex1" $ - stage3_complete_lax - [VI (LB (mkVersion [0, 0])) (MB (mkVersion [0])) (UB (mkVersion [1])), VI (LB (mkVersion [0, 0, 0])) (MB (mkVersion [1])) (UB (mkVersion [1]))] - (mkVersion [1]), - testProperty "valid ex2" $ - stage3_valid - (stage1 id (intersectVersionRanges (majorBoundVersion (mkVersion [0])) (orLaterVersion (mkVersion [1])))), - testProperty "complete ex2" $ - stage3_complete - (stage1 id (intersectVersionRanges (majorBoundVersion (mkVersion [0])) (orLaterVersion (mkVersion [1])))), - testProperty "complete lax ex2" $ - stage3_complete_lax - (stage1 id (intersectVersionRanges (majorBoundVersion (mkVersion [0])) (orLaterVersion (mkVersion [1])))), - testProperty "valid ex3" $ - stage3_valid - [VI (LB (mkVersion [0, 0])) (MB (mkVersion [0])) NoUB, VI (LB (mkVersion [0, 0])) NoMB NoUB] - ], - testGroup - "normalise" - [ normaliseExample ">=1 && <2" ">=1 && <2", - normaliseExample "^>=1" "^>=1", - normaliseExample "^>=1 || ^>=2" "^>=1 || ^>=2", - normaliseExample "^>=1.2 || ^>=1.3 || ^>=1.4" "^>=1.2 || ^>=1.3 || ^>=1.4", - normaliseExample "^>=1.2 || ^>=2.0" "^>=1.2 || ^>=2.0", - normaliseExample ">=1.2 && <1.4 || ^>=1.4 || ^>=1.5" "^>=1.2 || ^>=1.3 || ^>=1.4 || ^>=1.5", - normaliseExample ">=1.2 && <2.4 || ^>=2.4 || ^>=2.5" ">=1.2 && <2.5 || ^>=2.5", - normaliseExample "^>=1.2.0.0 || ^>=1.3.0.0 || ^>=1.4.0.0" "^>=1.2.0.0 || ^>=1.3.0.0 || ^>=1.4.0.0", - normaliseExample "==3.1.4" "==3.1.4", - normaliseExample "<3.1.4 || >3.1.4" "<3.1.4 || >=3.1.4.0", - normaliseExample "^>=1.2 && <2.0 || ^>=2.0" "^>=1.2 || ^>=2.0", - normaliseExample "^>=1.2 && <3.0 || ^>=2.0" "^>=1.2 || ^>=2.0", - normaliseExample "^>=1.2 || ^>=2.0 && <3" "^>=1.2 || ^>=2.0", - normaliseExample "(^>=1.2 || ^>=2.0) && <3" "^>=1.2 && <2.0 || ^>=2.0 && <3", - normaliseExample "(>=1.2 || >=2.0) && <3" ">=1.2 && <3", - normaliseExample "<1 || >=1.0" "<1 || >=1.0", - normaliseExample "<=1 || >=1.0" ">=0", - normaliseExample ">0 && <0.0" "<0", - normaliseExample - "^>=1.5.0.1 || ^>=1.6.0.1 || >=1.9 && <1.13" - "^>=1.5.0.1 || ^>=1.6.0.1 || ^>=1.9 || ^>=1.10 || ^>=1.11 ||^>=1.12", - cannotNormaliseExample "^>=0 && >=0.1" IntervalsEmpty, - testProperty "involutive" normaliseInvolutive, - testProperty "complete" normaliseComplete, - testProperty "complete_lax" normaliseCompleteLax, - testProperty "involutive ex1" $ - normaliseInvolutive $ - intersectVersionRanges (majorBoundVersion (mkVersion [3])) (laterVersion (mkVersion [3])) - ] - ] - -normaliseExample :: String -> String -> TestTree -normaliseExample input expected = testCase input $ do - input' <- either fail return $ eitherParsec input - expected' <- either fail return $ eitherParsec expected - - VersionInterval.normaliseVersionRange input' @?= Right expected' - -cannotNormaliseExample :: String -> ConversionProblem -> TestTree -cannotNormaliseExample input problem = testCase ("cannot " ++ input) $ do - input' <- either fail return $ eitherParsec input - - VersionInterval.normaliseVersionRange input' @?= Left problem - -------------------------------------------------------------------------------- --- Intersect -------------------------------------------------------------------------------- - -intersectComplete :: VersionInterval -> VersionInterval -> Version -> QC.Property -intersectComplete a b v = - QC.counterexample ("intersection: " ++ show (ab, inA, inB)) $ (inA && inB) === inAB - where - ab = intersectInterval a b - inA = withinInterval v a - inB = withinInterval v b - inAB = maybe False (withinInterval v) ab - -intersectCompleteLax :: VersionInterval -> VersionInterval -> Version -> QC.Property -intersectCompleteLax a b v = - QC.counterexample ("intersection: " ++ show (ab, inA, inB)) $ (inA && inB) === inAB - where - ab = intersectInterval a b - inA = withinIntervalLax v a - inB = withinIntervalLax v b - inAB = maybe False (withinIntervalLax v) ab - -------------------------------------------------------------------------------- --- Stage 1 -------------------------------------------------------------------------------- - -stage1_valid :: VersionRange -> QC.Property -stage1_valid vr = QC.counterexample ("stage1: " ++ show is) $ QC.property $ all validVersionInterval is - where - is = stage1 id vr - -stage1_complete :: VersionRange -> Version -> QC.Property -stage1_complete vr v = QC.counterexample ("stage1: " ++ show is) $ withinRange v vr === any (withinInterval v) is - where - is = stage1 id vr - -stage1_complete_lax :: VersionRange -> Version -> QC.Property -stage1_complete_lax vr v = QC.counterexample ("stage1: " ++ show is) $ withinRangeLax v vr === any (withinIntervalLax v) is - where - is = stage1 id vr - -------------------------------------------------------------------------------- --- Stage 2 -------------------------------------------------------------------------------- - -stage2_valid :: [VersionInterval] -> QC.Property -stage2_valid is' = QC.counterexample ("stage2: " ++ show is) $ QC.property $ all validVersionInterval is - where - is = stage2 is' - -stage2_involutive :: [VersionInterval] -> QC.Property -stage2_involutive is' = is1 === is2 - where - is1 = stage2 is' - is2 = stage2 is1 - -stage2_complete :: [VersionInterval] -> Version -> QC.Property -stage2_complete is' v = QC.counterexample ("stage2: " ++ show is) $ any (withinInterval v) is' === any (withinInterval v) is - where - is = stage2 is' - -stage2_complete_lax :: [VersionInterval] -> Version -> QC.Property -stage2_complete_lax is' v = QC.counterexample ("stage2: " ++ show is) $ any (withinIntervalLax v) is' === any (withinIntervalLax v) is - where - is = stage2 is' - -------------------------------------------------------------------------------- --- Stage 3 -------------------------------------------------------------------------------- - -stage3_valid :: [VersionInterval] -> QC.Property -stage3_valid is' = QC.counterexample ("stage3: " ++ show is) $ QC.property $ all validVersionInterval is - where - is = stage3 (stage2 is') - -stage3_involutive :: [VersionInterval] -> QC.Property -stage3_involutive is' = is1 === is2 - where - is1 = stage3 (stage2 is') - is2 = stage3 is1 - -stage3_complete :: [VersionInterval] -> Version -> QC.Property -stage3_complete is' v = QC.counterexample ("stage3: " ++ show is) $ any (withinInterval v) is' === any (withinInterval v) is - where - is = stage3 (stage2 is') - -stage3_complete_lax :: [VersionInterval] -> Version -> QC.Property -stage3_complete_lax is' v = QC.counterexample ("stage3: " ++ show is) $ any (withinIntervalLax v) is' === any (withinIntervalLax v) is - where - is = stage3 (stage2 is') - -------------------------------------------------------------------------------- --- Normalise -------------------------------------------------------------------------------- - -normaliseInvolutive :: VersionRange -> QC.Property -normaliseInvolutive vr = vr1 === vr2 - where - vr1 = VersionInterval.normaliseVersionRange vr - vr2 = VersionInterval.normaliseVersionRange =<< vr1 - -normaliseComplete :: VersionRange -> Version -> QC.Property -normaliseComplete vr v = case VersionInterval.normaliseVersionRange vr of - Left _ -> QC.property True - Right vr' -> QC.counterexample ("normalised: " ++ show vr') $ withinRange v vr === withinRange v vr' - -normaliseCompleteLax :: VersionRange -> Version -> QC.Property -normaliseCompleteLax vr v = case VersionInterval.normaliseVersionRange vr of - Left _ -> QC.property True - Right vr' -> QC.counterexample ("normalised: " ++ show vr') $ withinRangeLax v vr === withinRangeLax v vr' - -------------------------------------------------------------------------------- --- Predicates -------------------------------------------------------------------------------- - -withinInterval :: Version -> VersionInterval -> Bool -withinInterval v (VI l m u) = viGreater l && viLessM m && viLess u - where - viGreater (LB v') = v >= v' - - viLessM NoMB = True - viLessM (MB v') = v < v' - - viLess NoUB = True - viLess (UB v') = v < v' - -withinIntervalLax :: Version -> VersionInterval -> Bool -withinIntervalLax v (VI l _ u) = viGreater l && viLess u - where - viGreater (LB v') = v >= v' - - viLess NoUB = True - viLess (UB v') = v < v' - -withinRangeLax :: Version -> VersionRange -> Bool -withinRangeLax v vr = withinRange v (transformCaretUpper vr) - -------------------------------------------------------------------------------- --- QC instances -------------------------------------------------------------------------------- - -instance Arbitrary Version where - arbitrary = - QC.oneof - [ mkVersion <$> replicateM d vDigit - | d <- [1 .. 4] - ] - where - vDigit :: QC.Gen Int - vDigit = QC.elements [0 .. 9] - - shrink v = - [ mkVersion v' - | v' <- shrink (versionNumbers v), - not (null v') - ] - -instance Arbitrary VersionRange where - arbitrary = - let intToDouble :: Int -> Double - intToDouble = fromIntegral - in QC.sized $ genVersionRange . round . logBase 2 . intToDouble . max 1 - - shrink vr = case projectVersionRange vr of - LaterVersionF v -> laterVersion <$> shrink v - OrLaterVersionF v -> orLaterVersion <$> shrink v - EarlierVersionF v -> earlierVersion <$> shrink v - OrEarlierVersionF v -> orEarlierVersion <$> shrink v - ThisVersionF v -> thisVersion <$> shrink v - MajorBoundVersionF v -> majorBoundVersion <$> shrink v - UnionVersionRangesF l r -> l : r : fmap (uncurry unionVersionRanges) (shrink (l, r)) - IntersectVersionRangesF l r -> l : r : fmap (uncurry intersectVersionRanges) (shrink (l, r)) - -genVersionRange :: Int -> QC.Gen VersionRange -genVersionRange n - | n <= 1 = - QC.oneof - [ pure anyVersion, - thisVersion <$> arbitrary, - notThisVersion <$> arbitrary, - laterVersion <$> arbitrary, - earlierVersion <$> arbitrary, - orLaterVersion <$> arbitrary, - orEarlierVersion <$> arbitrary, - withinVersion <$> arbitrary, - majorBoundVersion <$> arbitrary - ] - | otherwise = do - l <- QC.chooseInt (1, n - 1) - let r = n - l - QC.oneof - [ unionVersionRanges <$> genVersionRange l <*> genVersionRange r, - intersectVersionRanges <$> genVersionRange l <*> genVersionRange r - ] - -instance Arbitrary VersionInterval where - arbitrary = QC.suchThat (VI <$> arbitrary <*> arbitrary <*> arbitrary) validVersionInterval - - shrink (VI l m u) = - [ vi - | (l', m', u') <- shrink (l, m, u), - let vi = VI l' m' u', - validVersionInterval vi - ] - -instance Arbitrary LB where - arbitrary = LB <$> arbitrary - shrink (LB v) = LB <$> shrink v - -instance Arbitrary UB where - arbitrary = - QC.oneof - [ pure NoUB, - UB <$> arbitrary - ] - - shrink NoUB = [] - shrink (UB v) = NoUB : map UB (shrink v) - -instance Arbitrary MB where - arbitrary = - QC.oneof - [ pure NoMB, - MB <$> arbitrary - ] - - shrink NoMB = [] - shrink (MB v) = NoMB : map MB (shrink v) diff --git a/source/test-suite/Main.hs b/source/test-suite/Main.hs --- a/source/test-suite/Main.hs +++ b/source/test-suite/Main.hs @@ -1,12 +1,844 @@ -import qualified CabalGild.Test.Golden -import qualified CabalGild.Test.Interval -import qualified Test.Tasty +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +import qualified CabalGild.Class.MonadLog as MonadLog +import qualified CabalGild.Class.MonadRead as MonadRead +import qualified CabalGild.Class.MonadWalk as MonadWalk +import qualified CabalGild.Class.MonadWrite as MonadWrite +import qualified CabalGild.Extra.String as String +import qualified CabalGild.Main as Gild +import qualified Control.Monad.Catch as Exception +import qualified Control.Monad.Trans.Class as Trans +import qualified Control.Monad.Trans.Except as ExceptT +import qualified Control.Monad.Trans.RWS as RWST +import qualified Data.ByteString as ByteString +import qualified Data.Either as Either +import qualified Data.Function as Function +import qualified Data.Functor.Identity as Identity +import qualified Data.Map as Map +import qualified GHC.Stack as Stack +import qualified System.FilePath as FilePath +import qualified Test.Hspec as Hspec + main :: IO () -main = - Test.Tasty.defaultMain $ - Test.Tasty.testGroup - "cabal-gild" - [ CabalGild.Test.Golden.tests, - CabalGild.Test.Interval.tests - ] +main = Hspec.hspec . Hspec.parallel . Hspec.describe "cabal-gild" $ do + Hspec.it "shows the help" $ do + let (a, s, w) = + runTest + (Gild.mainWith "" ["--help"]) + (Map.empty, Map.empty) + Map.empty + a `Hspec.shouldSatisfy` Either.isLeft + w `Hspec.shouldNotSatisfy` null + s `Hspec.shouldBe` Map.empty + + Hspec.it "shows the version" $ do + let (a, s, w) = + runTest + (Gild.mainWith "" ["--version"]) + (Map.empty, Map.empty) + Map.empty + a `Hspec.shouldSatisfy` Either.isLeft + w `Hspec.shouldNotSatisfy` null + s `Hspec.shouldBe` Map.empty + + Hspec.it "reads from an input file" $ do + let (a, s, w) = + runTest + (Gild.mainWith "" ["--input", "input.cabal"]) + (Map.singleton (Just "input.cabal") (String.toUtf8 ""), Map.empty) + Map.empty + a `Hspec.shouldBe` Right () + w `Hspec.shouldBe` [] + s `Hspec.shouldSatisfy` Map.member Nothing + + Hspec.it "writes to an output file" $ do + let (a, s, w) = + runTest + (Gild.mainWith "" ["--output", "output.cabal"]) + (Map.singleton Nothing (String.toUtf8 ""), Map.empty) + Map.empty + a `Hspec.shouldBe` Right () + w `Hspec.shouldBe` [] + s `Hspec.shouldSatisfy` Map.member (Just "output.cabal") + + Hspec.it "succeeds when checking formatted input" $ do + let (a, s, w) = + runTest + (Gild.mainWith "" ["--mode", "check"]) + (Map.singleton Nothing (String.toUtf8 ""), Map.empty) + Map.empty + a `Hspec.shouldBe` Right () + w `Hspec.shouldBe` [] + s `Hspec.shouldBe` Map.empty + + Hspec.it "fails when checking unformatted input" $ do + let (a, s, w) = + runTest + (Gild.mainWith "" ["--mode", "check"]) + (Map.singleton Nothing (String.toUtf8 "fail:yes"), Map.empty) + Map.empty + a `Hspec.shouldSatisfy` Either.isLeft + w `Hspec.shouldBe` [] + s `Hspec.shouldBe` Map.empty + + Hspec.it "succeeds with empty input" $ do + expectGilded + "" + "" + + Hspec.it "removes extra blank space" $ do + expectGilded + "\t\r\n \r\n" + "" + + Hspec.it "formats a comment" $ do + expectGilded + "-- c" + "-- c\n" + + Hspec.it "keeps a blank comment" $ do + expectGilded + "--" + "--\n" + + Hspec.it "formats multiple comments" $ do + expectGilded + "-- c\n-- d" + "-- c\n-- d\n" + + Hspec.it "removes blank lines between comments" $ do + expectGilded + "-- c\n\n-- d" + "-- c\n-- d\n" + + Hspec.it "does not require a space after the comment start" $ do + expectGilded + "--c" + "--c\n" + + Hspec.it "leaves leading blank space in comments" $ do + expectGilded + "--\t c" + "--\t c\n" + + Hspec.it "trims trailing blank space from comments" $ do + expectGilded + "-- c\t \n" + "-- c\n" + + Hspec.it "normalizes Windows line endings in comments" $ do + expectGilded + "-- c\r\n" + "-- c\n" + + Hspec.it "formats a field without a value" $ do + expectGilded + "f:" + "f:\n" + + Hspec.it "formats a field with a value" $ do + expectGilded + "f: 1" + "f: 1\n" + + Hspec.it "does not require spaces before a field's value" $ do + expectGilded + "f:1" + "f: 1\n" + + Hspec.it "allows spaces after a field's name" $ do + expectGilded + "f :1" + "f: 1\n" + + Hspec.it "formats multiple fields" $ do + expectGilded + "f: 1\ng: 2" + "f: 1\ng: 2\n" + + Hspec.it "formats a field with hung values" $ do + expectGilded + "f: 1\n 2" + "f:\n 1\n 2\n" + + Hspec.it "formats a field with nested values" $ do + expectGilded + "f:\n 1\n 2" + "f:\n 1\n 2\n" + + Hspec.it "puts a line after a field with multiple values" $ do + expectGilded + "f: 1\n 2\ng: 3" + "f:\n 1\n 2\n\ng: 3\n" + + Hspec.it "does not pu a line before a field with multiple values" $ do + expectGilded + "f: 1\ng: 2\n 3" + "f: 1\ng:\n 2\n 3\n" + + Hspec.it "converts field names to lowercase" $ do + expectGilded + "F: 1" + "f: 1\n" + + Hspec.it "does not convert field values to lowercase" $ do + expectGilded + "f: A" + "f: A\n" + + Hspec.it "normalizes spaces within field values" $ do + expectGilded + "f:\n a\n\n b" + "f:\n a\n b\n" + + Hspec.it "formats a section" $ do + expectGilded + "s" + "s\n" + + Hspec.it "puts a line after a section" $ do + expectGilded + "s\nf: 1" + "s\n\nf: 1\n" + + Hspec.it "puts a line before a section" $ do + expectGilded + "f: 1\ns" + "f: 1\n\ns\n" + + Hspec.it "formats a section with an argument" $ do + expectGilded + "s a" + "s a\n" + + Hspec.it "formats a section with multiple arguments" $ do + expectGilded + "s a b" + "s a b\n" + + Hspec.it "formats a section with a quoted argument" $ do + expectGilded + "s \"a\"" + "s \"a\"\n" + + Hspec.it "formats a section with an operator argument" $ do + expectGilded + "s !" + "s !\n" + + Hspec.it "converts section names to lowercase" $ do + expectGilded + "S" + "s\n" + + Hspec.it "does not convert section arguments to lowercase" $ do + expectGilded + "s A" + "s A\n" + + Hspec.it "formats nested sections" $ do + -- Note that the nested section does not have an extra blank line before + -- it. + expectGilded + "s\n t" + "s\n t\n" + + Hspec.it "formats a section with a field" $ do + expectGilded + "s\n f: 1" + "s\n f: 1\n" + + Hspec.it "formats a section with multiple fields" $ do + expectGilded + "s\n f: 1\n g: 2" + "s\n f: 1\n g: 2\n" + + Hspec.it "correctly indents a section containing a field with multiple values" $ do + expectGilded + "s\n f:\n 1\n 2" + "s\n f:\n 1\n 2\n" + + Hspec.it "formats a comment before a field" $ do + expectGilded + "-- c\nf: 1" + "-- c\nf: 1\n" + + Hspec.it "formats a comment after a field" $ do + expectGilded + "f: 1\n-- c" + "f: 1\n-- c\n" + + Hspec.it "formats a comment before a field's value" $ do + expectGilded + "f:\n -- c\n 1" + "f:\n -- c\n 1\n" + + Hspec.it "formats a comment in a field's value" $ do + expectGilded + "f:\n 1\n -- c\n 2" + "f:\n 1\n -- c\n 2\n" + + Hspec.it "formats a comment after a field's value" $ do + expectGilded + "f:\n 1\n -- c" + "f: 1\n-- c\n" + + Hspec.it "formats a comment after a field with multiple values" $ do + expectGilded + "f: 1\n 2\n-- c" + "f:\n 1\n 2\n\n-- c\n" + + Hspec.it "formats a comment before a section" $ do + expectGilded + "-- c\ns" + "-- c\ns\n" + + Hspec.it "formats a comment after a section" $ do + expectGilded + "s\n-- c" + "s\n\n-- c\n" + + Hspec.it "correctly indents a comment in a section" $ do + expectGilded + "s\n -- c\n f: 1" + "s\n -- c\n f: 1\n" + + Hspec.describe "description" $ do + -- These tests apply to other "free text" fields as well. The description + -- field is just a representative example. + + Hspec.describe "< 3.0" $ do + -- These may look surprising, but they're the expected behavior. + -- + + Hspec.it "collapses extra blank lines" $ do + expectGilded + "description:\n 1\n\n 2" + "description:\n 1\n 2\n" + + Hspec.it "trims leading blank space" $ do + expectGilded + "description:\n 1\n 2" + "description:\n 1\n 2\n" + + Hspec.describe ">= 3.0" $ do + Hspec.it "keeps one extra blank line" $ do + expectGilded + "cabal-version: 3.0\ndescription:\n 1\n\n 2" + "cabal-version: 3.0\ndescription:\n 1\n\n 2\n" + + Hspec.it "keeps two extra blank lines" $ do + -- Although Haddock will collapse these, Cabal itself keeps them. + expectGilded + "cabal-version: 3.0\ndescription:\n 1\n\n\n 2" + "cabal-version: 3.0\ndescription:\n 1\n\n\n 2\n" + + Hspec.it "indents second line past first when nested" $ do + expectGilded + "cabal-version: 3.0\ndescription:\n 1\n 2" + "cabal-version: 3.0\ndescription:\n 1\n 2\n" + + Hspec.it "indents first line past second when nested" $ do + expectGilded + "cabal-version: 3.0\ndescription:\n 1\n 2" + "cabal-version: 3.0\ndescription:\n 1\n 2\n" + + Hspec.it "does not indent first line when hung" $ do + expectGilded + "cabal-version: 3.0\ndescription: 1\n 2" + "cabal-version: 3.0\ndescription:\n 1\n 2\n" + + Hspec.it "indents second line past first when hung" $ do + expectGilded + "cabal-version: 3.0\ndescription: 1\n 2" + "cabal-version: 3.0\ndescription:\n 1\n 2\n" + + Hspec.it "indents third line (but not first) past second when hung" $ do + -- If the first line of the value is on the same line as the name, then + -- it should never be indented. + expectGilded + "cabal-version: 3.0\ndescription: 1\n 2\n 3" + "cabal-version: 3.0\ndescription:\n 1\n 2\n 3\n" + + Hspec.it "treats tabs the same as spaces" $ do + -- Yes, each tab only counts as one space. + expectGilded + "cabal-version: 3.0\ndescription:\n 1\n\t2" + "cabal-version: 3.0\ndescription:\n 1\n 2\n" + + Hspec.it "does not insert extra blank lines before comments" $ do + expectGilded + "cabal-version: 3.0\ndescription:\n -- c\n 1\n -- d\n 2" + "cabal-version: 3.0\ndescription:\n -- c\n 1\n -- d\n 2\n" + + Hspec.it "does not consider comments for indentation" $ do + expectGilded + "cabal-version: 3.0\ndescription:\n 1\n -- c\n 2" + "cabal-version: 3.0\ndescription:\n 1\n -- c\n 2\n" + + Hspec.it "properly formats conditionals" $ do + expectGilded + "if ! impl ( ghc >= 9.8 )" + "if !impl(ghc >= 9.8)\n" + + Hspec.describe "license-files" $ do + -- These tests apply to other "list" fields as well. The license-files + -- field is just a representative example. + + Hspec.it "removes duplicates" $ do + expectGilded + "license-files: f f" + "license-files: f\n" + + Hspec.it "sorts unquoted" $ do + expectGilded + "license-files: g f" + "license-files:\n f\n g\n" + + Hspec.it "sorts mixed" $ do + expectGilded + "license-files: \"g\" f" + "license-files:\n f\n g\n" + + Hspec.it "sorts quoted" $ do + expectGilded + "license-files: \"g\" \"f\"" + "license-files:\n f\n g\n" + + Hspec.it "sorts comma-separated" $ do + expectGilded + "license-files: g, f" + "license-files:\n f\n g\n" + + Hspec.it "collects comments at the top" $ do + -- This isn't ideal, but keeping comments "close" to their original + -- identifier is very difficult. + expectGilded + "license-files:\n -- c\n g\n -- d\n f" + "license-files:\n -- c\n -- d\n f\n g\n" + + Hspec.it "leaves invalid fields alone" $ do + -- This field value is valid in general. Cabal will reject it because the + -- license-files field has special rules. Perhaps the user is trying to + -- format something other than a package description. Or maybe they just + -- made a typo. Either way, we can leave it alone. + expectGilded + "license-files: , f ," + "license-files: , f ,\n" + + Hspec.it "sorts tested-with" $ do + expectGilded + "tested-with: GHC == 9.8.1 , GHC == 9.6.4" + "tested-with:\n ghc ==9.6.4\n ghc ==9.8.1\n" + + Hspec.it "sorts data-files" $ do + expectGilded + "data-files: g f" + "data-files:\n f\n g\n" + + Hspec.it "sorts extra-source-files" $ do + expectGilded + "extra-source-files: g f" + "extra-source-files:\n f\n g\n" + + Hspec.it "sorts extra-tmp-files" $ do + expectGilded + "extra-tmp-files: g f" + "extra-tmp-files:\n f\n g\n" + + Hspec.it "sorts extra-doc-files" $ do + expectGilded + "extra-doc-files: g f" + "extra-doc-files:\n f\n g\n" + + Hspec.it "sorts exposed-modules" $ do + expectGilded + "library\n exposed-modules: N M" + "library\n exposed-modules:\n M\n N\n" + + Hspec.it "sorts reexported-modules" $ do + expectGilded + "library\n reexported-modules: p:M4 as M5, M2 as M3, q:M6, M1" + "library\n reexported-modules:\n M1,\n M2 as M3,\n p:M4 as M5,\n q:M6\n" + + Hspec.it "sorts signatures" $ do + expectGilded + "library\n signatures: N M" + "library\n signatures:\n M\n N\n" + + Hspec.it "sorts build-tools" $ do + expectGilded + "library\n build-tools: q , p == 1" + "library\n build-tools:\n p ==1,\n q >=0\n" + + Hspec.it "adds a trailing comma to build-tools when possible" $ do + expectGilded + "cabal-version: 2.2\nlibrary\n build-tools: p == 1, q == 2" + "cabal-version: 2.2\n\nlibrary\n build-tools:\n p ==1,\n q ==2,\n" + + Hspec.it "does not add a trailing comma to build-tools with one element" $ do + expectGilded + "cabal-version: 2.2\nlibrary\n build-tools: p" + "cabal-version: 2.2\n\nlibrary\n build-tools: p >=0\n" + + Hspec.it "sorts build-tool-depends" $ do + expectGilded + "library\n build-tool-depends: q:d , p:c == 1" + "library\n build-tool-depends:\n p:c ==1,\n q:d\n" + + Hspec.it "sorts pkgconfig-depends" $ do + -- This unusual version range format appears to be a quirk of Cabal's + -- parser specifically for pkg-config. + expectGilded + "library\n pkgconfig-depends: q , p == 1" + "library\n pkgconfig-depends:\n p >=1 && <=1,\n q\n" + + Hspec.it "sorts frameworks" $ do + expectGilded + "library\n frameworks: b a" + "library\n frameworks:\n a\n b\n" + + Hspec.it "sorts extra-framework-dirs" $ do + expectGilded + "library\n extra-framework-dirs: e d" + "library\n extra-framework-dirs:\n d\n e\n" + + Hspec.it "sorts asm-sources" $ do + expectGilded + "library\n asm-sources: g f" + "library\n asm-sources:\n f\n g\n" + + Hspec.it "sorts cmm-sources" $ do + expectGilded + "library\n cmm-sources: g f" + "library\n cmm-sources:\n f\n g\n" + + Hspec.it "sorts c-sources" $ do + expectGilded + "library\n c-sources: g f" + "library\n c-sources:\n f\n g\n" + + Hspec.it "sorts cxx-sources" $ do + expectGilded + "library\n cxx-sources: g f" + "library\n cxx-sources:\n f\n g\n" + + Hspec.it "sorts js-sources" $ do + expectGilded + "library\n js-sources: g f" + "library\n js-sources:\n f\n g\n" + + Hspec.it "sorts other-modules" $ do + expectGilded + "library\n other-modules: N M" + "library\n other-modules:\n M\n N\n" + + Hspec.it "sorts virtual-modules" $ do + expectGilded + "library\n virtual-modules: N M" + "library\n virtual-modules:\n M\n N\n" + + Hspec.it "sorts autogen-modules" $ do + expectGilded + "library\n autogen-modules: N M" + "library\n autogen-modules:\n M\n N\n" + + Hspec.it "sorts other-languages" $ do + expectGilded + "library\n other-languages: b a" + "library\n other-languages:\n a\n b\n" + + Hspec.it "sorts default-extensions" $ do + expectGilded + "library\n default-extensions: b a" + "library\n default-extensions:\n a\n b\n" + + Hspec.it "sorts other-extensions" $ do + expectGilded + "library\n other-extensions: b a" + "library\n other-extensions:\n a\n b\n" + + Hspec.it "sorts extensions" $ do + expectGilded + "library\n extensions: b a" + "library\n extensions:\n a\n b\n" + + Hspec.it "sorts build-depends" $ do + expectGilded + "library\n build-depends: q , p == 1" + "library\n build-depends:\n p ==1,\n q\n" + + Hspec.it "adds a trailing comma to build-depends when possible" $ do + expectGilded + "cabal-version: 2.2\nlibrary\n build-depends: p == 1, q == 2" + "cabal-version: 2.2\n\nlibrary\n build-depends:\n p ==1,\n q ==2,\n" + + Hspec.it "does not add a trailing comma to build-depends with one element" $ do + expectGilded + "cabal-version: 2.2\nlibrary\n build-depends: p" + "cabal-version: 2.2\n\nlibrary\n build-depends: p\n" + + Hspec.it "removes duplicate options" $ do + -- This is kind of silly because there's only one possible foreign library + -- option. + expectGilded + "foreign-library x\n options: standalone standalone" + "foreign-library x\n options: standalone\n" + + Hspec.it "does not sort hs-source-dirs" $ do + expectGilded + "library\n hs-source-dirs: b a" + "library\n hs-source-dirs:\n b\n a\n" + + Hspec.it "does not sort code-generators" $ do + expectGilded + "test-suite x\n code-generators: b, a" + "test-suite x\n code-generators:\n b,\n a\n" + + Hspec.it "adds a trailing comma to code-generators when possible" $ do + expectGilded + "cabal-version: 2.2\ntest-suite x\n code-generators: a, b" + "cabal-version: 2.2\n\ntest-suite x\n code-generators:\n a,\n b,\n" + + Hspec.it "does not add a trailing comma to code-generators with one element" $ do + expectGilded + "cabal-version: 2.2\ntest-suite x\n code-generators: a" + "cabal-version: 2.2\n\ntest-suite x\n code-generators: a\n" + + Hspec.it "does not sort cpp-options" $ do + expectGilded + "library\n cpp-options: b a" + "library\n cpp-options:\n b\n a\n" + + Hspec.it "does not sort asm-options" $ do + expectGilded + "library\n asm-options: b a" + "library\n asm-options:\n b\n a\n" + + Hspec.it "does not sort cmm-options" $ do + expectGilded + "library\n cmm-options: b a" + "library\n cmm-options:\n b\n a\n" + + Hspec.it "does not sort cc-options" $ do + expectGilded + "library\n cc-options: b a" + "library\n cc-options:\n b\n a\n" + + Hspec.it "does not sort cxx-options" $ do + expectGilded + "library\n cxx-options: b a" + "library\n cxx-options:\n b\n a\n" + + Hspec.it "does not sort ld-options" $ do + expectGilded + "library\n ld-options: b a" + "library\n ld-options:\n b\n a\n" + + Hspec.it "does not sort hsc2hs-options" $ do + expectGilded + "library\n hsc2hs-options: b a" + "library\n hsc2hs-options:\n b\n a\n" + + Hspec.it "sorts extra-libraries" $ do + expectGilded + "library\n extra-libraries: b a" + "library\n extra-libraries:\n a\n b\n" + + Hspec.it "sorts extra-libraries-static" $ do + expectGilded + "library\n extra-libraries-static: b a" + "library\n extra-libraries-static:\n a\n b\n" + + Hspec.it "sorts extra-ghci-libraries" $ do + expectGilded + "library\n extra-ghci-libraries: b a" + "library\n extra-ghci-libraries:\n a\n b\n" + + Hspec.it "sorts extra-bundled-libraries" $ do + expectGilded + "library\n extra-bundled-libraries: b a" + "library\n extra-bundled-libraries:\n a\n b\n" + + Hspec.it "sorts extra-library-flavours" $ do + expectGilded + "library\n extra-library-flavours: b a" + "library\n extra-library-flavours:\n a\n b\n" + + Hspec.it "sorts extra-dynamic-library-flavours" $ do + expectGilded + "library\n extra-dynamic-library-flavours: b a" + "library\n extra-dynamic-library-flavours:\n a\n b\n" + + Hspec.it "sorts extra-lib-dirs" $ do + expectGilded + "library\n extra-lib-dirs: g f" + "library\n extra-lib-dirs:\n f\n g\n" + + Hspec.it "sorts extra-lib-dirs-static" $ do + expectGilded + "library\n extra-lib-dirs-static: g f" + "library\n extra-lib-dirs-static:\n f\n g\n" + + Hspec.it "sorts include-dirs" $ do + expectGilded + "library\n include-dirs: g f" + "library\n include-dirs:\n f\n g\n" + + Hspec.it "sorts includes" $ do + expectGilded + "library\n includes: g f" + "library\n includes:\n f\n g\n" + + Hspec.it "sorts autogen-includes" $ do + expectGilded + "library\n autogen-includes: g f" + "library\n autogen-includes:\n f\n g\n" + + Hspec.it "sorts install-includes" $ do + expectGilded + "library\n install-includes: g f" + "library\n install-includes:\n f\n g\n" + + Hspec.it "sorts mixins" $ do + expectGilded + "library\n mixins: q (M, N as O), p" + "library\n mixins:\n p,\n q (M, N as O)\n" + + Hspec.it "does not sort ghc-options" $ do + expectGilded + "library\n ghc-options: b a" + "library\n ghc-options:\n b\n a\n" + + Hspec.it "does not sort ghcjs-options" $ do + expectGilded + "library\n ghcjs-options: b a" + "library\n ghcjs-options:\n b\n a\n" + + Hspec.it "does not sort ghc-prof-options" $ do + expectGilded + "library\n ghc-prof-options: b a" + "library\n ghc-prof-options:\n b\n a\n" + + Hspec.it "does not sort ghcjs-prof-options" $ do + expectGilded + "library\n ghcjs-prof-options: b a" + "library\n ghcjs-prof-options:\n b\n a\n" + + Hspec.it "does not sort ghc-shared-options" $ do + expectGilded + "library\n ghc-shared-options: b a" + "library\n ghc-shared-options:\n b\n a\n" + + Hspec.it "does not sort ghcjs-shared-options" $ do + expectGilded + "library\n ghcjs-shared-options: b a" + "library\n ghcjs-shared-options:\n b\n a\n" + + Hspec.it "sorts setup-depends" $ do + expectGilded + "custom-setup\n setup-depends: b, a" + "custom-setup\n setup-depends:\n a,\n b\n" + + Hspec.it "discovers an exposed module" $ do + let (a, s, w) = + runTest + (Gild.mainWith "" []) + ( Map.singleton Nothing (String.toUtf8 "library\n -- cabal-gild: discover .\n exposed-modules:"), + Map.singleton (FilePath.combine "." ".") ["M.hs"] + ) + Map.empty + a `Hspec.shouldBe` Right () + w `Hspec.shouldBe` [] + s `Hspec.shouldBe` Map.singleton Nothing (String.toUtf8 "library\n -- cabal-gild: discover .\n exposed-modules: M\n") + + Hspec.it "discovers an other module" $ do + let (a, s, w) = + runTest + (Gild.mainWith "" []) + ( Map.singleton Nothing (String.toUtf8 "library\n -- cabal-gild: discover .\n other-modules:"), + Map.singleton (FilePath.combine "." ".") ["M.hs"] + ) + Map.empty + a `Hspec.shouldBe` Right () + w `Hspec.shouldBe` [] + s `Hspec.shouldBe` Map.singleton Nothing (String.toUtf8 "library\n -- cabal-gild: discover .\n other-modules: M\n") + +expectGilded :: (Stack.HasCallStack) => String -> String -> Hspec.Expectation +expectGilded input expected = do + let (a, s, w) = + runTest + (Gild.mainWith "" []) + (Map.singleton Nothing (String.toUtf8 input), Map.empty) + Map.empty + a `Hspec.shouldBe` Right () + w `Hspec.shouldBe` [] + actual <- case Map.toList s of + [(Nothing, x)] -> pure x + _ -> fail $ "impossible: " <> show s + actual `Hspec.shouldBe` String.toUtf8 expected + -- After formatting, the output should not change if we format it again. + expectStable actual + +expectStable :: (Stack.HasCallStack) => ByteString.ByteString -> Hspec.Expectation +expectStable input = do + let (a, s, w) = + runTest + (Gild.mainWith "" []) + (Map.singleton Nothing input, Map.empty) + Map.empty + a `Hspec.shouldBe` Right () + w `Hspec.shouldBe` [] + output <- case Map.toList s of + [(Nothing, x)] -> pure x + _ -> fail $ "impossible: " <> show s + output `Hspec.shouldBe` input + +newtype Problem = Problem + { unProblem :: Exception.SomeException + } + deriving (Show) + +instance Eq Problem where + (==) = Function.on (==) show + +type Test = TestT Identity.Identity + +runTest :: Test a -> R -> S -> (Either E a, S, W) +runTest t r = Identity.runIdentity . RWST.runRWST (ExceptT.runExceptT $ runTestT t) r + +type E = Problem + +type R = (S, Map.Map FilePath [FilePath]) + +type S = Map.Map (Maybe FilePath) ByteString.ByteString + +type W = [String] + +newtype TestT m a = TestT + { runTestT :: ExceptT.ExceptT E (RWST.RWST R W S m) a + } + deriving (Applicative, Functor, Monad) + +instance (Monad m) => MonadLog.MonadLog (TestT m) where + log = TestT . Trans.lift . RWST.tell . pure + +instance (Monad m) => MonadRead.MonadRead (TestT m) where + read k = do + m <- TestT . Trans.lift . RWST.asks $ Map.lookup k . fst + case m of + Nothing -> Exception.throwM . userError $ "read " <> show k + Just x -> pure x + +instance (Monad m) => Exception.MonadThrow (TestT m) where + throwM = TestT . ExceptT.throwE . Problem . Exception.toException + +instance (Monad m) => MonadWalk.MonadWalk (TestT m) where + walk p = do + m <- TestT . Trans.lift . RWST.asks $ Map.lookup p . snd + case m of + Nothing -> Exception.throwM . userError $ "walk " <> show p + Just x -> pure x + +instance (Monad m) => MonadWrite.MonadWrite (TestT m) where + write k = TestT . Trans.lift . RWST.modify . Map.insert k