diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,13 @@ +# Revision history for backstop + +## 1.3.0.350 -- 2019-07-11 + +* First version. Released on an unsuspecting world. + +## 1.3.0.351 -- 2019-07-14 + +* First cabal package. + +## 1.3.0.352 -- 2019-07-14 + +* Small documentation corrections. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,674 @@ + 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: + + 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. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + 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 +. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,292 @@ +# The backstop command + +The backstop command is a UNIX, Linux, and *BSD tool. Intuitively, +backstop fills in the missing objects or holes that exist in the +target directory relative to the source directories thereby creating a +merged view of the target and source directories. De-backstop undoes +this. See "backstop -m" for a manual page or the +[homepage](https://github.com/mdgabriel/backstop.git) for more +information. + +The command backstop was created over twenty years ago to manage +development environement toolchains in which part of the project was +under source control and part of the project was not, e.g. binaries. +It was inspired by lndir, graft, and "Source Control to Project +Control: Applying RCS and SCCS" by Don Bolinger and Tan Bronson. +Techniques have changed with time, but backstop is a robust tool +with an extensive test suite that runs around 2700 tests, a +combination of HUnit, QuickCheck, and black box tests. + +In the author's obviously biased veiw, backstop has pedagogical +value. The module Backstop uses a ReaderT monad transformer to +manage an Environment passed to it via the command line, a StateT +monad transformer to keep track of a set of counters and to keep track +of the status of direcotry content while backstopping or +de-backstopping. The last two are Monoids. With this structure, +the handling of a dry-run for backstop or de-backstop is rather +powerful even it is a bit subtle (obscure) to understand. + +On a personal note, the author truly began to appreciate Haskell after +creating the Backstop module and its test suite and has not stopped +appreciating Haskell since. + +# The backstop manual page + +```backstop(1) User Commands backstop(1) + +NAME + backstop - Backstop a target directory by source directories + +SYNOPSIS + backstop [-nprt] [-a|-d] trgdir srcdir [srcdir ...] + backstop -h + backstop -l + backstop -m + backstop -v + backstop -y + +AVAILABILITY + Marcus D. Gabriel (c)1999-2019. All rights reserved. + + marcus@gabriel.name + + License terms: GNU GPL version 3 or later (backstop -l) + +DESCRIPTION + Backstop a target directory by source directories thereby + creating a backing chain using relative symbolic links by default + or absolute symbolic links by option. If more than one source + directory is given, backstop the target directory with each + source directory in turn starting from left to right on the + command line. + + Intuitively, backstop fills in the missing objects or holes that + exist in the target directory relative to the source directories + thereby creating a merged view of the target and source + directories. + + De-backstop a target directory by its source directories. In + this case, the source directories no longer need to exist. If + more than one source directory is given, de-backstop the target + directory by the source directories. + + Symbolic links are never followed. However, the target and + source directories are canonicalized (realpath(3)) internally by + the command backstop before backstopping and de-backstoppoing. + + By default no output is displayed except possibly to STDERR. + +ALGORITHM + There must be at least two arguments or operands. The first + operand is the target directory, and the second operand and + beyond are source directories. The target and source directory + must be parallel directories, that is, neither canonicalized + (realpath(3)) directory path may be a sub-directory of the other. + If the above is not true, a usage error occurs. + + Nevertheless, pathnames are internally in reduced form such that + symbolic link names are treated literally when finding directory + names. See "cd -L" of ksh(1). In other words, components in the + pathname that are not directories but symbolic links to + directories are not resolved to their corresponding directories. + + A list of objects or names is collected under the root of the + source directory excluding the directory dot (.) and the + directory double-dot (..). If the list is empty, the algorithm + is done, otherwise the objects divide into two classes, objects + that are not directories and objects that are directories. There + are five possibilities: + + 1. The object is either dot (.) or double-dot (..) whereupon no + action is taken. + + 2. If an object of the same name as the name of the object under + the root of the source directory does not exists under the + root of the target directory, then a symbolic link, relative + or absolute as required, is created under the root of the + target directory to the object under the root of the source + directory. If populating (-p) and the object under the root + of the source directory is a directory, then a sub-directory + is created instead. + + 3. If an object of the same name as the name of the object under + the root of the source directory does exists under the root of + the target directory and is a file, no action is taken, + regardless of whether or not the object under the root of the + source directory is a file or a directory. + + 4. If an object of the same name as the name of the object under + the root of the source directory does exists under the root of + the target directory and is a directory, and if the object of + the same name under the root of the source directory is a + file, no action is taken. + + 5. If an object of the same name as the name of the object under + the root of the source directory does exists under the root of + the target directory and is a directory, and if the object of + the same name under the root of the source directory is also a + directory, then recursion occurs with the objects of the same + name under the roots of the target and source directories as + new root target and source directories, respectively. + + When de-backstopping a target directory by source directories, + the sources no longer need to exist. Symbolic links under the + target are removed if and only if they point to a pahtname under + one of the source directories. This can be determined even if + the source directory no longer exists because symbolic links + within directory pathnames are taken literally. See "cd -L" of + ksh(1). + + When de-populating while de-backstopping (-pd), a directory is + removed if all objects within the directory are symbolic links + that have been remove while de-backstopping. An empty directory + is removed if and only if there exists a corresponding directory + path under one of the source directories as under the target + directory. This can only be determined if the source directory + and correponding sub-directory still exist. If not, then no + action is taken. + +OPTIONS + The following options are supported: + + -a Create symbolic links which are absolute paths. + + -d De-backstop the target directory by its source directories. + The -a option has no affect on the -d option. + + -h Display a short command summary. + + -l Display the backstop license terms. + + -m Display this internal manual page. + + -n Take no action but trace possible program execution. The -n + option implies the -t option. + + -p Populate the target by making equivalent sub-directories of + the source sub-directories instead of symbolic links for these + sub-directories that point back into the sources. For + example, if the target directory is empty, then for a set of + source directories, from left to right on the command line, + this creates a combined directory structure of the sources + under the target directory in which all non-directories are + symbolic links pointing back into the source directories. + This is similar to the lndir(1) command of the X consortium. + + With the -d option, all sub-directories emptied of symbolic + links under the target directory are removed, and all empty + directories are removed if and only if the correspoding + sub-directory under the source directory exists. + + -r Report the number of symbolic links and directories created, + the number of calls and maximum depth of backstop, the + maximum breadth observed by backstop, and the number of non- + fatal errors encountered. With the -d option, show the + number of symbolic links and directories removed. + + -t Show the trace of program execution. The output is a list + of executable commands. + + -v The version of backstop. + + -y A synopsis of the internal manual page. + +OPERANDS + trgdir + The directory that will be backed by other directories. The + target directory can be backed by multiple source directories + where each source directory could be backed by yet another + directory or multiple directories thereby creating an + extensible backing chain. + + srcdir + The directory which backs a target directory. The source + directory can be backed by multiple additional directories + where each additional directory could be backed by yet another + directory or multiple directories thereby creating an + extensible backing chain. + +USAGE NOTES + Evolved with ghc 6.10, 6.12, 7.0, 7.4, 7.10, 8.0.2, and 8.4.1. + Tested with 8.4.1. + +EXAMPLES + To display a summary of usage, use + + backstop -h + + To display a synopsis of this internal manual page, use + + backstop -y + + To display this internal manual page, use + + backstop -m + + To trace program execution, use + + backstop -t /export/install/sparc/devlopment/modules \ + /export/install/sparc/modules + + To trace program execution taking no action, use + + backstop -n /export/install/sparc/devlopment/modules \ + /export/install/sparc/modules + + To back /export/install/sparc/devlopment/modules with + /export/install/sparc/modules using relative symbolic links, use + + backstop /export/install/sparc/devlopment/modules \ + /export/install/sparc/modules + + To back /export/install/sparc/devlopment/modules with + /export/install/sparc/modules using absolute symbolic links, use + + backstop -a /export/install/sparc/devlopment/modules \ + /export/install/sparc/modules + + To stop backing /export/install/sparc/devlopment/modules with + /export/install/sparc/modules, use + + backstop -d /export/install/sparc/devlopment/modules \ + /export/install/sparc/modules + +ENVIRONMENT VARIABLES + PAGER Page the internal manual page or license terms + using "${PAGER}", otherwise print it. + +EXIT STATUS + An exit status of 0 is returned if successful, otherwise non-zero + is returned. The following error exit codes are used by + backstop: + + EXIT CODE MEANING + 251 Less than two operands. + 252 Not a directory, that is, trgdir or one or more + of the srcdir are not a directory. + 253 Not parallel directories, that is, a srcdir is + a sub-directory of trgdir or vice versa, or one + of the srcdir is a sub-directory of another + srcdir. + 254 Not yet implemented. + 255 Non-fatal errors occurred. Error messages are + sent to STDERR for each non-fatal error that + occurred with return code equal to the number of + non-falal errors if less than 251, otherwise the + return code is 255, that is, "infinity". + +FILES + N/A. + +SEE ALSO + ln(1), mkdir(1), rm(1), rmdir(1), ksh(1), lndir(1), realpath(3) + + "Source Control to Project Control: Applying RCS and SCCS" by Don + Bolinger and Tan Bronson. ISBN 1-56592-117-8. + +NOTES + Please send bug reports to https://github.com/mdgabriel/backstop/issues. + +BUGS + No known bugs to date. +``` diff --git a/backstop.cabal b/backstop.cabal new file mode 100644 --- /dev/null +++ b/backstop.cabal @@ -0,0 +1,78 @@ +cabal-version: 2.4 +name: backstop +version: 1.3.0.352 +license: GPL-3.0-only +license-file: LICENSE +copyright: All rights reserved (c)1999-2019. +maintainer: marcus@gabriel.name +author: Marcus D. Gabriel +homepage: https://github.com/mdgabriel/backstop.git +bug-reports: https://github.com/mdgabriel/backstop/issues +synopsis: Backstop a target directory by source directories +description: + The backstop command is a UNIX, Linux, and *BSD tool. Intuitively, + backstop fills in the missing objects or holes that exist in the + target directory relative to the source directories thereby + creating a merged view of the target and source directories. + De-backstop undoes this. See "backstop -m" for a manual page + or the [homepage](https://github.com/mdgabriel/backstop.git) + for more information. +category: program, development, library +extra-source-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/mdgabriel/backstop.git + tag: 1.3.0.351 + +library + exposed-modules: + Backstop + Environment + License + Manual + Utils + hs-source-dirs: src + default-language: Haskell2010 + build-depends: + base >=4.12.0.0 && <4.13, + directory >=1.3.3.0 && <1.4, + filepath >=1.4.2.1 && <1.5, + mtl >=2.2.2 && <2.3, + process >=1.6.5.0 && <1.7, + unix >=2.7.2.2 && <2.8 + +executable backstop + main-is: Main.hs + hs-source-dirs: src + other-modules: + Backstop + Environment + License + Manual + Utils + default-language: Haskell2010 + build-depends: + base >=4.12.0.0 && <4.13, + directory >=1.3.3.0 && <1.4, + filepath >=1.4.2.1 && <1.5, + mtl >=2.2.2 && <2.3, + process >=1.6.5.0 && <1.7, + unix >=2.7.2.2 && <2.8 + +test-suite run-tests + type: exitcode-stdio-1.0 + main-is: RunTests.hs + hs-source-dirs: src tests + other-modules: + Utils + default-language: Haskell2010 + build-depends: + base ==4.*, + HUnit >=1.6.0.0 && <1.7, + QuickCheck >=2.13.2 && <2.14, + filepath >=1.4.2.1 && <1.5, + process >=1.6.5.0 && <1.7, + unix >=2.7.2.2 && <2.8 diff --git a/src/Backstop.hs b/src/Backstop.hs new file mode 100644 --- /dev/null +++ b/src/Backstop.hs @@ -0,0 +1,407 @@ +{-# LANGUAGE FlexibleContexts #-} +module Backstop (backstop) where + +import Control.Applicative ((<$>)) +import Control.Exception (try) +import Control.Monad.Reader (ask,ReaderT,runReaderT,withReaderT) +import Control.Monad.State.Strict (put,lift,when,evalStateT,get,StateT,runStateT,filterM) +import Control.Monad.Trans (liftIO) +import Data.List ((\\),sort,delete) +import Data.Monoid --(Monoid(..)) +import Environment (Environment(..),defaultEnv) +import System.Exit (exitWith,ExitCode(..)) +import System.FilePath ((),isAbsolute) +import System.Directory (createDirectory,removeDirectory,removeFile,getDirectoryContents) +import System.IO (stderr,hPutStrLn) +import System.IO.Error hiding (try) +import System.Posix.Files (readSymbolicLink,isDirectory,isSymbolicLink,createSymbolicLink,getSymbolicLinkStatus) +import Utils (aDirectory,compElems,absoluteLink,relativeLink,subdirectory,dot,dotdot,anObject) + + +-- Section 0: The interface to Main.runWith: Backstop.backstop ---------------------- + +-- | 'backstop' the 'Environment' reporting a summary if requested, +-- any errors, and a return code. The return code is either 0 for +-- success, the number of errors, or 255 for infinity. + +backstop :: Environment -> IO () +backstop e = + do bs <- runReaderT (if deBackstop e then _unbackstop else _backstop) e + when (report e) $ putBackstop bs + exitWith $ if errs bs > 0 + then ExitFailure (if errs bs < 251 then errs bs else 255) + else ExitSuccess + + +-- Section 1 ------------------------------------------------------------------------ + +data Backstop = + BS { calls :: Int -- ^ Number of calls to 'backstop' + , depth :: Int -- ^ Depth of recursion of 'backstop' + , breadth :: Int -- ^ Breadth for the given call to and depth of 'backstop' + , symlinks :: Int -- ^ Number of symlinks created or removed + , dirs :: Int -- ^ Number of directories created or removed + , errs :: Int -- ^ Number of non-fatal IO errors that occurred + } deriving Eq + +instance Semigroup Backstop where + bs1 <> bs2 = let add f = f bs1 + f bs2 + biggest f = max (f bs1) (f bs2) + in BS (add calls) + (add depth) + (biggest breadth) + (add symlinks) + (add dirs) + (add errs) + +instance Monoid Backstop where +-- Because of the use of biggest below, this instance of mempty is +-- only an identity of a monoid for all Int >= 0. This is the case in +-- the Backstop module. The monoid laws do not hold for Int < 0. + mempty = BS 0 0 0 0 0 0 + +-- | Put to STDERR the 'Backstop' results 'symlinks', 'dirs', 'calls', +-- 'depth', 'breadth', and 'errs'. + +putBackstop :: Backstop -> IO () +putBackstop bs = + hPutStrLn stderr ("Symlinks: " ++ (justify 5.show.symlinks) bs ++ "; " ++ + "Dirs: " ++ (justify 4.show.dirs) bs ++ "; " ++ + "Calls: " ++ (justify 4.show.calls) bs ++ "; " ++ + "Depth: " ++ (justify 4.show.depth) bs ++ "; " ++ + "Breadth: " ++ (justify 3.show.breadth) bs ++ "; " ++ + "Errs: " ++ (justify 3.show.errs) bs + ) + where + justify w s = let l = length s in (if l < w then (replicate (w-l) ' ' ++) else id) s + + +-- Section 2 ------------------------------------------------------------------------ + +-- | '_backstop' the 'Environment' keeping track of the 'Backstop' results. + +_backstop :: ReaderT Environment IO Backstop +_backstop = + do e <- ask + if (length.operands) e < 2 + then return oneCall + else do bs1 <- __backstop + bs2 <- withReaderT nextSource _backstop + return (bs1 `mappend` bs2) + where + __backstop = + do e <- ask + let t = operands e !! 0 + let s = operands e !! 1 + (bs1, ts) <- listDirectoryContents t + (bs2, ss) <- listDirectoryContents s + let (ps12, _, ps2) = compElems ts ss + bs3 <- createObjects ps2 + ds <- listDirectories (ps12++ps2) + bs4 <- mconcat <$> mapM (\d -> withReaderT (nextDepth d) __backstop) ds + (return.mconcat) [bs4, bs3, bs2, bs1, oneCall, if null ds then mempty else oneDepth] + +-- | Given an 'Environment' and a list of pathnames @ps@, create the +-- objects which are links from the target to the source or +-- directories as required yielding the 'Backstop' result. + +createObjects :: [FilePath] -> ReaderT Environment IO Backstop +createObjects = fmap mconcat . mapM createObject + +-- | 'createObject' attempts to create a symbolic link or directory +-- given an 'Environment' and a basename pathname @p@ yielding +-- the 'Backstop' result. + +createObject :: FilePath -> ReaderT Environment IO Backstop +createObject p = + do e <- ask + if (length.operands) e < 2 then return mempty else _createObject p + where + prt p t s = liftIO $ putStr $ if p + then "mkdir " ++ "\"" ++ t ++ "\"\n" + else "ln -s " ++ "\"" ++ s ++ "\" " ++ "\"" ++ t ++ "\"\n" + _createObject p = + do e <- ask + let d = pwd e + let t = (operands e !! 0) p + let s = (operands e !! 1) p + let s_ = (if absolute e then absoluteLink else relativeLink) d t s + p <- liftIO $ fmap (populate e &&) (aDirectory s) + let one = if p then oneDir else oneSymlink + when (trace e) $ prt p t s_ + if noAction e + then return one + else do (bs, _) <- tryOperation $ if p + then createDirectory t + else createSymbolicLink s_ t + return $ if bs /= mempty then bs else one + + +-- Section 3 ------------------------------------------------------------------------ + +data DirectoryContentStatus = Occupied -- ^ Directory occupied with remaining content after '__unbackstop' + | Emptied -- ^ Directory was emptied by '__unbackstop' + | Empty -- ^ Directory was empty when viewed by '__unbackstop' + deriving Eq + +instance Semigroup DirectoryContentStatus where + dcs1 <> dcs2 = case (dcs1, dcs2) of + (Occupied, _) -> Occupied + (_, Occupied) -> Occupied + (Empty, _) -> Empty + (_, Empty) -> Empty + (_,_) -> Emptied + +instance Monoid DirectoryContentStatus where + mempty = Emptied + +type DCS = DirectoryContentStatus -- Short version + +-- | '_unbackstop' the 'Environment' keeping track of the 'Backstop' results. + +_unbackstop :: ReaderT Environment IO Backstop +_unbackstop = + do e <- ask + if (length.operands) e < 2 + then return oneCall + else do -- Emptied when "empty" directory, otherwise Empty or set Occupied + bs1 <- evalStateT __unbackstop Emptied + bs2 <- withReaderT nextSource _unbackstop + return (bs1 `mappend` bs2) + where + __unbackstop :: StateT DCS (ReaderT Environment IO) Backstop + __unbackstop = + do e <- ask + let t = operands e !! 0 + (bs1, ts) <- lift $ listDirectoryContents t + ds <- lift $ listDirectories ts + let os = ts \\ ds + bs2 <- destroyObjects os + if null ds + then do put $ if symlinks bs2 /= length os then Occupied + else if null os then Empty else Emptied + (return.mconcat) [bs2, bs1, oneCall] + else do bs3 <- mconcat <$> mapM recurse ds + dcs <- get + put $ dcs `mappend` if symlinks bs2 /= length os then Occupied + else if null os then Empty else Emptied + (return.mconcat) [bs3, bs2, bs1, oneCall, oneDepth] + + recurse :: FilePath -> StateT DCS (ReaderT Environment IO) Backstop + recurse d = do s1 <- get + -- Emptied when "empty" directory, otherwise Empty or set Occupied + (bs1, s2) <- lift $ withReaderT (nextDepth d) (runStateT __unbackstop Emptied) + put s2 + bs2 <- destroyObjects [d] + s3 <- get + put (mconcat [s1, s2, s3]) + (return.mconcat) [bs2, bs1] + + {- Assume StateT monads for ms, then + + sequence ms = foldr k (return []) ms + where + k mx mxs = + StateT $ \s -> + (runState mx) s >>= \ (x, s') -> + (runStateT mxs) s' >>= \ (xs, s'') -> (x:xs, s'') + + Since mapM f xs is sequence (map f xs), it is recurse plus (dcs + <- get) in __unbackstop above via mapM (sequence) that threads + the DCS state value through __unbackstop. All put and get + calls are in encapsulated in __unbackstop and all that it calls + and only calls: destroyObjects, destroyObject, destroySymlink, + and destroyDir. For now, only destroyDir has a get and a put. + -} + +-- | Given an 'Environment' and a list of pathnames @ps@, destroy the +-- objects which are links from the target to the source or +-- directories as required yielding the 'Backstop' result. + +destroyObjects :: [FilePath] -> StateT DCS (ReaderT Environment IO) Backstop +destroyObjects = fmap mconcat . mapM destroyObject + +-- | 'destroyObject' attempts to destroy a symbolic link or directory +-- given an 'Environment' and a basename pathname @p@ yielding +-- the 'Backstop' result. + +destroyObject :: FilePath -> StateT DCS (ReaderT Environment IO) Backstop +destroyObject p = + do e <- ask + if (length.operands) e < 2 then return mempty else _destroyObject p + where + _destroyObject p = + do e <- ask + let trg = (operands e !! 0) p + (bs, fs) <- lift $ tryOperation (getSymbolicLinkStatus trg) + if bs /= mempty + then return bs + else if isSymbolicLink fs + then destroySymlink p + else if isDirectory fs + then destroyDir p + else return mempty + +-- | 'destroySymlink' attempts to destroy a symbolic link given an +-- 'Environment' and a basename pathname @p@ yielding the 'Backstop' +-- result. + +destroySymlink :: FilePath -> StateT DCS (ReaderT Environment IO) Backstop +destroySymlink p = + do e <- ask + if (length.operands) e < 2 then return mempty else _destroySymlink p + where + prt sym = liftIO $ putStr ("rm -f " ++ "\"" ++ sym ++ "\"\n") + abs d p f = (if isAbsolute f then id else (d).(p)) f + rm e sym = do when (trace e) $ prt sym + if noAction e + then return oneSymlink + else do (bs, _) <- lift $ tryOperation (removeFile sym) + return $ if bs /= mempty then bs else oneSymlink + _destroySymlink p = + do e <- ask + let cwd = pwd e + let trg = operands e !! 0 + let src = operands e !! 1 + let sym = trg p + (bs, p) <- lift $ tryOperation (readSymbolicLink sym) + if bs /= mempty + then return bs + else if not $ abs cwd trg p `subdirectory` abs cwd "" src + then return mempty + else rm e sym + +-- | Given an 'Environment', remove an empty target directory @d@ if +-- and only if the corresonding directory path exists under the source +-- directory in which case the target directory is considered to have +-- been populated by the source directory yielding the 'Backstop' +-- result. + +destroyDir :: FilePath -> StateT DCS (ReaderT Environment IO) Backstop +destroyDir p = + do e <- ask + if (length.operands) e < 2 || (not.populate) e then return mempty else _destroyDir p + where + prt dir = liftIO $ putStr ("rmdir \"" ++ dir ++"\"\n") + _destroyDir p = + do e <- ask + let trg = (operands e !! 0) p + let src = (operands e !! 1) p + sDir <- liftIO $ aDirectory src + dcs <- get + if ((dcs == Empty) && not sDir) || (dcs == Occupied) + then return mempty + else do when (trace e) $ prt trg + if noAction e + then return oneDir + else do (bs, _) <- lift $ tryOperation (removeDirectory trg) + if bs /= mempty + then do { put Occupied; return bs } + else do { put Emptied; return oneDir } + + +-- Section 4 ------------------------------------------------------------------------ + +-- | Given an 'Environment' and a pathname @p@, +-- 'listDirectoryContents' yields the sorted list @ps@ of directory +-- contents without the dot @(\".\")@ or double @(\"..\")@ directories +-- yielding the 'Backstop' result @bs@ in @(bs, ps)@. + +listDirectoryContents :: FilePath -> ReaderT Environment IO (Backstop, [FilePath]) +listDirectoryContents p = + do directory <- liftIO $ aDirectory p + if directory + then do (bs, ps) <- tryOperation (sort . delete dotdot . delete dot <$> getDirectoryContents p) + return $ if bs /= mempty then (bs, []) else (mempty{breadth = length ps}, ps) + else return (mempty, []) + +-- | 'listDirectories' of @ps@ for further backstopping by '_backstop'. + +listDirectories :: [FilePath] -> ReaderT Environment IO [FilePath] +listDirectories ps = + let dir e p = + let t = (operands e !! 0) p + s = (operands e !! 1) p + in do tDir <- aDirectory t + sDir <- aDirectory s + tObj <- anObject t + return $ if deBackstop e then tDir + else if noAction e && populate e && not tObj + then sDir else tDir && sDir + in do e <- ask + if (length.operands) e < 2 then return [] else liftIO $ filterM (dir e) ps + + +-- Section 5 ------------------------------------------------------------------------ + +-- | Given an 'Environment', 'IO.try' the operation @IO a@ yielding +-- @(Backstop, a)@. + +tryOperation :: IO a -> ReaderT Environment IO (Backstop, a) +tryOperation io = + liftIO (try io) >>= + either (\ioe -> putIOE ioe >> return (oneErr, error "N/A")) (\x -> return (mempty, x)) + +-- | Given an 'Environment', 'putIOE' prints an error message for +-- @ioe@ to STDERR. + +putIOE :: IOError -> ReaderT Environment IO () +putIOE ioe = + do e <- ask + let ln = ioeGetLocation ioe + let fn = ioeGetFileName ioe + let es = ioeGetErrorString ioe + let s = command e ++ ": " ++ ln ++ ": " ++ maybe es (++": "++es) fn + liftIO $ hPutStrLn stderr s + + +-- Section 6 ------------------------------------------------------------------------ + +-- | Return the new 'Environment' given a pathname @p@ or the original +-- 'Environment' if done. + +nextDepth :: FilePath -> Environment -> Environment +nextDepth p e = + if (length.operands) e < 2 + then e + else let t = operands e !! 0 + s = operands e !! 1 + in e{operands=[t p, s p]} + + +-- | Return the next 'Environment' to process or the original +-- 'Environment' if done. + +nextSource :: Environment -> Environment +nextSource e = + if (length.operands) e < 2 + then e + else e{operands=(head.operands) e : (tail.tail.operands) e} + + +-- Section 7 ------------------------------------------------------------------------ + +-- | Set 'calls' to one in 'mempty'. + +oneCall :: Backstop +oneCall = mempty{calls = 1} + +-- | Set 'depth' to one in 'mempty'. + +oneDepth :: Backstop +oneDepth = mempty{depth = 1} + +-- | Set 'symlinks' to one in 'mempty'. + +oneSymlink :: Backstop +oneSymlink = mempty{symlinks = 1} + +-- | Set 'dirs' to one in 'mempty'. + +oneDir :: Backstop +oneDir = mempty{dirs = 1} + +-- | Set 'errs' to one in 'mempty'. + +oneErr :: Backstop +oneErr = mempty{errs = 1} diff --git a/src/Environment.hs b/src/Environment.hs new file mode 100644 --- /dev/null +++ b/src/Environment.hs @@ -0,0 +1,48 @@ +module Environment (Environment(..),defaultEnv) where + +-- Section: environment (to be configured) +{- | +The environment contains the command name, operands, and the result of +every option at least. It may contain other items that need to be +updated. +-} +data Environment = + Env { command :: String -- ^ Program name + , pwd :: String -- ^ Present Working Directory (PWD) + , operands :: [String] -- ^ @trgdir@ @srcdir@ @[srcdir...]@ + , absolute :: Bool -- ^ @-a@, use absolute symbolic links + , deBackstop :: Bool -- ^ @-d@, de-backstop trgdir + , help :: Bool -- ^ @-h@, display help summary + , license :: Bool -- ^ @-l@, display license terms + , manual :: Bool -- ^ @-m@, display internal man page + , noAction :: Bool -- ^ @-n@, take no action but trace steps + , populate :: Bool -- ^ @-p@, populate trgdir with sub-directories + , report :: Bool -- ^ @-r@, report final statistics + , trace :: Bool -- ^ @-t@, trace steps + , version :: Bool -- ^ @-v@, display version + , synopsis :: Bool -- ^ @-y@, display manual synopsis + } deriving Show + +-- The default Environment +{- | +The defualt values, otherwise updated from the flags supplied on by +the command line options. The default program name is @backstop@. +All options flags are False or off by default. +-} +defaultEnv :: Environment +defaultEnv = + Env { command = "backstop" -- Default program name + , pwd = "" -- No PWD by default + , operands = [] -- No operands by default + , absolute = False -- False or off by default + , deBackstop = False -- False or off by default + , help = False -- False or off by default + , license = False -- False or off by default + , manual = False -- False or off by default + , noAction = False -- False or off by default + , populate = False -- False or off by default + , report = False -- False or off by default + , trace = False -- False or off by default + , synopsis = False -- False or off by default + , version = False -- False or off by default + } diff --git a/src/License.hs b/src/License.hs new file mode 100644 --- /dev/null +++ b/src/License.hs @@ -0,0 +1,691 @@ +module License(putLicense) where + +import System.Exit (exitWith) +import Utils (putOrPageStrLn) + +-- | Display the license terms (GNU GPLv3). + +putLicense :: IO () +putLicense = putOrPageStrLn gpl30License >>= exitWith + +-- | Derived from gpl-3.0.txt (GNU GENERAL PUBLIC LICENSE, Version 3, +-- 29 June 2007). + +gpl30License :: String +gpl30License = + " License terms: GNU GPL version 3 or any later version\n"++ + "\n"++ + " GNU GENERAL PUBLIC LICENSE\n"++ + " Version 3, 29 June 2007\n"++ + "\n"++ + " Copyright (C) 2007 Free Software Foundation, Inc. \n"++ + " Everyone is permitted to copy and distribute verbatim copies\n"++ + " of this license document, but changing it is not allowed.\n"++ + "\n"++ + " Preamble\n"++ + "\n"++ + " The GNU General Public License is a free, copyleft license for\n"++ + "software and other kinds of works.\n"++ + "\n"++ + " The licenses for most software and other practical works are designed\n"++ + "to take away your freedom to share and change the works. By contrast,\n"++ + "the GNU General Public License is intended to guarantee your freedom to\n"++ + "share and change all versions of a program--to make sure it remains free\n"++ + "software for all its users. We, the Free Software Foundation, use the\n"++ + "GNU General Public License for most of our software; it applies also to\n"++ + "any other work released this way by its authors. You can apply it to\n"++ + "your programs, too.\n"++ + "\n"++ + " When we speak of free software, we are referring to freedom, not\n"++ + "price. Our General Public Licenses are designed to make sure that you\n"++ + "have the freedom to distribute copies of free software (and charge for\n"++ + "them if you wish), that you receive source code or can get it if you\n"++ + "want it, that you can change the software or use pieces of it in new\n"++ + "free programs, and that you know you can do these things.\n"++ + "\n"++ + " To protect your rights, we need to prevent others from denying you\n"++ + "these rights or asking you to surrender the rights. Therefore, you have\n"++ + "certain responsibilities if you distribute copies of the software, or if\n"++ + "you modify it: responsibilities to respect the freedom of others.\n"++ + "\n"++ + " For example, if you distribute copies of such a program, whether\n"++ + "gratis or for a fee, you must pass on to the recipients the same\n"++ + "freedoms that you received. You must make sure that they, too, receive\n"++ + "or can get the source code. And you must show them these terms so they\n"++ + "know their rights.\n"++ + "\n"++ + " Developers that use the GNU GPL protect your rights with two steps:\n"++ + "(1) assert copyright on the software, and (2) offer you this License\n"++ + "giving you legal permission to copy, distribute and/or modify it.\n"++ + "\n"++ + " For the developers' and authors' protection, the GPL clearly explains\n"++ + "that there is no warranty for this free software. For both users' and\n"++ + "authors' sake, the GPL requires that modified versions be marked as\n"++ + "changed, so that their problems will not be attributed erroneously to\n"++ + "authors of previous versions.\n"++ + "\n"++ + " Some devices are designed to deny users access to install or run\n"++ + "modified versions of the software inside them, although the manufacturer\n"++ + "can do so. This is fundamentally incompatible with the aim of\n"++ + "protecting users' freedom to change the software. The systematic\n"++ + "pattern of such abuse occurs in the area of products for individuals to\n"++ + "use, which is precisely where it is most unacceptable. Therefore, we\n"++ + "have designed this version of the GPL to prohibit the practice for those\n"++ + "products. If such problems arise substantially in other domains, we\n"++ + "stand ready to extend this provision to those domains in future versions\n"++ + "of the GPL, as needed to protect the freedom of users.\n"++ + "\n"++ + " Finally, every program is threatened constantly by software patents.\n"++ + "States should not allow patents to restrict development and use of\n"++ + "software on general-purpose computers, but in those that do, we wish to\n"++ + "avoid the special danger that patents applied to a free program could\n"++ + "make it effectively proprietary. To prevent this, the GPL assures that\n"++ + "patents cannot be used to render the program non-free.\n"++ + "\n"++ + " The precise terms and conditions for copying, distribution and\n"++ + "modification follow.\n"++ + "\n"++ + " TERMS AND CONDITIONS\n"++ + "\n"++ + " 0. Definitions.\n"++ + "\n"++ + " \"This License\" refers to version 3 of the GNU General Public License.\n"++ + "\n"++ + " \"Copyright\" also means copyright-like laws that apply to other kinds of\n"++ + "works, such as semiconductor masks.\n"++ + "\n"++ + " \"The Program\" refers to any copyrightable work licensed under this\n"++ + "License. Each licensee is addressed as \"you\". \"Licensees\" and\n"++ + "\"recipients\" may be individuals or organizations.\n"++ + "\n"++ + " To \"modify\" a work means to copy from or adapt all or part of the work\n"++ + "in a fashion requiring copyright permission, other than the making of an\n"++ + "exact copy. The resulting work is called a \"modified version\" of the\n"++ + "earlier work or a work \"based on\" the earlier work.\n"++ + "\n"++ + " A \"covered work\" means either the unmodified Program or a work based\n"++ + "on the Program.\n"++ + "\n"++ + " To \"propagate\" a work means to do anything with it that, without\n"++ + "permission, would make you directly or secondarily liable for\n"++ + "infringement under applicable copyright law, except executing it on a\n"++ + "computer or modifying a private copy. Propagation includes copying,\n"++ + "distribution (with or without modification), making available to the\n"++ + "public, and in some countries other activities as well.\n"++ + "\n"++ + " To \"convey\" a work means any kind of propagation that enables other\n"++ + "parties to make or receive copies. Mere interaction with a user through\n"++ + "a computer network, with no transfer of a copy, is not conveying.\n"++ + "\n"++ + " An interactive user interface displays \"Appropriate Legal Notices\"\n"++ + "to the extent that it includes a convenient and prominently visible\n"++ + "feature that (1) displays an appropriate copyright notice, and (2)\n"++ + "tells the user that there is no warranty for the work (except to the\n"++ + "extent that warranties are provided), that licensees may convey the\n"++ + "work under this License, and how to view a copy of this License. If\n"++ + "the interface presents a list of user commands or options, such as a\n"++ + "menu, a prominent item in the list meets this criterion.\n"++ + "\n"++ + " 1. Source Code.\n"++ + "\n"++ + " The \"source code\" for a work means the preferred form of the work\n"++ + "for making modifications to it. \"Object code\" means any non-source\n"++ + "form of a work.\n"++ + "\n"++ + " A \"Standard Interface\" means an interface that either is an official\n"++ + "standard defined by a recognized standards body, or, in the case of\n"++ + "interfaces specified for a particular programming language, one that\n"++ + "is widely used among developers working in that language.\n"++ + "\n"++ + " The \"System Libraries\" of an executable work include anything, other\n"++ + "than the work as a whole, that (a) is included in the normal form of\n"++ + "packaging a Major Component, but which is not part of that Major\n"++ + "Component, and (b) serves only to enable use of the work with that\n"++ + "Major Component, or to implement a Standard Interface for which an\n"++ + "implementation is available to the public in source code form. A\n"++ + "\"Major Component\", in this context, means a major essential component\n"++ + "(kernel, window system, and so on) of the specific operating system\n"++ + "(if any) on which the executable work runs, or a compiler used to\n"++ + "produce the work, or an object code interpreter used to run it.\n"++ + "\n"++ + " The \"Corresponding Source\" for a work in object code form means all\n"++ + "the source code needed to generate, install, and (for an executable\n"++ + "work) run the object code and to modify the work, including scripts to\n"++ + "control those activities. However, it does not include the work's\n"++ + "System Libraries, or general-purpose tools or generally available free\n"++ + "programs which are used unmodified in performing those activities but\n"++ + "which are not part of the work. For example, Corresponding Source\n"++ + "includes interface definition files associated with source files for\n"++ + "the work, and the source code for shared libraries and dynamically\n"++ + "linked subprograms that the work is specifically designed to require,\n"++ + "such as by intimate data communication or control flow between those\n"++ + "subprograms and other parts of the work.\n"++ + "\n"++ + " The Corresponding Source need not include anything that users\n"++ + "can regenerate automatically from other parts of the Corresponding\n"++ + "Source.\n"++ + "\n"++ + " The Corresponding Source for a work in source code form is that\n"++ + "same work.\n"++ + "\n"++ + " 2. Basic Permissions.\n"++ + "\n"++ + " All rights granted under this License are granted for the term of\n"++ + "copyright on the Program, and are irrevocable provided the stated\n"++ + "conditions are met. This License explicitly affirms your unlimited\n"++ + "permission to run the unmodified Program. The output from running a\n"++ + "covered work is covered by this License only if the output, given its\n"++ + "content, constitutes a covered work. This License acknowledges your\n"++ + "rights of fair use or other equivalent, as provided by copyright law.\n"++ + "\n"++ + " You may make, run and propagate covered works that you do not\n"++ + "convey, without conditions so long as your license otherwise remains\n"++ + "in force. You may convey covered works to others for the sole purpose\n"++ + "of having them make modifications exclusively for you, or provide you\n"++ + "with facilities for running those works, provided that you comply with\n"++ + "the terms of this License in conveying all material for which you do\n"++ + "not control copyright. Those thus making or running the covered works\n"++ + "for you must do so exclusively on your behalf, under your direction\n"++ + "and control, on terms that prohibit them from making any copies of\n"++ + "your copyrighted material outside their relationship with you.\n"++ + "\n"++ + " Conveying under any other circumstances is permitted solely under\n"++ + "the conditions stated below. Sublicensing is not allowed; section 10\n"++ + "makes it unnecessary.\n"++ + "\n"++ + " 3. Protecting Users' Legal Rights From Anti-Circumvention Law.\n"++ + "\n"++ + " No covered work shall be deemed part of an effective technological\n"++ + "measure under any applicable law fulfilling obligations under article\n"++ + "11 of the WIPO copyright treaty adopted on 20 December 1996, or\n"++ + "similar laws prohibiting or restricting circumvention of such\n"++ + "measures.\n"++ + "\n"++ + " When you convey a covered work, you waive any legal power to forbid\n"++ + "circumvention of technological measures to the extent such circumvention\n"++ + "is effected by exercising rights under this License with respect to\n"++ + "the covered work, and you disclaim any intention to limit operation or\n"++ + "modification of the work as a means of enforcing, against the work's\n"++ + "users, your or third parties' legal rights to forbid circumvention of\n"++ + "technological measures.\n"++ + "\n"++ + " 4. Conveying Verbatim Copies.\n"++ + "\n"++ + " You may convey verbatim copies of the Program's source code as you\n"++ + "receive it, in any medium, provided that you conspicuously and\n"++ + "appropriately publish on each copy an appropriate copyright notice;\n"++ + "keep intact all notices stating that this License and any\n"++ + "non-permissive terms added in accord with section 7 apply to the code;\n"++ + "keep intact all notices of the absence of any warranty; and give all\n"++ + "recipients a copy of this License along with the Program.\n"++ + "\n"++ + " You may charge any price or no price for each copy that you convey,\n"++ + "and you may offer support or warranty protection for a fee.\n"++ + "\n"++ + " 5. Conveying Modified Source Versions.\n"++ + "\n"++ + " You may convey a work based on the Program, or the modifications to\n"++ + "produce it from the Program, in the form of source code under the\n"++ + "terms of section 4, provided that you also meet all of these conditions:\n"++ + "\n"++ + " a) The work must carry prominent notices stating that you modified\n"++ + " it, and giving a relevant date.\n"++ + "\n"++ + " b) The work must carry prominent notices stating that it is\n"++ + " released under this License and any conditions added under section\n"++ + " 7. This requirement modifies the requirement in section 4 to\n"++ + " \"keep intact all notices\".\n"++ + "\n"++ + " c) You must license the entire work, as a whole, under this\n"++ + " License to anyone who comes into possession of a copy. This\n"++ + " License will therefore apply, along with any applicable section 7\n"++ + " additional terms, to the whole of the work, and all its parts,\n"++ + " regardless of how they are packaged. This License gives no\n"++ + " permission to license the work in any other way, but it does not\n"++ + " invalidate such permission if you have separately received it.\n"++ + "\n"++ + " d) If the work has interactive user interfaces, each must display\n"++ + " Appropriate Legal Notices; however, if the Program has interactive\n"++ + " interfaces that do not display Appropriate Legal Notices, your\n"++ + " work need not make them do so.\n"++ + "\n"++ + " A compilation of a covered work with other separate and independent\n"++ + "works, which are not by their nature extensions of the covered work,\n"++ + "and which are not combined with it such as to form a larger program,\n"++ + "in or on a volume of a storage or distribution medium, is called an\n"++ + "\"aggregate\" if the compilation and its resulting copyright are not\n"++ + "used to limit the access or legal rights of the compilation's users\n"++ + "beyond what the individual works permit. Inclusion of a covered work\n"++ + "in an aggregate does not cause this License to apply to the other\n"++ + "parts of the aggregate.\n"++ + "\n"++ + " 6. Conveying Non-Source Forms.\n"++ + "\n"++ + " You may convey a covered work in object code form under the terms\n"++ + "of sections 4 and 5, provided that you also convey the\n"++ + "machine-readable Corresponding Source under the terms of this License,\n"++ + "in one of these ways:\n"++ + "\n"++ + " a) Convey the object code in, or embodied in, a physical product\n"++ + " (including a physical distribution medium), accompanied by the\n"++ + " Corresponding Source fixed on a durable physical medium\n"++ + " customarily used for software interchange.\n"++ + "\n"++ + " b) Convey the object code in, or embodied in, a physical product\n"++ + " (including a physical distribution medium), accompanied by a\n"++ + " written offer, valid for at least three years and valid for as\n"++ + " long as you offer spare parts or customer support for that product\n"++ + " model, to give anyone who possesses the object code either (1) a\n"++ + " copy of the Corresponding Source for all the software in the\n"++ + " product that is covered by this License, on a durable physical\n"++ + " medium customarily used for software interchange, for a price no\n"++ + " more than your reasonable cost of physically performing this\n"++ + " conveying of source, or (2) access to copy the\n"++ + " Corresponding Source from a network server at no charge.\n"++ + "\n"++ + " c) Convey individual copies of the object code with a copy of the\n"++ + " written offer to provide the Corresponding Source. This\n"++ + " alternative is allowed only occasionally and noncommercially, and\n"++ + " only if you received the object code with such an offer, in accord\n"++ + " with subsection 6b.\n"++ + "\n"++ + " d) Convey the object code by offering access from a designated\n"++ + " place (gratis or for a charge), and offer equivalent access to the\n"++ + " Corresponding Source in the same way through the same place at no\n"++ + " further charge. You need not require recipients to copy the\n"++ + " Corresponding Source along with the object code. If the place to\n"++ + " copy the object code is a network server, the Corresponding Source\n"++ + " may be on a different server (operated by you or a third party)\n"++ + " that supports equivalent copying facilities, provided you maintain\n"++ + " clear directions next to the object code saying where to find the\n"++ + " Corresponding Source. Regardless of what server hosts the\n"++ + " Corresponding Source, you remain obligated to ensure that it is\n"++ + " available for as long as needed to satisfy these requirements.\n"++ + "\n"++ + " e) Convey the object code using peer-to-peer transmission, provided\n"++ + " you inform other peers where the object code and Corresponding\n"++ + " Source of the work are being offered to the general public at no\n"++ + " charge under subsection 6d.\n"++ + "\n"++ + " A separable portion of the object code, whose source code is excluded\n"++ + "from the Corresponding Source as a System Library, need not be\n"++ + "included in conveying the object code work.\n"++ + "\n"++ + " A \"User Product\" is either (1) a \"consumer product\", which means any\n"++ + "tangible personal property which is normally used for personal, family,\n"++ + "or household purposes, or (2) anything designed or sold for incorporation\n"++ + "into a dwelling. In determining whether a product is a consumer product,\n"++ + "doubtful cases shall be resolved in favor of coverage. For a particular\n"++ + "product received by a particular user, \"normally used\" refers to a\n"++ + "typical or common use of that class of product, regardless of the status\n"++ + "of the particular user or of the way in which the particular user\n"++ + "actually uses, or expects or is expected to use, the product. A product\n"++ + "is a consumer product regardless of whether the product has substantial\n"++ + "commercial, industrial or non-consumer uses, unless such uses represent\n"++ + "the only significant mode of use of the product.\n"++ + "\n"++ + " \"Installation Information\" for a User Product means any methods,\n"++ + "procedures, authorization keys, or other information required to install\n"++ + "and execute modified versions of a covered work in that User Product from\n"++ + "a modified version of its Corresponding Source. The information must\n"++ + "suffice to ensure that the continued functioning of the modified object\n"++ + "code is in no case prevented or interfered with solely because\n"++ + "modification has been made.\n"++ + "\n"++ + " If you convey an object code work under this section in, or with, or\n"++ + "specifically for use in, a User Product, and the conveying occurs as\n"++ + "part of a transaction in which the right of possession and use of the\n"++ + "User Product is transferred to the recipient in perpetuity or for a\n"++ + "fixed term (regardless of how the transaction is characterized), the\n"++ + "Corresponding Source conveyed under this section must be accompanied\n"++ + "by the Installation Information. But this requirement does not apply\n"++ + "if neither you nor any third party retains the ability to install\n"++ + "modified object code on the User Product (for example, the work has\n"++ + "been installed in ROM).\n"++ + "\n"++ + " The requirement to provide Installation Information does not include a\n"++ + "requirement to continue to provide support service, warranty, or updates\n"++ + "for a work that has been modified or installed by the recipient, or for\n"++ + "the User Product in which it has been modified or installed. Access to a\n"++ + "network may be denied when the modification itself materially and\n"++ + "adversely affects the operation of the network or violates the rules and\n"++ + "protocols for communication across the network.\n"++ + "\n"++ + " Corresponding Source conveyed, and Installation Information provided,\n"++ + "in accord with this section must be in a format that is publicly\n"++ + "documented (and with an implementation available to the public in\n"++ + "source code form), and must require no special password or key for\n"++ + "unpacking, reading or copying.\n"++ + "\n"++ + " 7. Additional Terms.\n"++ + "\n"++ + " \"Additional permissions\" are terms that supplement the terms of this\n"++ + "License by making exceptions from one or more of its conditions.\n"++ + "Additional permissions that are applicable to the entire Program shall\n"++ + "be treated as though they were included in this License, to the extent\n"++ + "that they are valid under applicable law. If additional permissions\n"++ + "apply only to part of the Program, that part may be used separately\n"++ + "under those permissions, but the entire Program remains governed by\n"++ + "this License without regard to the additional permissions.\n"++ + "\n"++ + " When you convey a copy of a covered work, you may at your option\n"++ + "remove any additional permissions from that copy, or from any part of\n"++ + "it. (Additional permissions may be written to require their own\n"++ + "removal in certain cases when you modify the work.) You may place\n"++ + "additional permissions on material, added by you to a covered work,\n"++ + "for which you have or can give appropriate copyright permission.\n"++ + "\n"++ + " Notwithstanding any other provision of this License, for material you\n"++ + "add to a covered work, you may (if authorized by the copyright holders of\n"++ + "that material) supplement the terms of this License with terms:\n"++ + "\n"++ + " a) Disclaiming warranty or limiting liability differently from the\n"++ + " terms of sections 15 and 16 of this License; or\n"++ + "\n"++ + " b) Requiring preservation of specified reasonable legal notices or\n"++ + " author attributions in that material or in the Appropriate Legal\n"++ + " Notices displayed by works containing it; or\n"++ + "\n"++ + " c) Prohibiting misrepresentation of the origin of that material, or\n"++ + " requiring that modified versions of such material be marked in\n"++ + " reasonable ways as different from the original version; or\n"++ + "\n"++ + " d) Limiting the use for publicity purposes of names of licensors or\n"++ + " authors of the material; or\n"++ + "\n"++ + " e) Declining to grant rights under trademark law for use of some\n"++ + " trade names, trademarks, or service marks; or\n"++ + "\n"++ + " f) Requiring indemnification of licensors and authors of that\n"++ + " material by anyone who conveys the material (or modified versions of\n"++ + " it) with contractual assumptions of liability to the recipient, for\n"++ + " any liability that these contractual assumptions directly impose on\n"++ + " those licensors and authors.\n"++ + "\n"++ + " All other non-permissive additional terms are considered \"further\n"++ + "restrictions\" within the meaning of section 10. If the Program as you\n"++ + "received it, or any part of it, contains a notice stating that it is\n"++ + "governed by this License along with a term that is a further\n"++ + "restriction, you may remove that term. If a license document contains\n"++ + "a further restriction but permits relicensing or conveying under this\n"++ + "License, you may add to a covered work material governed by the terms\n"++ + "of that license document, provided that the further restriction does\n"++ + "not survive such relicensing or conveying.\n"++ + "\n"++ + " If you add terms to a covered work in accord with this section, you\n"++ + "must place, in the relevant source files, a statement of the\n"++ + "additional terms that apply to those files, or a notice indicating\n"++ + "where to find the applicable terms.\n"++ + "\n"++ + " Additional terms, permissive or non-permissive, may be stated in the\n"++ + "form of a separately written license, or stated as exceptions;\n"++ + "the above requirements apply either way.\n"++ + "\n"++ + " 8. Termination.\n"++ + "\n"++ + " You may not propagate or modify a covered work except as expressly\n"++ + "provided under this License. Any attempt otherwise to propagate or\n"++ + "modify it is void, and will automatically terminate your rights under\n"++ + "this License (including any patent licenses granted under the third\n"++ + "paragraph of section 11).\n"++ + "\n"++ + " However, if you cease all violation of this License, then your\n"++ + "license from a particular copyright holder is reinstated (a)\n"++ + "provisionally, unless and until the copyright holder explicitly and\n"++ + "finally terminates your license, and (b) permanently, if the copyright\n"++ + "holder fails to notify you of the violation by some reasonable means\n"++ + "prior to 60 days after the cessation.\n"++ + "\n"++ + " Moreover, your license from a particular copyright holder is\n"++ + "reinstated permanently if the copyright holder notifies you of the\n"++ + "violation by some reasonable means, this is the first time you have\n"++ + "received notice of violation of this License (for any work) from that\n"++ + "copyright holder, and you cure the violation prior to 30 days after\n"++ + "your receipt of the notice.\n"++ + "\n"++ + " Termination of your rights under this section does not terminate the\n"++ + "licenses of parties who have received copies or rights from you under\n"++ + "this License. If your rights have been terminated and not permanently\n"++ + "reinstated, you do not qualify to receive new licenses for the same\n"++ + "material under section 10.\n"++ + "\n"++ + " 9. Acceptance Not Required for Having Copies.\n"++ + "\n"++ + " You are not required to accept this License in order to receive or\n"++ + "run a copy of the Program. Ancillary propagation of a covered work\n"++ + "occurring solely as a consequence of using peer-to-peer transmission\n"++ + "to receive a copy likewise does not require acceptance. However,\n"++ + "nothing other than this License grants you permission to propagate or\n"++ + "modify any covered work. These actions infringe copyright if you do\n"++ + "not accept this License. Therefore, by modifying or propagating a\n"++ + "covered work, you indicate your acceptance of this License to do so.\n"++ + "\n"++ + " 10. Automatic Licensing of Downstream Recipients.\n"++ + "\n"++ + " Each time you convey a covered work, the recipient automatically\n"++ + "receives a license from the original licensors, to run, modify and\n"++ + "propagate that work, subject to this License. You are not responsible\n"++ + "for enforcing compliance by third parties with this License.\n"++ + "\n"++ + " An \"entity transaction\" is a transaction transferring control of an\n"++ + "organization, or substantially all assets of one, or subdividing an\n"++ + "organization, or merging organizations. If propagation of a covered\n"++ + "work results from an entity transaction, each party to that\n"++ + "transaction who receives a copy of the work also receives whatever\n"++ + "licenses to the work the party's predecessor in interest had or could\n"++ + "give under the previous paragraph, plus a right to possession of the\n"++ + "Corresponding Source of the work from the predecessor in interest, if\n"++ + "the predecessor has it or can get it with reasonable efforts.\n"++ + "\n"++ + " You may not impose any further restrictions on the exercise of the\n"++ + "rights granted or affirmed under this License. For example, you may\n"++ + "not impose a license fee, royalty, or other charge for exercise of\n"++ + "rights granted under this License, and you may not initiate litigation\n"++ + "(including a cross-claim or counterclaim in a lawsuit) alleging that\n"++ + "any patent claim is infringed by making, using, selling, offering for\n"++ + "sale, or importing the Program or any portion of it.\n"++ + "\n"++ + " 11. Patents.\n"++ + "\n"++ + " A \"contributor\" is a copyright holder who authorizes use under this\n"++ + "License of the Program or a work on which the Program is based. The\n"++ + "work thus licensed is called the contributor's \"contributor version\".\n"++ + "\n"++ + " A contributor's \"essential patent claims\" are all patent claims\n"++ + "owned or controlled by the contributor, whether already acquired or\n"++ + "hereafter acquired, that would be infringed by some manner, permitted\n"++ + "by this License, of making, using, or selling its contributor version,\n"++ + "but do not include claims that would be infringed only as a\n"++ + "consequence of further modification of the contributor version. For\n"++ + "purposes of this definition, \"control\" includes the right to grant\n"++ + "patent sublicenses in a manner consistent with the requirements of\n"++ + "this License.\n"++ + "\n"++ + " Each contributor grants you a non-exclusive, worldwide, royalty-free\n"++ + "patent license under the contributor's essential patent claims, to\n"++ + "make, use, sell, offer for sale, import and otherwise run, modify and\n"++ + "propagate the contents of its contributor version.\n"++ + "\n"++ + " In the following three paragraphs, a \"patent license\" is any express\n"++ + "agreement or commitment, however denominated, not to enforce a patent\n"++ + "(such as an express permission to practice a patent or covenant not to\n"++ + "sue for patent infringement). To \"grant\" such a patent license to a\n"++ + "party means to make such an agreement or commitment not to enforce a\n"++ + "patent against the party.\n"++ + "\n"++ + " If you convey a covered work, knowingly relying on a patent license,\n"++ + "and the Corresponding Source of the work is not available for anyone\n"++ + "to copy, free of charge and under the terms of this License, through a\n"++ + "publicly available network server or other readily accessible means,\n"++ + "then you must either (1) cause the Corresponding Source to be so\n"++ + "available, or (2) arrange to deprive yourself of the benefit of the\n"++ + "patent license for this particular work, or (3) arrange, in a manner\n"++ + "consistent with the requirements of this License, to extend the patent\n"++ + "license to downstream recipients. \"Knowingly relying\" means you have\n"++ + "actual knowledge that, but for the patent license, your conveying the\n"++ + "covered work in a country, or your recipient's use of the covered work\n"++ + "in a country, would infringe one or more identifiable patents in that\n"++ + "country that you have reason to believe are valid.\n"++ + "\n"++ + " If, pursuant to or in connection with a single transaction or\n"++ + "arrangement, you convey, or propagate by procuring conveyance of, a\n"++ + "covered work, and grant a patent license to some of the parties\n"++ + "receiving the covered work authorizing them to use, propagate, modify\n"++ + "or convey a specific copy of the covered work, then the patent license\n"++ + "you grant is automatically extended to all recipients of the covered\n"++ + "work and works based on it.\n"++ + "\n"++ + " A patent license is \"discriminatory\" if it does not include within\n"++ + "the scope of its coverage, prohibits the exercise of, or is\n"++ + "conditioned on the non-exercise of one or more of the rights that are\n"++ + "specifically granted under this License. You may not convey a covered\n"++ + "work if you are a party to an arrangement with a third party that is\n"++ + "in the business of distributing software, under which you make payment\n"++ + "to the third party based on the extent of your activity of conveying\n"++ + "the work, and under which the third party grants, to any of the\n"++ + "parties who would receive the covered work from you, a discriminatory\n"++ + "patent license (a) in connection with copies of the covered work\n"++ + "conveyed by you (or copies made from those copies), or (b) primarily\n"++ + "for and in connection with specific products or compilations that\n"++ + "contain the covered work, unless you entered into that arrangement,\n"++ + "or that patent license was granted, prior to 28 March 2007.\n"++ + "\n"++ + " Nothing in this License shall be construed as excluding or limiting\n"++ + "any implied license or other defenses to infringement that may\n"++ + "otherwise be available to you under applicable patent law.\n"++ + "\n"++ + " 12. No Surrender of Others' Freedom.\n"++ + "\n"++ + " If conditions are imposed on you (whether by court order, agreement or\n"++ + "otherwise) that contradict the conditions of this License, they do not\n"++ + "excuse you from the conditions of this License. If you cannot convey a\n"++ + "covered work so as to satisfy simultaneously your obligations under this\n"++ + "License and any other pertinent obligations, then as a consequence you may\n"++ + "not convey it at all. For example, if you agree to terms that obligate you\n"++ + "to collect a royalty for further conveying from those to whom you convey\n"++ + "the Program, the only way you could satisfy both those terms and this\n"++ + "License would be to refrain entirely from conveying the Program.\n"++ + "\n"++ + " 13. Use with the GNU Affero General Public License.\n"++ + "\n"++ + " Notwithstanding any other provision of this License, you have\n"++ + "permission to link or combine any covered work with a work licensed\n"++ + "under version 3 of the GNU Affero General Public License into a single\n"++ + "combined work, and to convey the resulting work. The terms of this\n"++ + "License will continue to apply to the part which is the covered work,\n"++ + "but the special requirements of the GNU Affero General Public License,\n"++ + "section 13, concerning interaction through a network will apply to the\n"++ + "combination as such.\n"++ + "\n"++ + " 14. Revised Versions of this License.\n"++ + "\n"++ + " The Free Software Foundation may publish revised and/or new versions of\n"++ + "the GNU General Public License from time to time. Such new versions will\n"++ + "be similar in spirit to the present version, but may differ in detail to\n"++ + "address new problems or concerns.\n"++ + "\n"++ + " Each version is given a distinguishing version number. If the\n"++ + "Program specifies that a certain numbered version of the GNU General\n"++ + "Public License \"or any later version\" applies to it, you have the\n"++ + "option of following the terms and conditions either of that numbered\n"++ + "version or of any later version published by the Free Software\n"++ + "Foundation. If the Program does not specify a version number of the\n"++ + "GNU General Public License, you may choose any version ever published\n"++ + "by the Free Software Foundation.\n"++ + "\n"++ + " If the Program specifies that a proxy can decide which future\n"++ + "versions of the GNU General Public License can be used, that proxy's\n"++ + "public statement of acceptance of a version permanently authorizes you\n"++ + "to choose that version for the Program.\n"++ + "\n"++ + " Later license versions may give you additional or different\n"++ + "permissions. However, no additional obligations are imposed on any\n"++ + "author or copyright holder as a result of your choosing to follow a\n"++ + "later version.\n"++ + "\n"++ + " 15. Disclaimer of Warranty.\n"++ + "\n"++ + " THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY\n"++ + "APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT\n"++ + "HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY\n"++ + "OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,\n"++ + "THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR\n"++ + "PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM\n"++ + "IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF\n"++ + "ALL NECESSARY SERVICING, REPAIR OR CORRECTION.\n"++ + "\n"++ + " 16. Limitation of Liability.\n"++ + "\n"++ + " IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING\n"++ + "WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS\n"++ + "THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY\n"++ + "GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE\n"++ + "USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF\n"++ + "DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD\n"++ + "PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),\n"++ + "EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF\n"++ + "SUCH DAMAGES.\n"++ + "\n"++ + " 17. Interpretation of Sections 15 and 16.\n"++ + "\n"++ + " If the disclaimer of warranty and limitation of liability provided\n"++ + "above cannot be given local legal effect according to their terms,\n"++ + "reviewing courts shall apply local law that most closely approximates\n"++ + "an absolute waiver of all civil liability in connection with the\n"++ + "Program, unless a warranty or assumption of liability accompanies a\n"++ + "copy of the Program in return for a fee.\n"++ + "\n"++ + " END OF TERMS AND CONDITIONS\n"++ + "\n"++ + " How to Apply These Terms to Your New Programs\n"++ + "\n"++ + " If you develop a new program, and you want it to be of the greatest\n"++ + "possible use to the public, the best way to achieve this is to make it\n"++ + "free software which everyone can redistribute and change under these terms.\n"++ + "\n"++ + " To do so, attach the following notices to the program. It is safest\n"++ + "to attach them to the start of each source file to most effectively\n"++ + "state the exclusion of warranty; and each file should have at least\n"++ + "the \"copyright\" line and a pointer to where the full notice is found.\n"++ + "\n"++ + " \n"++ + " Copyright (C) \n"++ + "\n"++ + " This program is free software: you can redistribute it and/or modify\n"++ + " it under the terms of the GNU General Public License as published by\n"++ + " the Free Software Foundation, either version 3 of the License, or\n"++ + " (at your option) any later version.\n"++ + "\n"++ + " This program is distributed in the hope that it will be useful,\n"++ + " but WITHOUT ANY WARRANTY; without even the implied warranty of\n"++ + " MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n"++ + " GNU General Public License for more details.\n"++ + "\n"++ + " You should have received a copy of the GNU General Public License\n"++ + " along with this program. If not, see .\n"++ + "\n"++ + "Also add information on how to contact you by electronic and paper mail.\n"++ + "\n"++ + " If the program does terminal interaction, make it output a short\n"++ + "notice like this when it starts in an interactive mode:\n"++ + "\n"++ + " Copyright (C) \n"++ + " This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.\n"++ + " This is free software, and you are welcome to redistribute it\n"++ + " under certain conditions; type `show c' for details.\n"++ + "\n"++ + "The hypothetical commands `show w' and `show c' should show the appropriate\n"++ + "parts of the General Public License. Of course, your program's commands\n"++ + "might be different; for a GUI interface, you would use an \"about box\".\n"++ + "\n"++ + " You should also get your employer (if you work as a programmer) or school,\n"++ + "if any, to sign a \"copyright disclaimer\" for the program, if necessary.\n"++ + "For more information on this, and how to apply and follow the GNU GPL, see\n"++ + ".\n"++ + "\n"++ + " The GNU General Public License does not permit incorporating your program\n"++ + "into proprietary programs. If your program is a subroutine library, you\n"++ + "may consider it more useful to permit linking proprietary applications with\n"++ + "the library. If this is what you want to do, use the GNU Lesser General\n"++ + "Public License instead of this License. But first, please read\n"++ + ".\n" diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,494 @@ + +{- | +> backstop(1) User Commands backstop(1) +> +> NAME +> backstop - Backstop a target directory by source directories +> +> SYNOPSIS +> backstop [-nprt] [-a|-d] trgdir srcdir [srcdir ...] +> backstop -h +> backstop -l +> backstop -m +> backstop -v +> backstop -y +> +> AVAILABILITY +> Marcus D. Gabriel (c)1999-2017. All rights reserved. +> +> marcus@gabriel.name +> +> License terms: GNU GPL version 3 or later (backstop -l) +> +> DESCRIPTION +> Backstop a target directory by source directories thereby +> creating a backing chain using relative symbolic links by default +> or absolute symbolic links by option. If more than one source +> directory is given, backstop the target directory with each +> source directory in turn starting from left to right on the +> command line. +> +> Intuitively, backstop fills in the missing objects or holes that +> exist in the target directory relative to the source directories +> thereby creating a merged view of the target and source +> directories. +> +> De-backstop a target directory by its source directories. In +> this case, the source directories no longer need to exist. If +> more than one source directory is given, de-backstop the target +> directory by the source directories. +> +> Symbolic links are never followed. However, the target and +> source directories are canonicalized (realpath(3)) internally by +> the command backstop before backstopping and de-backstoppoing. +> +> By default no output is displayed except possibly to STDERR. +> +> ALGORITHM +> There must be at least two arguments or operands. The first +> operand is the target directory, and the second operand and +> beyond are source directories. The target and source directory +> must be parallel directories, that is, neither canonicalized +> (realpath(3)) directory path may be a sub-directory of the other. +> If the above is not true, a usage error occurs. +> +> Nevertheless, pathnames are internally in reduced form such that +> symbolic link names are treated literally when finding directory +> names. See "cd -L" of ksh(1). In other words, components in the +> pathname that are not directories but symbolic links to +> directories are not resolved to their corresponding directories. +> +> A list of objects or names is collected under the root of the +> source directory excluding the directory dot (.) and the +> directory double-dot (..). If the list is empty, the algorithm +> is done, otherwise the objects divide into two classes, objects +> that are not directories and objects that are directories. There +> are five possibilities: +> +> 1. The object is either dot (.) or double-dot (..) whereupon no +> action is taken. +> +> 2. If an object of the same name as the name of the object under +> the root of the source directory does not exists under the +> root of the target directory, then a symbolic link, relative +> or absolute as required, is created under the root of the +> target directory to the object under the root of the source +> directory. If populating (-p) and the object under the root +> of the source directory is a directory, then a sub-directory +> is created instead. +> +> 3. If an object of the same name as the name of the object under +> the root of the source directory does exists under the root of +> the target directory and is a file, no action is taken, +> regardless of whether or not the object under the root of the +> source directory is a file or a directory. +> +> 4. If an object of the same name as the name of the object under +> the root of the source directory does exists under the root of +> the target directory and is a directory, and if the object of +> the same name under the root of the source directory is a +> file, no action is taken. +> +> 5. If an object of the same name as the name of the object under +> the root of the source directory does exists under the root of +> the target directory and is a directory, and if the object of +> the same name under the root of the source directory is also a +> directory, then recursion occurs with the objects of the same +> name under the roots of the target and source directories as +> new root target and source directories, respectively. +> +> When de-backstopping a target directory by source directories, +> the sources no longer need to exist. Symbolic links under the +> target are removed if and only if they point to a pahtname under +> one of the source directories. This can be determined even if +> the source directory no longer exists because symbolic links +> within directory pathnames are taken literally. See "cd -L" of +> ksh(1). +> +> When de-populating while de-backstopping (-pd), a directory is +> removed if all objects within the directory are symbolic links +> that have been remove while de-backstopping. An empty directory +> is removed if and only if there exists a corresponding directory +> path under one of the source directories as under the target +> directory. This can only be determined if the source directory +> and correponding sub-directory still exist. If not, then no +> action is taken. +> +> OPTIONS +> The following options are supported: +> +> -a Create symbolic links which are absolute paths. +> +> -d De-backstop the target directory by its source directories. +> The -a option has no affect on the -d option. +> +> -h Display a short command summary. +> +> -l Display the backstop license terms. +> +> -m Display this internal manual page. +> +> -n Take no action but trace possible program execution. The -n +> option implies the -t option. +> +> -p Populate the target by making equivalent sub-directories of +> the source sub-directories instead of symbolic links for these +> sub-directories that point back into the sources. For +> example, if the target directory is empty, then for a set of +> source directories, from left to right on the command line, +> this creates a combined directory structure of the sources +> under the target directory in which all non-directories are +> symbolic links pointing back into the source directories. +> This is similar to the lndir(1) command of the X consortium. +> +> With the -d option, all sub-directories emptied of symbolic +> links under the target directory are removed, and all empty +> directories are removed if and only if the correspoding +> sub-directory under the source directory exists. +> +> -r Report the number of symbolic links and directories created, +> the number of calls and maximum depth of backstop, the +> maximum breadth observed by backstop, and the number of non- +> fatal errors encountered. With the -d option, show the +> number of symbolic links and directories removed. +> +> -t Show the trace of program execution. The output is a list +> of executable commands. +> +> -v The version of backstop. +> +> -y A synopsis of the internal manual page. +> +> OPERANDS +> trgdir +> The directory that will be backed by other directories. The +> target directory can be backed by multiple source directories +> where each source directory could be backed by yet another +> directory or multiple directories thereby creating an +> extensible backing chain. +> +> srcdir +> The directory which backs a target directory. The source +> directory can be backed by multiple additional directories +> where each additional directory could be backed by yet another +> directory or multiple directories thereby creating an +> extensible backing chain. +> +> USAGE NOTES +> Evolved with ghc 6.10, 6.12, 7.0, 7.4, 7.10, 8.0.2, and 8.4.1. +> Tested with 8.4.1. +> +> EXAMPLES +> To display a summary of usage, use +> +> backstop -h +> +> To display a synopsis of this internal manual page, use +> +> backstop -y +> +> To display this internal manual page, use +> +> backstop -m +> +> To trace program execution, use +> +> backstop -t /export/install/sparc/devlopment/modules \ +> /export/install/sparc/modules +> +> To trace program execution taking no action, use +> +> backstop -n /export/install/sparc/devlopment/modules \ +> /export/install/sparc/modules +> +> To back /export/install/sparc/devlopment/modules with +> /export/install/sparc/modules using relative symbolic links, use +> +> backstop /export/install/sparc/devlopment/modules \ +> /export/install/sparc/modules +> +> To back /export/install/sparc/devlopment/modules with +> /export/install/sparc/modules using absolute symbolic links, use +> +> backstop -a /export/install/sparc/devlopment/modules \ +> /export/install/sparc/modules +> +> To stop backing /export/install/sparc/devlopment/modules with +> /export/install/sparc/modules, use +> +> backstop -d /export/install/sparc/devlopment/modules \ +> /export/install/sparc/modules +> +> ENVIRONMENT VARIABLES +> PAGER Page the internal manual page or license terms +> using "${PAGER}", otherwise print it. +> +> EXIT STATUS +> An exit status of 0 is returned if successful, otherwise non-zero +> is returned. The following error exit codes are used by +> backstop: +> +> EXIT CODE MEANING +> 251 Less than two operands. +> 252 Not a directory, that is, trgdir or one or more +> of the srcdir are not a directory. +> 253 Not parallel directories, that is, a srcdir is +> a sub-directory of trgdir or vice versa, or one +> of the srcdir is a sub-directory of another +> srcdir. +> 254 Not yet implemented. +> 255 Non-fatal errors occurred. Error messages are +> sent to STDERR for each non-fatal error that +> occurred with return code equal to the number of +> non-falal errors if less than 251, otherwise the +> return code is 255, that is, "infinity". +> +> FILES +> N/A. +> +> SEE ALSO +> ln(1), mkdir(1), rm(1), rmdir(1), ksh(1), lndir(1), realpath(3) +> +> "Source Control to Project Control: Applying RCS and SCCS" by Don +> Bolinger and Tan Bronson. ISBN 1-56592-117-8. +> +> NOTES +> Please send bug reports to marcus@gabriel.name. +> +> BUGS +> No known bugs to date. +-} + +module Main(main) where + + +-- Section: imports +import Backstop (backstop) +import Control.Exception (try,IOException(..)) +import Control.Monad (when,unless,filterM) +import Data.List (intercalate) +import Environment (Environment(..),defaultEnv) +import License (putLicense) +import Manual (putManual) +import System.Console.GetOpt (ArgDescr(..),OptDescr(..),ArgOrder(..),usageInfo,getOpt) +import System.Directory (getCurrentDirectory,canonicalizePath) +import System.Environment (getEnvironment,getProgName,getArgs) +import System.Exit (exitSuccess,exitWith,ExitCode(..)) +import System.FilePath (takeFileName) +import System.IO (stderr,stdout,hPutStrLn,Handle(..)) +import Utils (reduceFilePath,pairs,subdirectories,aDirectory) + +-- Section: main: No need to change this section. +{- | Backstop a target directory by source directories. Refer to +'backstop'@ -h@, 'backstop'@ -y@, or 'backstop'@ -m@ for more information. +-} +main :: IO () +main = + do cmdLine <- getArgs + progName <- getProgName + case getOpt (argOrder config) options cmdLine of + (opts, args, []) -> runCmd $ foldl updateEnvField env opts + where env = defaultEnv{command=takeFileName progName,operands=args} + (_, _, errs) -> error $ concat errs ++ usageInfo (header progName) options + + +-- Section: summary, help, version: No need to change this section. +{- | +Given the programe name, returns the program name and the release +version. +-} +versionHeader :: String -> String +versionHeader progName = takeFileName progName ++ " release " ++ release config + +{- | +Given the program name, returns a synopis of options. +-} +header :: String -> String +header progName = versionHeader (takeFileName progName) ++ + "\nusage: " ++ takeFileName progName ++ flagsOps config + +{- | +Puts the program name and its version. +-} +putVersion :: IO () +putVersion = do progName <- getProgName + putStrLn (versionHeader progName) + exitSuccess + +{- | +Puts the program name and the synopsis of options to handle (stdout or +stderr) with the supplied the exit code. +-} +putSynopsis :: Handle -> String -> ExitCode -> IO () +putSynopsis h s e = do progName <- getProgName + hPutStrLn h (takeFileName progName ++ ": " ++ s ++ header progName) + exitWith e + +{- | +Puts the program name and a short summary. +-} +putSummary :: IO () +putSummary = do progName <- getProgName + putStrLn (usageInfo (header progName) options) + exitSuccess + + +-- Section: configuration (to be configured) +{- | +Configuration information is initial, constant information, that is, +not needing updates. +-} +data Configuration = + Config { + argOrder :: ArgOrder Flag, + release :: String, + flagsOps :: String + } + +{- | +To be configured once with the versions number and synopsis. Other +items may of course be added to the configuration as needed. +-} +config :: Configuration +config = + Config { + argOrder = RequireOrder, + -- Update revision number: toggle case + release = "1.3.0.352", + flagsOps = " {-{h|l|m|v|y}|[-nprt] [-a|-d] trgdir srcdir [srcdir...]}" + } + where + revision = + let num = flip elem ['0'..'9'] + in reverse.dropWhile (not.num).reverse.dropWhile (not.num) + + +-- Section: options (to be configured) +{- | +Flags set as a function of the command line options supplied. +-} +data Flag = Absolute | DeBackstop | Help | License | + Manual | NoAction | Populate | Report | Trace | + Synopsis | Version + +{- | +Options that can be given on the command line. +-} +options :: [OptDescr Flag] +options = + [ + Option "a" ["absolute"] (NoArg Absolute) "Make absolute symbolic links", + Option "d" ["de-backstop"] (NoArg DeBackstop) "De-backstop target given sources", + Option "h" ["help"] (NoArg Help) "Help summary", + Option "l" ["license"] (NoArg License) "License terms", + Option "m" ["manual"] (NoArg Manual) "Manual page", + Option "n" ["no-action"] (NoArg NoAction) "No-action trace", + Option "p" ["populate"] (NoArg Populate) "Populate by making sub-directories", + Option "r" ["report"] (NoArg Report) "Report final statistics", + Option "t" ["trace"] (NoArg Trace) "Trace program execution", + Option "v" ["version"] (NoArg Version) "Version of backstop", + Option "y" ["synopsis"] (NoArg Synopsis) "Help synopsis" + ] + + +-- Section: updating a field in the environment (to be configured) +{- | +Every option, and only an option, must be able to be updated here. +-} +updateEnvField :: Environment -> Flag -> Environment +updateEnvField env opt = + case opt of + Absolute -> env{absolute = True} + DeBackstop -> env{deBackstop = True} + Help -> env{help = True} + License -> env{license = True} + Manual -> env{manual = True} + NoAction -> env{noAction = True} + Populate -> env{populate = True} + Report -> env{report = True} + Trace -> env{trace = True} + Synopsis -> env{synopsis = True} + Version -> env{version = True} +-- _ -> error (command env ++ ": updateEnvField: unknown error") + + +-- Section: running the command given the environment (to be configured) +{- | + +No need to change the function runCmd. + +Update the environment with updateEnv, verify the environment with +verifyEnv, resolve option conflicts with resolveEnv, and run the +command given the environemnt with runWith which does the actual work +where the thre reall usually imported from a module. +-} +runCmd :: Environment -> IO () +runCmd env + | synopsis env = putSynopsis stdout "\r" ExitSuccess + | help env = putSummary + | version env = putVersion + | manual env = putManual + | license env = putLicense + | otherwise = + do env_ <- updateEnv env + verifyEnv env_ + runWith (resolveEnv env_) + +{- | +'updateEnv' updates the environment ('Environment') from the universe, +the external environment. +-} +updateEnv :: Environment -> IO Environment +updateEnv env = do cd <- getCurrentDirectory + es <- getEnvironment + os <- mapM canonicalizePath (operands env) + let pd = lookup "PWD" es + e' = maybe env{pwd = cd} (\pd -> env{pwd = pd}) pd + return e'{operands = os} + +{- | +'verifyEnv' verifies the environment created from the command line +options and the supplied operands. +-} +verifyEnv :: Environment -> IO () +verifyEnv env = verify1 env >> verify2 env >> verify3 env + where + verify1 env = + when (length (operands env) < 2) $ + putSynopsis stderr "less than two operands\n" (ExitFailure 251) + verify2 env = + do let ops = if deBackstop env then [(head.operands) env] else operands env + ps <- filterM (fmap not . aDirectory) ops + let errMsg s = putSynopsis stderr (s++(unwords ps++"\n")) (ExitFailure 252) + unless (null ps) $ + errMsg $ if length ps == 1 then "not a directory: " else "not directories: " + verify3 env = + do ds <- mapM canonicalizePath (operands env) + let ps = filter (uncurry subdirectories) $ pairs ds + let errMsg = intercalate "\n " $ map (\ (x,y) -> "("++x++","++y++")") ps + unless (null ps) $ + putSynopsis stderr ("not parallel directories:\n "++errMsg++"\n") (ExitFailure 253) + +{- | +'resolveEnv' resolves the environment created from the command line +options and the supplied operands, e.g., if an option over-rides +another, 'resolveEnv' takes this into account. +-} +resolveEnv :: Environment -> Environment +-- Order is important, so please do not change it without study +resolveEnv = resolveEnv2 . resolveEnv1 + where + -- The -n option implies -t + resolveEnv1 env = + if noAction env + then env{trace = True} + else env + -- Reduce directories, that is, ksh(1) canonical form + resolveEnv2 env = env{operands = map reduceFilePath (operands env)} + +{- | +'runWith' this environment. 'runWith' is the interface between the command +line options plus operands and the real work. 'runWith' is 'backstop'. +-} +runWith :: Environment -> IO () +runWith = backstop diff --git a/src/Manual.hs b/src/Manual.hs new file mode 100644 --- /dev/null +++ b/src/Manual.hs @@ -0,0 +1,272 @@ +module Manual(putManual) where + +import System.Exit (exitWith) +import Utils (putOrPageStrLn) + +-- | Display the internal manual. + +putManual :: IO () +putManual = putOrPageStrLn internalManual >>= exitWith + +-- | Internal manual. The definitive source of the internal manual is +-- the description section of the module Main. + +internalManual :: String +internalManual = + "backstop(1) User Commands backstop(1)\n"++ + "\n"++ + "NAME\n"++ + " backstop - Backstop a target directory by source directories\n"++ + "\n"++ + "SYNOPSIS\n"++ + " backstop [-nprt] [-a|-d] trgdir srcdir [srcdir ...]\n"++ + " backstop -h\n"++ + " backstop -l\n"++ + " backstop -m\n"++ + " backstop -v\n"++ + " backstop -y\n"++ + "\n"++ + "AVAILABILITY\n"++ + " Marcus D. Gabriel (c)1999-2017. All rights reserved.\n"++ + "\n"++ + " marcus@gabriel.name\n"++ + "\n"++ + " License terms: GNU GPL version 3 or later (backstop -l)\n"++ + "\n"++ + "DESCRIPTION\n"++ + " Backstop a target directory by source directories thereby\n"++ + " creating a backing chain using relative symbolic links by default\n"++ + " or absolute symbolic links by option. If more than one source\n"++ + " directory is given, backstop the target directory with each\n"++ + " source directory in turn starting from left to right on the\n"++ + " command line.\n"++ + "\n"++ + " Intuitively, backstop fills in the missing objects or holes that\n"++ + " exist in the target directory relative to the source directories\n"++ + " thereby creating a merged view of the target and source\n"++ + " directories.\n"++ + "\n"++ + " De-backstop a target directory by its source directories. In\n"++ + " this case, the source directories no longer need to exist. If\n"++ + " more than one source directory is given, de-backstop the target\n"++ + " directory by the source directories.\n"++ + "\n"++ + " Symbolic links are never followed. However, the target and\n"++ + " source directories are canonicalized (realpath(3)) internally by\n"++ + " the command backstop before backstopping and de-backstoppoing.\n"++ + "\n"++ + " By default no output is displayed except possibly to STDERR.\n"++ + "\n"++ + "ALGORITHM\n"++ + " There must be at least two arguments or operands. The first\n"++ + " operand is the target directory, and the second operand and\n"++ + " beyond are source directories. The target and source directory\n"++ + " must be parallel directories, that is, neither canonicalized\n"++ + " (realpath(3)) directory path may be a sub-directory of the other.\n"++ + " If the above is not true, a usage error occurs.\n"++ + "\n"++ + " Nevertheless, pathnames are internally in reduced form such that\n"++ + " symbolic link names are treated literally when finding directory\n"++ + " names. See \"cd -L\" of ksh(1). In other words, components in the\n"++ + " pathname that are not directories but symbolic links to\n"++ + " directories are not resolved to their corresponding directories.\n"++ + "\n"++ + " A list of objects or names is collected under the root of the\n"++ + " source directory excluding the directory dot (.) and the\n"++ + " directory double-dot (..). If the list is empty, the algorithm\n"++ + " is done, otherwise the objects divide into two classes, objects\n"++ + " that are not directories and objects that are directories. There\n"++ + " are five possibilities:\n"++ + "\n"++ + " 1. The object is either dot (.) or double-dot (..) whereupon no\n"++ + " action is taken.\n"++ + "\n"++ + " 2. If an object of the same name as the name of the object under\n"++ + " the root of the source directory does not exists under the\n"++ + " root of the target directory, then a symbolic link, relative\n"++ + " or absolute as required, is created under the root of the\n"++ + " target directory to the object under the root of the source\n"++ + " directory. If populating (-p) and the object under the root\n"++ + " of the source directory is a directory, then a sub-directory\n"++ + " is created instead.\n"++ + "\n"++ + " 3. If an object of the same name as the name of the object under\n"++ + " the root of the source directory does exists under the root of\n"++ + " the target directory and is a file, no action is taken,\n"++ + " regardless of whether or not the object under the root of the\n"++ + " source directory is a file or a directory.\n"++ + "\n"++ + " 4. If an object of the same name as the name of the object under\n"++ + " the root of the source directory does exists under the root of\n"++ + " the target directory and is a directory, and if the object of\n"++ + " the same name under the root of the source directory is a\n"++ + " file, no action is taken.\n"++ + "\n"++ + " 5. If an object of the same name as the name of the object under\n"++ + " the root of the source directory does exists under the root of\n"++ + " the target directory and is a directory, and if the object of\n"++ + " the same name under the root of the source directory is also a\n"++ + " directory, then recursion occurs with the objects of the same\n"++ + " name under the roots of the target and source directories as\n"++ + " new root target and source directories, respectively.\n"++ + "\n"++ + " When de-backstopping a target directory by source directories,\n"++ + " the sources no longer need to exist. Symbolic links under the\n"++ + " target are removed if and only if they point to a pahtname under\n"++ + " one of the source directories. This can be determined even if\n"++ + " the source directory no longer exists because symbolic links\n"++ + " within directory pathnames are taken literally. See \"cd -L\" of\n"++ + " ksh(1).\n"++ + "\n"++ + " When de-populating while de-backstopping (-pd), a directory is\n"++ + " removed if all objects within the directory are symbolic links\n"++ + " that have been remove while de-backstopping. An empty directory\n"++ + " is removed if and only if there exists a corresponding directory\n"++ + " path under one of the source directories as under the target\n"++ + " directory. This can only be determined if the source directory\n"++ + " and correponding sub-directory still exist. If not, then no\n"++ + " action is taken.\n"++ + "\n"++ + "OPTIONS\n"++ + " The following options are supported:\n"++ + "\n"++ + " -a Create symbolic links which are absolute paths.\n"++ + "\n"++ + " -d De-backstop the target directory by its source directories.\n"++ + " The -a option has no affect on the -d option.\n"++ + "\n"++ + " -h Display a short command summary.\n"++ + "\n"++ + " -l Display the backstop license terms.\n"++ + "\n"++ + " -m Display this internal manual page.\n"++ + "\n"++ + " -n Take no action but trace possible program execution. The -n\n"++ + " option implies the -t option.\n"++ + "\n"++ + " -p Populate the target by making equivalent sub-directories of\n"++ + " the source sub-directories instead of symbolic links for these\n"++ + " sub-directories that point back into the sources. For\n"++ + " example, if the target directory is empty, then for a set of\n"++ + " source directories, from left to right on the command line,\n"++ + " this creates a combined directory structure of the sources\n"++ + " under the target directory in which all non-directories are\n"++ + " symbolic links pointing back into the source directories.\n"++ + " This is similar to the lndir(1) command of the X consortium.\n"++ + "\n"++ + " With the -d option, all sub-directories emptied of symbolic\n"++ + " links under the target directory are removed, and all empty\n"++ + " directories are removed if and only if the correspoding\n"++ + " sub-directory under the source directory exists.\n"++ + "\n"++ + " -r Report the number of symbolic links and directories created,\n"++ + " the number of calls and maximum depth of backstop, the\n"++ + " maximum breadth observed by backstop, and the number of non-\n"++ + " fatal errors encountered. With the -d option, show the\n"++ + " number of symbolic links and directories removed.\n"++ + "\n"++ + " -t Show the trace of program execution. The output is a list\n"++ + " of executable commands.\n"++ + "\n"++ + " -v The version of backstop.\n"++ + "\n"++ + " -y A synopsis of the internal manual page.\n"++ + "\n"++ + "OPERANDS\n"++ + " trgdir\n"++ + " The directory that will be backed by other directories. The\n"++ + " target directory can be backed by multiple source directories\n"++ + " where each source directory could be backed by yet another\n"++ + " directory or multiple directories thereby creating an\n"++ + " extensible backing chain.\n"++ + "\n"++ + " srcdir\n"++ + " The directory which backs a target directory. The source\n"++ + " directory can be backed by multiple additional directories\n"++ + " where each additional directory could be backed by yet another\n"++ + " directory or multiple directories thereby creating an\n"++ + " extensible backing chain.\n"++ + "\n"++ + "USAGE NOTES\n"++ + " Evolved with ghc 6.10, 6.12, 7.0, 7.4, 7.10, 8.0.2, and 8.4.1.\n"++ + " Tested with 8.4.1.\n"++ + "\n"++ + "EXAMPLES\n"++ + " To display a summary of usage, use\n"++ + "\n"++ + " backstop -h\n"++ + "\n"++ + " To display a synopsis of this internal manual page, use\n"++ + "\n"++ + " backstop -y\n"++ + "\n"++ + " To display this internal manual page, use\n"++ + "\n"++ + " backstop -m\n"++ + "\n"++ + " To trace program execution, use\n"++ + "\n"++ + " backstop -t /export/install/sparc/devlopment/modules \\\n"++ + " /export/install/sparc/modules\n"++ + "\n"++ + " To trace program execution taking no action, use\n"++ + "\n"++ + " backstop -n /export/install/sparc/devlopment/modules \\\n"++ + " /export/install/sparc/modules\n"++ + "\n"++ + " To back /export/install/sparc/devlopment/modules with\n"++ + " /export/install/sparc/modules using relative symbolic links, use\n"++ + "\n"++ + " backstop /export/install/sparc/devlopment/modules \\\n"++ + " /export/install/sparc/modules\n"++ + "\n"++ + " To back /export/install/sparc/devlopment/modules with\n"++ + " /export/install/sparc/modules using absolute symbolic links, use\n"++ + "\n"++ + " backstop -a /export/install/sparc/devlopment/modules \\\n"++ + " /export/install/sparc/modules\n"++ + "\n"++ + " To stop backing /export/install/sparc/devlopment/modules with\n"++ + " /export/install/sparc/modules, use\n"++ + "\n"++ + " backstop -d /export/install/sparc/devlopment/modules \\\n"++ + " /export/install/sparc/modules\n"++ + "\n"++ + "ENVIRONMENT VARIABLES\n"++ + " PAGER Page the internal manual page or license terms\n"++ + " using \"${PAGER}\", otherwise print it.\n"++ + "\n"++ + "EXIT STATUS\n"++ + " An exit status of 0 is returned if successful, otherwise non-zero\n"++ + " is returned. The following error exit codes are used by\n"++ + " backstop:\n"++ + "\n"++ + " EXIT CODE MEANING\n"++ + " 251 Less than two operands.\n"++ + " 252 Not a directory, that is, trgdir or one or more\n"++ + " of the srcdir are not a directory.\n"++ + " 253 Not parallel directories, that is, a srcdir is\n"++ + " a sub-directory of trgdir or vice versa, or one\n"++ + " of the srcdir is a sub-directory of another\n"++ + " srcdir.\n"++ + " 254 Not yet implemented.\n"++ + " 255 Non-fatal errors occurred. Error messages are\n"++ + " sent to STDERR for each non-fatal error that\n"++ + " occurred with return code equal to the number of\n"++ + " non-falal errors if less than 251, otherwise the\n"++ + " return code is 255, that is, \"infinity\".\n"++ + "\n"++ + "FILES\n"++ + " N/A.\n"++ + "\n"++ + "SEE ALSO\n"++ + " ln(1), mkdir(1), rm(1), rmdir(1), ksh(1), lndir(1), realpath(3)\n"++ + "\n"++ + " \"Source Control to Project Control: Applying RCS and SCCS\" by Don\n"++ + " Bolinger and Tan Bronson. ISBN 1-56592-117-8.\n"++ + "\n"++ + "NOTES\n"++ + " Please send bug reports to marcus@gabriel.name.\n"++ + "\n"++ + "BUGS\n"++ + " No known bugs to date.\n" diff --git a/src/Utils.hs b/src/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Utils.hs @@ -0,0 +1,266 @@ +module Utils (pairs + , unpairs + , root + , dot + , dotdot + , reduceFilePath + , absoluteLink + , relativeLink + , compElems + , subdirectories + , subdirectory + , aDirectory + , aSymbolicLink + , anObject + , putOrPageStrLn + ) +where + +import Control.Exception (IOException, try) +import Control.Monad (unless) +import Data.List (nub,intersect,isPrefixOf,tails,foldl') +import Data.Maybe (fromJust,isNothing) +import System.Environment (getEnvironment) +import System.Exit (ExitCode(..)) +import System.FilePath (pathSeparator,joinPath,(),isAbsolute,splitDirectories) +import System.IO (hClose,hFlush,hPutStr) +import System.Posix.Files (getSymbolicLinkStatus,isSymbolicLink,isDirectory) +import System.Process (waitForProcess,createProcess,shell,StdStream(..),CreateProcess(..)) + + +-- Section 0: exported items--------------------------------------------------------- + +-- | 'root' = @[pathSeparator]@ +root :: FilePath +root = [pathSeparator] + +-- | 'dot' = \".\" +dot :: FilePath +dot = "." + +-- | 'dotdot' = \"..\" +dotdot :: FilePath +dotdot = ".." + +-- | Given a list @[a]@, 'pairs' returns the list of all pairs +-- @[(a,a)]@ of @[a]@ progressing from the head to tail of @[a]@. For +-- example, +-- +-- > pairs [x1,x2,x3,x4] +-- > == [(x1,x2),(x1,x3),(x1,x4),(x2,x3),(x2,x4),(x3,x4)] +-- +-- Note that +-- +-- > pairs [] == [] +-- > pairs (x:[]) == [] + +pairs :: [a] -> [(a,a)] +pairs [] = [] +pairs [x] = [] +pairs xs = + let pair_ x0 = map (\x1 -> (x0,x1)) + xss = init $ init $ tails xs + in concatMap (\xs -> pair_ (head xs) (tail xs)) xss + +-- | For @length l /= 1@, +-- +-- > (unpairs . pairs) l == l +-- +-- is @True@. +-- +-- > Number of elements Number of pairs +-- > ------------------ --------------- +-- > 0 => 0 +-- > 1 => 0 +-- > 2 => 1 +-- > 3 => 3 +-- > 4 => 6 +-- > 5 => 10 +-- > e => p = e(e-1)/2, e >= 0 + +unpairs :: Eq a => [(a,a)] -> [a] +unpairs ps + | null ps = [] + | otherwise = fst (head ps) : foldr ((:).snd) [] (take (elements 0 (length ps) - 1) ps) + where + elements e p = if p == e*(e-1) `div` 2 then e else elements (e+1) p + +-- | 'reduceFilePath' returns a pathname that is reduced to canonical +-- form equivalent to that of ksh(1), that is, symbolic link names are +-- treated literally when finding the directory name. See @cd -L@ of +-- ksh(1). Specifically, extraneous separators @(\"/\")@, dot +-- @(\".\")@, and double-dot @(\"..\")@ directories are removed. + +reduceFilePath :: FilePath -> FilePath +reduceFilePath = joinPath . filePathComponents + +-- | Given a pathname @wd@ representing a workng directory and two +-- pathnames @p1@ and @p2@, 'absoluteLink' returns the reduced +-- ('reduceFilePath') and absolute path to @p2@ to which @p1@ could point +-- as a symbolic link. +-- +-- If @wd@ is not an absolute path, it is assumed to be a relative +-- path that is relative to the root directory of the file system tree +-- and is made an absolute path. + +absoluteLink :: FilePath -> FilePath -> FilePath -> FilePath +absoluteLink wd _ = reduceFilePath . ((pathSeparator:wd)) + +-- | Given a pathname @wd@ representing a workng directory and two +-- pathnames @p1@ and @p2@, 'relativeLink' returns the reduced +-- ('reduceFilePath') and relative path from @p1@ to @p2@ to which +-- @p1@ could point as a symbolic link. Thus, @p1@ must not be the +-- root @(\"/\")@, dot @(\".\")@, nor double-dot @(\"..\")@ +-- directories but of the form @\"\/SomePath\/SymLink\"@ +-- +-- If @wd@ is not an absolute path, it is assumed to be a relative +-- path that is relative to the root directory of the file system tree +-- and is made an absolute path. + +relativeLink :: FilePath -> FilePath -> FilePath -> FilePath +relativeLink wd p1 p2 = + let wd_ = pathSeparator:wd + ab p = if isAbsolute p then p else wd_ p + (_, p1_, p2_) = decomposeFilePaths (ab p1) (ab p2) + p1_s = map (const dotdot) $ splitDirectories p1_ + p1__ = (joinPath . (if null p1_s then id else tail)) p1_s + p = p1__ p2_ + in if null p then dot else p + +-- | 'compElems' compares elements of two lists and returns the list of +-- elements that are in both lists, unique to the first list, and +-- uniqued to the second list. Duplicates are 'nub'ed. + +compElems :: Eq a => [a] -> [a] -> ([a], [a], [a]) +compElems [] l2 = ([], [], nub l2) +compElems l1 [] = ([], nub l1, []) +compElems l1 l2 = + let l1_ = nub l1 + l2_ = nub l2 + same = intersect l1_ l2_ + unique1 = filter (`notElem` same) l1_ + unique2 = filter (`notElem` same) l2_ + in (same, unique1, unique2) + +-- | 'subdirectories' returns true if either the absolute pathname +-- @p1@ or the absolute pathname @p2@ is a sub-directory or sub-path +-- of the other. + +subdirectories :: FilePath -> FilePath -> Bool +subdirectories p1 p2 = subdirectory p1 p2 || subdirectory p2 p1 + +-- | 'subdirectory' returns true if the absolute pathname @p1@ is a +-- subdirectory of the absolute pathname @p2@ as in +-- +-- > p1 `subdirectory` p2 +-- +-- otherwise false. + +subdirectory :: FilePath -> FilePath -> Bool +subdirectory p1 p2 = + let x = filePathComponents p1 + y = filePathComponents p2 + in isPrefixOf y x + +-- | 'aDirectory' returns true if @p@ is not a symbolic link +-- and is a directory, otherwise false. + +aDirectory :: FilePath -> IO Bool +aDirectory = + fmap (either (const False :: IOException -> Bool) isDirectory) . try . getSymbolicLinkStatus + +-- | 'aSymbolicLink' returns true if @p@ is a symbolic link, otherwise +-- false. + +aSymbolicLink :: FilePath -> IO Bool +aSymbolicLink = + fmap (either (const False :: IOException -> Bool) isSymbolicLink) . try . getSymbolicLinkStatus + +-- | 'anObject' returns true if @p@ is an object in the filesystem, +-- otherwise false. Symbolic links are not deferenced. + +anObject :: FilePath -> IO Bool +anObject = + fmap (either (const False :: IOException -> Bool) (const True)) . try . getSymbolicLinkStatus + + +-- | Put a string or page it if the environmental variable PAGER is set. + +putOrPageStrLn :: String -> IO ExitCode +putOrPageStrLn str + | null str = return ExitSuccess + | otherwise = + do pager <- fmap (lookup "PAGER") getEnvironment + if isNothing pager + then putStrLn str >> return ExitSuccess + else do (inh, _, _, pid) <- createProcess (shell $ fromJust pager){std_in = CreatePipe} + unless (isNothing inh) $ do hPutStr (fromJust inh) str + hFlush (fromJust inh) + hClose (fromJust inh) + waitForProcess pid + + +-- Section 1 ------------------------------------------------------------------------ + +-- | Given two abosulte pathnames @p1@ and @p2@, 'decomposeFilePaths' +-- returns the common prefix to @p1@ and @p2@ plus the remainders of +-- @p1@ and @p2@, otherwise null plus @p1@ and @p2@. +decomposeFilePaths :: FilePath -> FilePath -> (FilePath, FilePath, FilePath) +decomposeFilePaths p1 p2 + | null p1 = ([], p1, p2) + | null p2 = ([], p1, p2) + | otherwise = + let p1s = filePathComponents p1 + p2s = filePathComponents p2 + (pxs_, p1s_, p2s_) = decomposeFilePaths_ ([], p1s, p2s) + decomposeFilePaths_ (pxs, [], p2s) = (pxs, [], p2s) + decomposeFilePaths_ (pxs, p1s, []) = (pxs, p1s, []) + decomposeFilePaths_ (pxs, p1s, p2s) = + let p1h = head p1s + p2h = head p2s + p1t = tail p1s + p2t = tail p2s + in if p1h == p2h + then decomposeFilePaths_ (pxs++[p1h], p1t, p2t) + else (pxs, p1s, p2s) + in (joinPath pxs_, joinPath p1s_, joinPath p2s_) + + +-- Section 2 ------------------------------------------------------------------------ + +-- | 'filePathComponents' returns pathname components that are reduced +-- to canonical form equivalent to that of ksh(1), that is, symbolic +-- link names are treated literally when finding the directory name. +-- See @cd -L@ of ksh(1). Specifically, extraneous separators +-- @(\"/\")@, dot @(\".\")@, and double-dot @(\"..\")@ directories are +-- removed. + +filePathComponents :: FilePath -> [FilePath] +filePathComponents p + | null p = [dot] + | otherwise = let c = head p + cs = tail p + in reverse $ snd $ foldl accumulate + (if c == pathSeparator then ([],[root]) else ([c],[dot])) + (cs++root) + where + accumulate :: (String,[String]) -> Char -> (String,[String]) + accumulate (cs, css) c = + if c == pathSeparator + then ([],(if null cs then id else cons cs) css) + else (cs++[c],css) + cons :: String -> [String] -> [String] + cons cs css + | cs == dot = css + | css == [dot] = [cs] + | cs /= dotdot || null css = cs : css + | otherwise = + let hd = head css + tl = tail css + in if hd == root + then css + else if hd == dotdot + then cs : css + else if null tl + then [dot] + else tl diff --git a/tests/RunTests.hs b/tests/RunTests.hs new file mode 100644 --- /dev/null +++ b/tests/RunTests.hs @@ -0,0 +1,641 @@ +module Main(main) where + +import Control.Monad (unless) +import Data.List (sort,nub,intersect) +import System.Exit (exitWith,ExitCode(..)) +import System.IO (hPutStrLn,hFlush,stdout,stderr) +import System.FilePath ((),pathSeparator,isAbsolute,isRelative,joinPath) +import System.Process (runCommand,waitForProcess) +import Test.HUnit hiding (Testable) +import Test.QuickCheck (Testable(..),Property(..),(==>),Result(..),quickCheckResult) +import Utils (putOrPageStrLn,anObject,aSymbolicLink,aDirectory,subdirectories + ,subdirectory,root,reduceFilePath,compElems,pairs,unpairs,dot,dotdot + ,relativeLink,absoluteLink) + + +-- Section 0 ------------------------------------------------------------------------ + +main :: IO () +main = do putMessage "Unit test reduceFilePath:" + runTestTT checks4reduceFilePath >>= checkCounts + + putMessage "Property test reduceFilePath:" + mapM_ runTest props4reduceFilePath + mapM_ runTest props4reduceFilePath_ + + putMessage "Unit test absoluteLink:" + runTestTT checks4absoluteLink >>= checkCounts + + putMessage "Property test absoluteLink:" + mapM_ runTest props4absoluteLink + + putMessage "Unit test relativeLink:" + runTestTT checks4relativeLink >>= checkCounts + + putMessage "Property test relativeLink:" + mapM_ runTest props4relativeLink + + putMessage "Unit test pairs:" + runTestTT checks4pairs >>= checkCounts + + putMessage "Unit test unpairs . pairs == id:" + runTestTT checks4unpairsPairs >>= checkCounts + + putMessage "Property test unpairs . pairs == id:" + mapM_ runTest props4unpairsPairs + + putMessage "Unit test compElems:" + runTestTT check4compElems >>= checkCounts + + putMessage "Property test compElems:" + mapM_ runTest props4check4compElems + + putMessage "Unit test subdirectory:" + runTestTT checks4subdirectory >>= checkCounts + + putMessage "Unit test subdirectories:" + runTestTT checks4subdirectories >>= checkCounts + + putMessage "Property test subdirectory and subdirectories:" + mapM_ runTest props4Subdirectories + + putMessage "Unit test aDirectory:" + runTestTT checks4aDirectory >>= checkCounts + + putMessage "Unit test aSymbolicLink:" + runTestTT checks4aSymbolicLink >>= checkCounts + + putMessage "Unit test anObject:" + runTestTT checks4anObject >>= checkCounts + + putMessage "Unit test putOrPageStrLn:" + runTestTT checks4putOrPageStrLn >>= checkCounts + + putMessage "Running black box tests:" + runTests >>= exitWith + +checkCounts :: Counts -> IO () +checkCounts cnts = let errs = errors cnts + failures cnts + in if errs > 0 + then exitWith $ ExitFailure (if errs < 256 then errs else 255) + else putStrLn "" + +runTest :: Testable t => (String, t) -> IO () +runTest (s, t) = do putStrLn s + verify t + putStrLn "" + +putMessage :: String -> IO () +putMessage s = let l = length s + in do putStrLn s + (putStrLn . replicate l) '=' + hFlush stdout + + +-- Section 1 ------------------------------------------------------------------------ + +checks4reduceFilePath :: Test +checks4reduceFilePath = + let checkReduceFilePath p1 p2 + = TestCase (assertEqual "reduceFilePath" p2 (reduceFilePath p1)) + in TestList + [ + -- The special case of null arguments + checkReduceFilePath "" "." + + -- The special case of dot + , checkReduceFilePath "." "." + + -- The special case of double dot + , checkReduceFilePath ".." ".." + + -- Only slashes + , checkReduceFilePath "/" "/" + , checkReduceFilePath "//" "/" + , checkReduceFilePath "///" "/" + + -- Only dots and slashes + , checkReduceFilePath "./" "." + , checkReduceFilePath ".//" "." + , checkReduceFilePath ".///" "." + , checkReduceFilePath "./." "." + , checkReduceFilePath ".//." "." + , checkReduceFilePath ".///." "." + , checkReduceFilePath "././" "." + , checkReduceFilePath ".//./././///." "." + , checkReduceFilePath "././././././././" "." + + -- Only slashes and dots + , checkReduceFilePath "/." "/" + , checkReduceFilePath "//." "/" + , checkReduceFilePath "/./" "/" + , checkReduceFilePath "///.///" "/" + , checkReduceFilePath "/./././." "/" + , checkReduceFilePath "//.//.//.//." "/" + + -- Only slashes and double dots + , checkReduceFilePath "/.." "/" + , checkReduceFilePath "/../" "/" + , checkReduceFilePath "///..///" "/" + , checkReduceFilePath "/../../../../" "/" + + -- Only double dots and slashes + , checkReduceFilePath "../" ".." + , checkReduceFilePath "..///" ".." + , checkReduceFilePath "..///.." "../.." + , checkReduceFilePath "../../../../" "../../../.." + , checkReduceFilePath "..///..///..///..///" "../../../.." + + -- Absolute paths with only slahses + , checkReduceFilePath "/a" "/a" + , checkReduceFilePath "/a/b" "/a/b" + , checkReduceFilePath "//a" "/a" + , checkReduceFilePath "//a//b" "/a/b" + , checkReduceFilePath "//a///" "/a" + , checkReduceFilePath "//a//b///" "/a/b" + + -- Relative paths with only slahses + , checkReduceFilePath "a" "a" + , checkReduceFilePath "a/b" "a/b" + , checkReduceFilePath "a" "a" + , checkReduceFilePath "a//b" "a/b" + , checkReduceFilePath "a///" "a" + , checkReduceFilePath "a//b///" "a/b" + + -- Absolute paths with dots + , checkReduceFilePath "/a/." "/a" + , checkReduceFilePath "/a/./." "/a" + , checkReduceFilePath "/./a" "/a" + , checkReduceFilePath "/./a/./." "/a" + + -- Relative paths with dots + , checkReduceFilePath "a/." "a" + , checkReduceFilePath "a/./." "a" + , checkReduceFilePath "./a" "a" + , checkReduceFilePath "./a/./." "a" + + -- Absolute paths with double dots + , checkReduceFilePath "/.." "/" + , checkReduceFilePath "/a/.." "/" + , checkReduceFilePath "/a/b/.." "/a" + , checkReduceFilePath "/a/b/c/.." "/a/b" + , checkReduceFilePath "/a/../b" "/b" + , checkReduceFilePath "/a/b/../c" "/a/c" + , checkReduceFilePath "/a/b/c/../.." "/a" + , checkReduceFilePath "/a/b/c/../../.." "/" + , checkReduceFilePath "/a/b/c/../../../.." "/" + , checkReduceFilePath "/a/b/c/../x/y/../z" "/a/b/x/z" + + -- Relative paths with double dots + , checkReduceFilePath "a/.." "." + , checkReduceFilePath "a/b/.." "a" + , checkReduceFilePath "a/b/c/.." "a/b" + , checkReduceFilePath "a/../b" "b" + , checkReduceFilePath "a/b/../c" "a/c" + , checkReduceFilePath "a/b/c/../.." "a" + , checkReduceFilePath "a/b/c/../../.." "." + , checkReduceFilePath "a/b/c/../../../.." ".." + , checkReduceFilePath "a/b/c/../../../../.." "../.." + , checkReduceFilePath "a/b/c/../x/y/../z" "a/b/x/z" + + -- General abosulte paths + , checkReduceFilePath "/a/b/./x/y/z/../." "/a/b/x/y" + , checkReduceFilePath "/./a/.." "/" + , checkReduceFilePath "/a/./b/c/../x/y/./.." "/a/b/x" + , checkReduceFilePath "/a/b/c/d/e/f/g/h/../../../../../e/f/g/h/i" "/a/b/c/e/f/g/h/i" + + -- General reltative paths + , checkReduceFilePath "a/b/./x/y/z/../." "a/b/x/y" + , checkReduceFilePath "./a/.." "." + , checkReduceFilePath "a/./b/c/../x/y/./.." "a/b/x" + , checkReduceFilePath "./../../../a/b/c/./x/y/z" "../../../a/b/c/x/y/z" + , checkReduceFilePath "a/b/c/d/e/f/g/h/../../../../../e/f/g/h/i" "a/b/c/e/f/g/h/i" + ] + + +-- Section 2 ------------------------------------------------------------------------ + +props4reduceFilePath :: [(String, FilePath -> Property)] +props4reduceFilePath = [ ("propReduceFilePathIdempotent", propReduceFilePathIdempotent) + , ("propReduceFilePathStaysAbsolute", propReduceFilePathStaysAbsolute) + , ("propReduceFilePathStaysRelative", propReduceFilePathStaysRelative) + ] + +props4reduceFilePath_ :: [(String, FilePath -> FilePath -> Property)] +props4reduceFilePath_ = [ ("propReduceFilePathAssociativity", propReduceFilePathAssociativity) + ] + +propReduceFilePathIdempotent :: FilePath -> Property +propReduceFilePathIdempotent p = + property $ (reduceFilePath . reduceFilePath) p == reduceFilePath p + +propReduceFilePathStaysAbsolute :: FilePath -> Property +propReduceFilePathStaysAbsolute p = + let p' = root p + in property $ (isAbsolute . reduceFilePath) p' == isAbsolute p' + +propReduceFilePathStaysRelative :: FilePath -> Property +propReduceFilePathStaysRelative p = + (not (null p) && (head p /= pathSeparator)) ==> + (isRelative . reduceFilePath) p == isRelative p + +propReduceFilePathAssociativity :: FilePath -> FilePath -> Property +propReduceFilePathAssociativity p1 p2 = + property (reduceFilePath (p1 p2) == reduceFilePath (reduceFilePath p1 reduceFilePath p2)) + + +-- Section 3 ------------------------------------------------------------------------ + +checks4absoluteLink :: Test +checks4absoluteLink = + let + checkAbsoluteLink wd p1 p2 p = + TestCase (assertEqual "absoluteLink" p (absoluteLink wd p1 p2)) + in TestList + [ checkAbsoluteLink "" "" "" root + , checkAbsoluteLink "" "" "." root + , checkAbsoluteLink "" "" ".." root + , checkAbsoluteLink "" "X" "" root + , checkAbsoluteLink "" "X" "." root + , checkAbsoluteLink "" "X" ".." root + , checkAbsoluteLink root "" "" root + , checkAbsoluteLink root "" "." root + , checkAbsoluteLink root "" ".." root + , checkAbsoluteLink root "X" "" root + , checkAbsoluteLink root "X" "." root + , checkAbsoluteLink root "X" ".." root + , checkAbsoluteLink "/xx/yy/zz" "" "" "/xx/yy/zz" + , checkAbsoluteLink "/xx/yy/zz" "" "." "/xx/yy/zz" + , checkAbsoluteLink "/xx/yy/zz" "" ".." "/xx/yy" + , checkAbsoluteLink "/xx/yy/zz" "X" "" "/xx/yy/zz" + , checkAbsoluteLink "/xx/yy/zz" "X" "." "/xx/yy/zz" + , checkAbsoluteLink "/xx/yy/zz" "X" ".." "/xx/yy" + , checkAbsoluteLink "xx/yy/zz" "" "" "/xx/yy/zz" + , checkAbsoluteLink "xx/yy/zz" "" "." "/xx/yy/zz" + , checkAbsoluteLink "xx/yy/zz" "" ".." "/xx/yy" + , checkAbsoluteLink "xx/yy/zz" "X" "" "/xx/yy/zz" + , checkAbsoluteLink "xx/yy/zz" "X" "." "/xx/yy/zz" + , checkAbsoluteLink "xx/yy/zz" "X" ".." "/xx/yy" + , checkAbsoluteLink "" "" "aa/bb/cc" "/aa/bb/cc" + , checkAbsoluteLink "" "" "aa/bb/cc/." "/aa/bb/cc" + , checkAbsoluteLink "" "" "aa/bb/cc/.." "/aa/bb" + , checkAbsoluteLink "" "X" "aa/bb/cc/" "/aa/bb/cc" + , checkAbsoluteLink "" "X" "aa/bb/cc/." "/aa/bb/cc" + , checkAbsoluteLink "" "X" "aa/bb/cc/.." "/aa/bb" + , checkAbsoluteLink root "" "aa/bb/cc/" "/aa/bb/cc" + , checkAbsoluteLink root "" "aa/bb/cc/." "/aa/bb/cc" + , checkAbsoluteLink root "" "aa/bb/cc/.." "/aa/bb" + , checkAbsoluteLink root "X" "aa/bb/cc/" "/aa/bb/cc" + , checkAbsoluteLink root "X" "aa/bb/cc/." "/aa/bb/cc" + , checkAbsoluteLink root "X" "aa/bb/cc/.." "/aa/bb" + , checkAbsoluteLink "/xx/yy/zz" "" "aa/bb/cc/" "/xx/yy/zz/aa/bb/cc" + , checkAbsoluteLink "/xx/yy/zz" "" "aa/bb/cc/." "/xx/yy/zz/aa/bb/cc" + , checkAbsoluteLink "/xx/yy/zz" "" "aa/bb/cc/.." "/xx/yy/zz/aa/bb" + , checkAbsoluteLink "/xx/yy/zz" "X" "aa/bb/cc/" "/xx/yy/zz/aa/bb/cc" + , checkAbsoluteLink "/xx/yy/zz" "X" "aa/bb/cc/." "/xx/yy/zz/aa/bb/cc" + , checkAbsoluteLink "/xx/yy/zz" "X" "aa/bb/cc/.." "/xx/yy/zz/aa/bb" + , checkAbsoluteLink "xx/yy/zz" "" "aa/bb/cc/" "/xx/yy/zz/aa/bb/cc" + , checkAbsoluteLink "xx/yy/zz" "" "aa/bb/cc/." "/xx/yy/zz/aa/bb/cc" + , checkAbsoluteLink "xx/yy/zz" "" "aa/bb/cc/.." "/xx/yy/zz/aa/bb" + , checkAbsoluteLink "xx/yy/zz" "X" "aa/bb/cc/" "/xx/yy/zz/aa/bb/cc" + , checkAbsoluteLink "xx/yy/zz" "X" "aa/bb/cc/." "/xx/yy/zz/aa/bb/cc" + , checkAbsoluteLink "xx/yy/zz" "X" "aa/bb/cc/.." "/xx/yy/zz/aa/bb" + ] + + +-- Section 4 ------------------------------------------------------------------------ + +wd :: FilePath +wd = joinPath $ map show [0..9] + +props4absoluteLink :: [(String, FilePath -> FilePath -> Property)] +props4absoluteLink = [ ("propAbsoluteLinkIdempotent root", propAbsoluteLinkIdempotent root) + , ("propAbsoluteLinkIdempotent wd", propAbsoluteLinkIdempotent wd) + , ("propAbsoluteLinkStaysAbsolute root", propAbsoluteLinkStaysAbsolute root) + , ("propAbsoluteLinkStaysAbsolute wd", propAbsoluteLinkStaysAbsolute wd) + , ("propAbsoluteLinkIsNotRelative root", propAbsoluteLinkIsNotRelative root) + , ("propAbsoluteLinkIsNotRelative wd", propAbsoluteLinkIsNotRelative wd) + ] + +propAbsoluteLinkIdempotent :: FilePath -> FilePath -> FilePath -> Property +propAbsoluteLinkIdempotent wd p1 p2 = + property $ (absoluteLink wd p1 . absoluteLink wd p1) p2 == absoluteLink wd p1 p2 + +propAbsoluteLinkStaysAbsolute :: FilePath -> FilePath -> FilePath -> Property +propAbsoluteLinkStaysAbsolute wd p1 = + property . isAbsolute . absoluteLink wd p1 + +propAbsoluteLinkIsNotRelative :: FilePath -> FilePath -> FilePath -> Property +propAbsoluteLinkIsNotRelative wd p1 = + property . not. isRelative . absoluteLink wd p1 + + +-- Section 5 ------------------------------------------------------------------------ + +checks4relativeLink :: Test +checks4relativeLink = + let + checkRelativeLink wd p1 p2 p = + TestCase (assertEqual "relativeLink" p (relativeLink wd p1 p2)) + in TestList + [ checkRelativeLink "" "" "" dot + , checkRelativeLink "" "" "." dot + , checkRelativeLink "" "" ".." dot + , checkRelativeLink "" "X" "" dot + , checkRelativeLink "" "X" "." dot + , checkRelativeLink "" "X" ".." dot + , checkRelativeLink root "" "" dot + , checkRelativeLink root "" "." dot + , checkRelativeLink root "" ".." dot + , checkRelativeLink root "X" "" dot + , checkRelativeLink root "X" "." dot + , checkRelativeLink root "X" ".." dot + , checkRelativeLink "/xx/yy/zz" "" "" dot + , checkRelativeLink "/xx/yy/zz" "" "." dot + , checkRelativeLink "/xx/yy/zz" "" ".." dot + , checkRelativeLink "/xx/yy/zz" "X" "" dot + , checkRelativeLink "/xx/yy/zz" "X" "." dot + , checkRelativeLink "/xx/yy/zz" "X" ".." dotdot + , checkRelativeLink "xx/yy/zz" "" "" dot + , checkRelativeLink "xx/yy/zz" "" "." dot + , checkRelativeLink "xx/yy/zz" "" ".." dot + , checkRelativeLink "xx/yy/zz" "X" "" dot + , checkRelativeLink "xx/yy/zz" "X" "." dot + , checkRelativeLink "xx/yy/zz" "X" ".." dotdot + , checkRelativeLink "" "" "aa/bb/cc" "aa/bb/cc" + , checkRelativeLink "" "" "aa/bb/cc/." "aa/bb/cc" + , checkRelativeLink "" "" "aa/bb/cc/.." "aa/bb" + , checkRelativeLink "" "X" "aa/bb/cc/" "aa/bb/cc" + , checkRelativeLink "" "X" "aa/bb/cc/." "aa/bb/cc" + , checkRelativeLink "" "X" "aa/bb/cc/.." "aa/bb" + , checkRelativeLink root "" "aa/bb/cc/" "aa/bb/cc" + , checkRelativeLink root "" "aa/bb/cc/." "aa/bb/cc" + , checkRelativeLink root "" "aa/bb/cc/.." "aa/bb" + , checkRelativeLink root "X" "aa/bb/cc/" "aa/bb/cc" + , checkRelativeLink root "X" "aa/bb/cc/." "aa/bb/cc" + , checkRelativeLink root "X" "aa/bb/cc/.." "aa/bb" + , checkRelativeLink "/xx/yy/zz" "" "aa/bb/cc/" "aa/bb/cc" + , checkRelativeLink "/xx/yy/zz" "" "aa/bb/cc/." "aa/bb/cc" + , checkRelativeLink "/xx/yy/zz" "" "aa/bb/cc/.." "aa/bb" + , checkRelativeLink "/xx/yy/zz" "X" "aa/bb/cc/" "aa/bb/cc" + , checkRelativeLink "/xx/yy/zz" "X" "aa/bb/cc/." "aa/bb/cc" + , checkRelativeLink "/xx/yy/zz" "X" "aa/bb/cc/.." "aa/bb" + , checkRelativeLink "xx/yy/zz" "" "aa/bb/cc/" "aa/bb/cc" + , checkRelativeLink "xx/yy/zz" "" "aa/bb/cc/." "aa/bb/cc" + , checkRelativeLink "xx/yy/zz" "" "aa/bb/cc/.." "aa/bb" + , checkRelativeLink "xx/yy/zz" "X" "aa/bb/cc/" "aa/bb/cc" + , checkRelativeLink "xx/yy/zz" "X" "aa/bb/cc/." "aa/bb/cc" + , checkRelativeLink "xx/yy/zz" "X" "aa/bb/cc/.." "aa/bb" + , checkRelativeLink "xx/yy/zz" "a" "a/bb/cc" "bb/cc" + , checkRelativeLink "xx/yy" "a/b" "a/b/cc" "cc" + ] + + +-- Section 6 ------------------------------------------------------------------------ + +props4relativeLink :: [(String, FilePath -> FilePath -> Property)] +props4relativeLink = [ ("propRelativeLinkStaysRelative root", propRelativeLinkStaysRelative root) + , ("propRelativeLinkStaysRelative wd", propRelativeLinkStaysRelative wd) + , ("propRelativeLinkIsNotAbsolute root", propRelativeLinkIsNotAbsolute root) + , ("propRelativeLinkIsNotAbsolute wd", propRelativeLinkIsNotAbsolute wd) + , ("propSubRelativeLinkIsTarget root", propSubRelativeLinkIsTarget root) + , ("propSubRelativeLinkIsTarget wd", propSubRelativeLinkIsTarget wd) + ] + +propRelativeLinkStaysRelative :: FilePath -> FilePath -> FilePath -> Property +propRelativeLinkStaysRelative wd p1 = property . isRelative . relativeLink wd p1 + +propRelativeLinkIsNotAbsolute :: FilePath -> FilePath -> FilePath -> Property +propRelativeLinkIsNotAbsolute wd p1 = property . not. isAbsolute . relativeLink wd p1 + +propSubRelativeLinkIsTarget :: FilePath -> FilePath -> FilePath -> Property +propSubRelativeLinkIsTarget wd p1 p2 = + let rl = relativeLink wd (p1 "symlink") p2 + abs p = if isAbsolute p then p else (pathSeparator:wd) p + in property (reduceFilePath (abs p2) == reduceFilePath (abs p1 rl)) + + +-- Section 7 ------------------------------------------------------------------------ + +checks4pairs :: Test +checks4pairs = + let checkPairs xs ps = TestCase (assertEqual "pairs" ps (pairs xs)) + in TestList + [ + -- Null and one element + checkPairs [] ([] :: [(Int,Int)]) + , checkPairs [0] [] + + -- One pair + , checkPairs [0,0] [(0,0)] + , checkPairs [0,1] [(0,1)] + , checkPairs [1,0] [(1,0)] + + -- Three pairs + , checkPairs [0,0,0] [(0,0),(0,0),(0,0)] + , checkPairs [0,0,2] [(0,0),(0,2),(0,2)] + , checkPairs [0,1,0] [(0,1),(0,0),(1,0)] + , checkPairs [0,1,1] [(0,1),(0,1),(1,1)] + , checkPairs [0,1,2] [(0,1),(0,2),(1,2)] + , checkPairs [1,0,2] [(1,0),(1,2),(0,2)] + , checkPairs [2,1,0] [(2,1),(2,0),(1,0)] + , checkPairs [0,2,1] [(0,2),(0,1),(2,1)] + ] + + +-- Section 8 ------------------------------------------------------------------------ + +checks4unpairsPairs :: Test +checks4unpairsPairs = + let l = [[],[0,0],[0,1],[1,0],[0,0,0],[0,0,2],[0,1,0],[0,1,1],[0,1,2],[1,0,2],[2,1,0],[0,2,1]] + in TestCase (assertEqual "unpairs/pairs" l (map (unpairs.pairs) l)) + +props4unpairsPairs :: [(String, [Int] -> Property)] +props4unpairsPairs = [("propUnpairsPairsId", propUnpairsPairsId)] + +propUnpairsPairsId :: [Int] -> Property +propUnpairsPairsId xs = length xs /= 1 ==> xs == (unpairs.pairs) xs + + +-- Section 9 ------------------------------------------------------------------------ + +check4compElems :: Test +check4compElems = + let checkCompElems xs ys ts = TestCase (assertEqual "compElems" ts (compElems xs ys)) + in TestList + [ checkCompElems ([]::[Int]) [] ([],[],[]) + , checkCompElems [0..9] [] ([],[0..9],[]) + , checkCompElems [] [0..9] ([],[],[0..9]) + , checkCompElems [0..9] [0..9] ([0..9],[],[]) + , checkCompElems [0..9] [10..19] ([],[0..9],[10..19]) + , checkCompElems [0..9] [0..19] ([0..9],[],[10..19]) + , checkCompElems [0..19] [0..9] ([0..9],[10..19],[]) + , checkCompElems [0..19] [-9..9] ([0..9],[10..19],[-9..(-1)]) + ] + +props4check4compElems :: [(String,[Int] -> [Int] -> Property)] +props4check4compElems = [("propCompElemsDisjoint",propCompElemsDisjoint) + ,("propCompElemsComplete",propCompElemsComplete) + ] + +propCompElemsDisjoint :: [Int] -> [Int] -> Property +propCompElemsDisjoint xs ys = let (same, unique1, unique2) = compElems xs ys + in property ( + null (same `intersect` unique1) && + null (same `intersect` unique2) && + null (unique1 `intersect` unique2) + ) + +propCompElemsComplete :: [Int] -> [Int] -> Property +propCompElemsComplete xs ys = let (same, unique1, unique2) = compElems xs ys + in property ( + sort (nub xs) == sort (same++unique1) && + sort (nub ys) == sort (same++unique2) + ) + + +-- Section 10 ----------------------------------------------------------------------- + +checks4subdirectory :: Test +checks4subdirectory = + let checkSubdirectory d1 d2 b = TestCase (assertEqual "subdirectory" b (d1 `subdirectory` d2)) + in TestList + [ checkSubdirectory "/" "/" True + , checkSubdirectory "/" "/." True + , checkSubdirectory "/." "/" True + , checkSubdirectory "/." "/." True + , checkSubdirectory "/" "/.." True + , checkSubdirectory "/.." "/" True + , checkSubdirectory "/.." "/.." True + , checkSubdirectory "/.." "/." True + , checkSubdirectory "/." "/.." True + , checkSubdirectory "/a/b/c" "/x/y/z" False + , checkSubdirectory "/x/y/z" "/a/b/c" False + , checkSubdirectory "/x/y/z" "/x/y/z" True + , checkSubdirectory "/x/y/z" "/x/y" True + , checkSubdirectory "/x/y" "/x/y/z" False + ] + +checks4subdirectories :: Test +checks4subdirectories = + let checkSubdirectories d2 d1 b = TestCase (assertEqual "subdirectories" b (d2 `subdirectories` d1)) + in TestList + [ checkSubdirectories "/" "/" True + , checkSubdirectories "/" "/." True + , checkSubdirectories "/." "/" True + , checkSubdirectories "/." "/." True + , checkSubdirectories "/" "/.." True + , checkSubdirectories "/.." "/" True + , checkSubdirectories "/.." "/.." True + , checkSubdirectories "/.." "/." True + , checkSubdirectories "/." "/.." True + , checkSubdirectories "/a/b/c" "/x/y/z" False + , checkSubdirectories "/x/y/z" "/a/b/c" False + , checkSubdirectories "/x/y/z" "/x/y/z" True + , checkSubdirectories "/x/y/z" "/x/y" True + , checkSubdirectories "/x/y" "/x/y/z" True + ] + +props4Subdirectories :: [(String, FilePath -> FilePath -> Property)] +props4Subdirectories = [ ("propSubdirectory",propSubdirectory) + , ("propSubdirectories",propSubdirectories) + ] + +propSubdirectory :: FilePath -> FilePath -> Property +propSubdirectory d1 d2 = + let d1_ = root d1 + d2_ = root d2 + in property ( + if reduceFilePath d1_ == reduceFilePath d2_ + then d1_ `subdirectory` d2_ + else if d1_ `subdirectory` d2_ + then not (d2_ `subdirectory` d1_) + else if d2_ `subdirectory` d1_ + then not (d1_ `subdirectory` d2_) + else not (d1_ `subdirectory` d2_) && not (d2_ `subdirectory` d1_) + ) + +propSubdirectories :: FilePath -> FilePath -> Property +propSubdirectories d1 d2 = + let d1_ = root d1 + d2_ = root d2 + in property ( + (subdirectories d1_ d2_ && subdirectories d2_ d1_) || + (not (subdirectories d1_ d2_) && not (subdirectories d2_ d1_)) + ) + + +-- Section 11 ----------------------------------------------------------------------- + +checks4aDirectory :: Test +checks4aDirectory = + let check4aDirectory p expected = + TestCase (aDirectory p >>= assertBool "aDirectory" . (expected==)) + in TestList + [ check4aDirectory "/" True + , check4aDirectory "." True + , check4aDirectory ".." True + , check4aDirectory "/etc/passwd" False + , check4aDirectory "/var/run" False + , check4aDirectory "RaNdOmJuNk" False + ] + +checks4aSymbolicLink :: Test +checks4aSymbolicLink = + let check4aSymbolicLink p expected = + TestCase (aSymbolicLink p >>= assertBool "aSymbolicLink" . (expected==)) + in TestList + [ check4aSymbolicLink "/" False + , check4aSymbolicLink "." False + , check4aSymbolicLink ".." False + , check4aSymbolicLink "/etc/passwd" False + , check4aSymbolicLink "/var/run" True + , check4aSymbolicLink "RaNdOmJuNk" False + ] + +checks4anObject :: Test +checks4anObject = + let check4anObject p expected = + TestCase (anObject p >>= assertBool "anObject" . (expected==)) + in TestList + [ check4anObject "/" True + , check4anObject "." True + , check4anObject ".." True + , check4anObject "/etc/passwd" True + , check4anObject "RaNdOmJuNk" False + , check4anObject "/cdrom" True + ] + + +-- Section 12 ----------------------------------------------------------------------- + +checks4putOrPageStrLn :: Test +checks4putOrPageStrLn = + let check4putOrPageStrLn s = + TestCase $ assert (putOrPageStrLn s >>= \e -> unless (e == ExitSuccess) $ exitWith e) + in TestList + [ check4putOrPageStrLn "" + , check4putOrPageStrLn "." + ] + + +-- Section 13 ------------------------------------------------------------------------ + +runTests :: IO ExitCode +runTests = + runCommand "./tests/run-tests.sh dist*/build/*/ghc-*/backstop-*/x/backstop/build/backstop/backstop" + >>= waitForProcess + +-- Section Last --------------------------------------------------------------------- + +verify :: Testable a => a -> IO () +verify t = + do result <- quickCheckResult t + case result of + Success{} -> return () + GaveUp ntest _ _ _ _ _ -> do hPutStrLn stderr ("Gave up after "++show ntest++" tests") + exitWith (ExitFailure (if ntest < 255 then ntest else 255)) + Failure _ _ _ _ _ _ _ reason _ _ _ _ _ -> do hPutStrLn stderr ("Failure: "++reason) + exitWith (ExitFailure 255) + _ -> do hPutStrLn stderr "Not a success" + exitWith (ExitFailure 255)