diff options
| -rw-r--r-- | cabal-helper.cabal | 2 | ||||
| -rw-r--r-- | cabal-plan/.gitignore | 5 | ||||
| -rw-r--r-- | cabal-plan/.gitrepo | 12 | ||||
| -rw-r--r-- | cabal-plan/.travis.yml | 110 | ||||
| -rw-r--r-- | cabal-plan/ChangeLog.md | 50 | ||||
| -rw-r--r-- | cabal-plan/LICENSE.GPLv2 | 339 | ||||
| -rw-r--r-- | cabal-plan/LICENSE.GPLv3 | 674 | ||||
| -rw-r--r-- | cabal-plan/Setup.hs | 2 | ||||
| -rw-r--r-- | cabal-plan/cabal-plan.cabal | 132 | ||||
| -rw-r--r-- | cabal-plan/cabal.project | 4 | ||||
| -rw-r--r-- | cabal-plan/license-report.css | 334 | ||||
| -rw-r--r-- | cabal-plan/src-exe/LicenseReport.hs | 271 | ||||
| -rw-r--r-- | cabal-plan/src-exe/cabal-plan.hs | 856 | ||||
| -rw-r--r-- | cabal-plan/src-topograph/LICENSE | 30 | ||||
| -rw-r--r-- | cabal-plan/src-topograph/Topograph.hs | 527 | ||||
| -rwxr-xr-x | cabal-plan/src/Cabal/Plan.hs | 586 | ||||
| -rw-r--r-- | cabal.project | 3 |
17 files changed, 2 insertions, 3935 deletions
diff --git a/cabal-helper.cabal b/cabal-helper.cabal index f88891c..ddfe77d 100644 --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -79,7 +79,7 @@ common extensions common build-deps build-depends: base < 5 && >= 4.8 , Cabal < 2.5 && >= 2.0 || < 1.26 && >= 1.14 - , cabal-plan < 0.5 && >= 0.3.0.0 + , cabal-plan < 0.6 && >= 0.5.0.0 , clock < 0.8 && >= 0.7.2 , containers < 1 && >= 0.5.5.1 , bytestring < 0.11 && >= 0.9.2.1 diff --git a/cabal-plan/.gitignore b/cabal-plan/.gitignore deleted file mode 100644 index 1b394da..0000000 --- a/cabal-plan/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -*~ -/dist-newstyle/ -/dist/ -/.ghc.environment.* -/cabal.project.local diff --git a/cabal-plan/.gitrepo b/cabal-plan/.gitrepo deleted file mode 100644 index d0ddadd..0000000 --- a/cabal-plan/.gitrepo +++ /dev/null @@ -1,12 +0,0 @@ -; DO NOT EDIT (unless you know what you are doing) -; -; This subdirectory is a git "subrepo", and this file is maintained by the -; git-subrepo command. See https://github.com/git-commands/git-subrepo#readme -; -[subrepo] - remote = ../cabal-plan - branch = target-selector - commit = e36c8ca8d4a2efd1dc83d5fd1f0193ebff3840b9 - parent = ee2f7ab509bdfbad38d54691cf781c08cdba9792 - cmdver = 0.4.0 - method = merge diff --git a/cabal-plan/.travis.yml b/cabal-plan/.travis.yml deleted file mode 100644 index 0cb96f8..0000000 --- a/cabal-plan/.travis.yml +++ /dev/null @@ -1,110 +0,0 @@ -# This Travis job script has been generated by a script via -# -# runghc make_travis_yml_2.hs '-o' '.travis.yml' 'cabal-plan.cabal' -# -# For more information, see https://github.com/hvr/multi-ghc-travis -# -language: c -sudo: false - -git: - submodules: false # whether to recursively clone submodules - -cache: - directories: - - $HOME/.cabal/packages - - $HOME/.cabal/store - -before_cache: - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - # remove files that are regenerated by 'cabal update' - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx - - - rm -rfv $HOME/.cabal/packages/head.hackage - -matrix: - include: - - compiler: "ghc-8.4.3" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.2" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.0.2" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}} - - compiler: "ghc-7.10.3" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}} - - compiler: "ghc-7.8.4" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}} - - compiler: "ghc-7.6.3" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.6.3], sources: [hvr-ghc]}} - -before_install: - - HC=${CC} - - HCPKG=${HC/ghc/ghc-pkg} - - unset CC - - ROOTDIR=$(pwd) - - mkdir -p $HOME/.local/bin - - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" - - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) - - echo $HCNUMVER - -install: - - cabal --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - BENCH=${BENCH---enable-benchmarks} - - TEST=${TEST---enable-tests} - - HADDOCK=${HADDOCK-true} - - INSTALLED=${INSTALLED-true} - - GHCHEAD=${GHCHEAD-false} - - travis_retry cabal update -v - - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - - rm -fv cabal.project cabal.project.local - - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - - "printf 'packages: \".\"\\n' > cabal.project" - - cat cabal.project - - if [ -f "./configure.ac" ]; then - (cd "." && autoreconf -i); - fi - - rm -f cabal.project.freeze - - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all - - rm -rf .ghc.environment.* "."/dist - - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) - -# Here starts the actual work to be performed for the package under test; -# any command which exits with a non-zero exit code causes the build to fail. -script: - # test that source-distributions can be generated - - (cd "." && cabal sdist) - - mv "."/dist/cabal-plan-*.tar.gz ${DISTDIR}/ - - cd ${DISTDIR} || false - - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - - "printf 'packages: cabal-plan-*/*.cabal\\n' > cabal.project" - - cat cabal.project - # this builds all libraries and executables (without tests/benchmarks) - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - - # Build with installed constraints for packages in global-db - - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi - - # build & run tests, build benchmarks - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - # cabal check - - (cd cabal-plan-* && cabal check) - - # haddock - - rm -rf ./dist-newstyle - - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi - -# REGENDATA ["-o",".travis.yml","cabal-plan.cabal"] -# EOF diff --git a/cabal-plan/ChangeLog.md b/cabal-plan/ChangeLog.md deleted file mode 100644 index 4691d9d..0000000 --- a/cabal-plan/ChangeLog.md +++ /dev/null @@ -1,50 +0,0 @@ -# Revision history for `cabal-plan` - -## 0.4.0.0 - -### `lib:cabal-plan` Library - -* New `SearchPlanJson` type to specify strategy for locating `plan.json` -* Add `SearchPlanJson` parameter to `findAndDecodePlanJson` function and change return type -* Expose separate `findProjectRoot` operation - -### `exe:cabal-plan` Executable - -* New command `license-report` (requires Cabal flag `license-report` to be active) - -## 0.3.0.0 - -### `lib:cabal-plan` Library - -* Add support for foreign-lib components. -* Add support for `dist-dir` `plan.json` field. -* Make `Sha256` type abstract and add new `sha256{To,From}ByteString` - conversion functions, as well as the new `parseSha256` function. -* Introduce `FlagName` newtype. -* Add `FromJSONKey`/`ToJSONKey` instances for `UnitId`, `PackageName`, and `PkgId`. - -### `exe:cabal-plan` Executable - -* smart completer for list-bin/list-bins pattern -* new command `topo` (printing out topographic sorting of install-plan) -* `dot` prints component dependency graph. New options: - - `--tred` transitive reduction - - `--tred-weights` Adjust edge thickness during transitive reduction - - `--path-from pkgA --path-from pkgB` Highlight dependency paths from *pkgA* to *pkgB* - - `--revdep pkg` highlight reverse dependencies of pkg in the install plan - -## 0.2.0.0 - -* Add an optional `--builddir` argument to all commands and to `findAndDecodePlanJson` function. -* Add experimental support for underlining. -* Reimplement CLI with `optparse-applicative`. -* Add new sub-command `list-bins` and change semantics of existing `list-bin` sub-cmd. - -### 0.1.1.0 - -* Add `cabal-plan fingerprint` command for printing - sha256 sums of source tarballs. - -## 0.1.0.0 - -* First version. Released on an unsuspecting world. diff --git a/cabal-plan/LICENSE.GPLv2 b/cabal-plan/LICENSE.GPLv2 deleted file mode 100644 index 1f53f40..0000000 --- a/cabal-plan/LICENSE.GPLv2 +++ /dev/null @@ -1,339 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc., - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Lesser General Public License instead.) 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 -this service 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 make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. 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. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the 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 a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE 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. - - 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 -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - <one line to give the program's name and a brief idea of what it does.> - Copyright (C) <year> <name of author> - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 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, write to the Free Software Foundation, Inc., - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) year name of author - Gnomovision 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, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - <signature of Ty Coon>, 1 April 1989 - Ty Coon, President of Vice - -This 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. diff --git a/cabal-plan/LICENSE.GPLv3 b/cabal-plan/LICENSE.GPLv3 deleted file mode 100644 index 45644ff..0000000 --- a/cabal-plan/LICENSE.GPLv3 +++ /dev/null @@ -1,674 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU General Public License is a free, copyleft license for -software and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - <one line to give the program's name and a brief idea of what it does.> - Copyright (C) <year> <name of author> - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. - -Also add information on how to contact you by electronic and paper mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - <program> Copyright (C) <year> <name of author> - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -<http://www.gnu.org/licenses/>. - - The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -<http://www.gnu.org/philosophy/why-not-lgpl.html>. diff --git a/cabal-plan/Setup.hs b/cabal-plan/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/cabal-plan/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cabal-plan/cabal-plan.cabal b/cabal-plan/cabal-plan.cabal deleted file mode 100644 index 72aaccd..0000000 --- a/cabal-plan/cabal-plan.cabal +++ /dev/null @@ -1,132 +0,0 @@ -cabal-version: 2.0 -name: cabal-plan -version: 0.4.0.0 - -synopsis: Library and utiltity for processing cabal's plan.json file -description: { -This package provides a library for decoding @plan.json@ files as -well as the simple tool @cabal-plan@ for extracting and pretty printing -the information contained in the @plan.json@ file. -. -@plan.json@ files are generated by [cabal](https://hackage.haskell.org/package/cabal-install)'s [nix-style local builds](http://cabal.readthedocs.io/en/latest/nix-local-build.html) and contain detailed information about the build/install plan computed by the cabal solver. -} - -bug-reports: https://github.com/hvr/cabal-plan/issues -X-SPDX-License-Identifier: GPL-2.0-or-later -license: GPL-2 -license-files: LICENSE.GPLv2 LICENSE.GPLv3 src-topograph/LICENSE -author: Herbert Valerio Riedel -maintainer: hvr@gnu.org -copyright: 2016 Herbert Valerio Riedel -category: Development -build-type: Simple - -tested-with: - GHC==8.4.3, - GHC==8.2.2, - GHC==8.0.2, - GHC==7.10.3, - GHC==7.8.4, - GHC==7.6.3 - -extra-source-files: - ChangeLog.md - ----------------------------------------------------------------------------- - -flag exe - -- this automatic flag allows the cabal solver to disable the exe:cabal-plan component (& its build-deps); - -- IOW, emulate https://github.com/haskell/cabal/issues/4660 - description: Enable @exe:cabal-plan@ component - -flag license-report - description: Enable @license-report@ sub-command (only relevant when the @exe@ flag is active) - manual: True - default: False - -flag _ - description: Enable underlining of primary unit-ids - manual: True - default: False - -library - default-language: Haskell2010 - other-extensions: OverloadedStrings - GeneralizedNewtypeDeriving - RecordWildCards - exposed-modules: Cabal.Plan - - build-depends: base (>= 4.6 && <4.10) || ^>= 4.10 || ^>=4.11 - , aeson ^>= 1.2.0 || ^>= 1.3.0 || ^>=1.4.0.0 - , bytestring ^>= 0.10.0 - , containers ^>= 0.5.0 - , text ^>= 1.2.2 - , directory ^>= 1.2.0 || ^>= 1.3.0 - , filepath ^>= 1.3.0 || ^>= 1.4.0 - , base16-bytestring ^>= 0.1.1 - - hs-source-dirs: src - - ghc-options: -Wall - -library topograph - default-language: Haskell2010 - other-extensions: RankNTypes ScopedTypeVariables RecordWildCards - exposed-modules: Topograph - - build-depends: base (>= 4.6 && <4.10) || ^>= 4.10 || ^>= 4.11 - , base-compat ^>= 0.9.3 || ^>=0.10.1 - , base-orphans ^>= 0.6 || ^>=0.7 || ^>=0.8 - , containers ^>= 0.5.0 - , vector ^>= 0.12.0.1 - - hs-source-dirs: src-topograph - -executable cabal-plan - default-language: Haskell2010 - other-extensions: RecordWildCards - - hs-source-dirs: src-exe - main-is: cabal-plan.hs - other-modules: Paths_cabal_plan, LicenseReport - autogen-modules: Paths_cabal_plan - - if flag(exe) - -- dependencies w/ inherited version ranges via 'cabal-plan' library - build-depends: cabal-plan - , topograph - , base - , text - , containers - , bytestring - , directory - - -- dependencies which require version bounds - build-depends: mtl ^>= 2.2.1 - , ansi-terminal ^>= 0.6.2 || ^>= 0.8.0.2 - , base-compat ^>= 0.9.3 || ^>=0.10.1 - , optparse-applicative ^>= 0.13.0 || ^>= 0.14.0 - , parsec ^>= 3.1.11 - , vector ^>= 0.12.0.1 - - - if flag(license-report) - build-depends: Cabal ^>= 2.2.0.1 - , tar ^>= 0.5.1.0 - , zlib ^>= 0.6.2 - , filepath ^>= 1.4.1.2 - - if !impl(ghc >= 8.0) - build-depends: - semigroups ^>= 0.18.3 - - if flag(_) - cpp-options: -DUNDERLINE_SUPPORT - else - buildable: False - - ghc-options: -Wall - -source-repository head - type: git - location: https://github.com/hvr/cabal-plan diff --git a/cabal-plan/cabal.project b/cabal-plan/cabal.project deleted file mode 100644 index 0c693dc..0000000 --- a/cabal-plan/cabal.project +++ /dev/null @@ -1,4 +0,0 @@ -packages: . - -package cabal-plan - flags: +exe +license-report diff --git a/cabal-plan/license-report.css b/cabal-plan/license-report.css deleted file mode 100644 index a5ffa72..0000000 --- a/cabal-plan/license-report.css +++ /dev/null @@ -1,334 +0,0 @@ -/* from https://gist.github.com/killercup/5917178 declared as public domain or CC0 - * - * pandoc -c license-report.css --self-contained -s license.md > license.html - * - */ - -html { - font-size: 100%; - overflow-y: scroll; - -webkit-text-size-adjust: 100%; - -ms-text-size-adjust: 100%; -} - -body { - color: #444; - font-family: Georgia, Palatino, 'Palatino Linotype', Times, 'Times New Roman', serif; - font-size: 12px; - line-height: 1.7; - padding: 1em; - margin: auto; - /* max-width: 42em; */ - background: #fefefe; -} - -a { - color: #0645ad; - text-decoration: none; -} - -a:visited { - color: #0b0080; -} - -a:hover { - color: #06e; -} - -a:active { - color: #faa700; -} - -a:focus { - outline: thin dotted; -} - -*::-moz-selection { - background: rgba(255, 255, 0, 0.3); - color: #000; -} - -*::selection { - background: rgba(255, 255, 0, 0.3); - color: #000; -} - -a::-moz-selection { - background: rgba(255, 255, 0, 0.3); - color: #0645ad; -} - -a::selection { - background: rgba(255, 255, 0, 0.3); - color: #0645ad; -} - -p { - margin: 1em 0; -} - -img { - max-width: 100%; -} - -h1, h2, h3, h4, h5, h6 { - color: #111; - line-height: 125%; - margin-top: 2em; - font-weight: normal; -} - -h4, h5, h6 { - font-weight: bold; -} - -h1 { - font-size: 2.5em; -} - -h2 { - font-size: 2em; -} - -h3 { - font-size: 1.5em; -} - -h4 { - font-size: 1.2em; -} - -h5 { - font-size: 1em; -} - -h6 { - font-size: 0.9em; -} - -blockquote { - color: #666666; - margin: 0; - padding-left: 3em; - border-left: 0.5em #EEE solid; -} - -hr { - display: block; - height: 2px; - border: 0; - border-top: 1px solid #aaa; - border-bottom: 1px solid #eee; - margin: 1em 0; - padding: 0; -} - -pre, code, kbd, samp { - color: #000; - font-family: monospace, monospace; - _font-family: 'courier new', monospace; - font-size: 0.98em; -} - -pre { - white-space: pre; - white-space: pre-wrap; - word-wrap: break-word; -} - -b, strong { - font-weight: bold; -} - -dfn { - font-style: italic; -} - -ins { - background: #ff9; - color: #000; - text-decoration: none; -} - -mark { - background: #ff0; - color: #000; - font-style: italic; - font-weight: bold; -} - -sub, sup { - font-size: 75%; - line-height: 0; - position: relative; - vertical-align: baseline; -} - -sup { - top: -0.5em; -} - -sub { - bottom: -0.25em; -} - -ul, ol { - margin: 1em 0; - padding: 0 0 0 2em; -} - -li p:last-child { - margin-bottom: 0; -} - -ul ul, ol ol { - margin: .3em 0; -} - -dl { - margin-bottom: 1em; -} - -dt { - font-weight: bold; - margin-bottom: .8em; -} - -dd { - margin: 0 0 .8em 2em; -} - -dd:last-child { - margin-bottom: 0; -} - -img { - border: 0; - -ms-interpolation-mode: bicubic; - vertical-align: middle; -} - -figure { - display: block; - text-align: center; - margin: 1em 0; -} - -figure img { - border: none; - margin: 0 auto; -} - -figcaption { - font-size: 0.8em; - font-style: italic; - margin: 0 0 .8em; -} - -table { - margin-bottom: 2em; - border-bottom: 1px solid #ddd; - border-right: 1px solid #ddd; - border-spacing: 0; - border-collapse: collapse; -} - -table th { - padding: .2em 1em; - background-color: #eee; - border-top: 1px solid #ddd; - border-left: 1px solid #ddd; -} - -table td { - padding: .2em 1em; - border-top: 1px solid #ddd; - border-left: 1px solid #ddd; - vertical-align: top; -} - -table tr.even { - background-color: #fbfbfb; -} - -.author { - font-size: 1.2em; - text-align: center; -} - -@media only screen and (min-width: 480px) { - body { - font-size: 14px; - } -} -@media only screen and (min-width: 768px) { - body { - font-size: 16px; - } -} -@media print { - * { - background: transparent !important; - color: black !important; - filter: none !important; - -ms-filter: none !important; - } - - body { - font-size: 12pt; - max-width: 100%; - } - - a, a:visited { - text-decoration: underline; - } - - hr { - height: 1px; - border: 0; - border-bottom: 1px solid black; - } - - a[href]:after { - content: " (" attr(href) ")"; - } - - abbr[title]:after { - content: " (" attr(title) ")"; - } - - .ir a:after, a[href^="javascript:"]:after, a[href^="#"]:after { - content: ""; - } - - pre, blockquote { - border: 1px solid #999; - padding-right: 1em; - page-break-inside: avoid; - } - - tr, img { - page-break-inside: avoid; - } - - img { - max-width: 100% !important; - } - - @page :left { - margin: 15mm 20mm 15mm 10mm; -} - - @page :right { - margin: 15mm 10mm 15mm 20mm; -} - - p, h2, h3 { - orphans: 3; - widows: 3; - } - - h2, h3 { - page-break-after: avoid; - } -} diff --git a/cabal-plan/src-exe/LicenseReport.hs b/cabal-plan/src-exe/LicenseReport.hs deleted file mode 100644 index 7afe4e7..0000000 --- a/cabal-plan/src-exe/LicenseReport.hs +++ /dev/null @@ -1,271 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - --- | Implements @cabal-plan license-report@ functionality -module LicenseReport - ( generateLicenseReport - ) where - -#if defined(MIN_VERSION_Cabal) -import Cabal.Plan -import qualified Codec.Archive.Tar as Tar -import qualified Codec.Archive.Tar.Entry as Tar -import qualified Codec.Compression.GZip as GZip -import Control.Monad.Compat (forM, forM_, guard, unless, when) -import qualified Data.ByteString.Lazy as BSL -import qualified Data.ByteString as BS -import Data.Map (Map) -import Data.List (nub) -import qualified Data.Map as Map -import Data.Semigroup -import Data.Set (Set) -import qualified Data.Set as Set -import qualified Data.Text as T -import qualified Data.Text.IO as T -import qualified Data.Version as DV -import Distribution.PackageDescription -import Distribution.PackageDescription.Parsec -import Distribution.Pretty -import System.Directory -import System.FilePath -import System.IO (stderr) -import Text.ParserCombinators.ReadP -import Prelude () -import Prelude.Compat - --- | Read tarball lazily (and possibly decompress) -readTarEntries :: FilePath -> IO [Tar.Entry] -readTarEntries idxtar = do - es <- case takeExtension idxtar of - ".gz" -> Tar.read . GZip.decompress <$> BSL.readFile idxtar - ".tar" -> Tar.read <$> BSL.readFile idxtar - ext -> error ("unknown extension " ++ show ext) - - return (Tar.foldEntries (:) [] (\err -> error ("readTarEntries " ++ show err)) es) - -fp2pid :: FilePath -> Maybe PkgId -fp2pid fn0 = do - [pns,pvs,rest] <- Just (splitDirectories fn0) - guard (rest == pns <.> "cabal") - pv <- parseVer pvs - pure (PkgId (PkgName $ T.pack pns) pv) - - -parseVer :: String -> Maybe Ver -parseVer str = case reverse $ readP_to_S DV.parseVersion str of - (ver, "") : _ | not (null (DV.versionBranch ver)), all (>= 0) (DV.versionBranch ver) - -> Just (Ver $ DV.versionBranch ver) - _ -> Nothing - - -readHackageIndex :: IO [(PkgId, BSL.ByteString)] -readHackageIndex = do - -- TODO: expose package index configuration as CLI flag - cabalPkgCacheDir <- getAppUserDataDirectory "cabal/packages/hackage.haskell.org" - ents <- readTarEntries (cabalPkgCacheDir </> "01-index.tar") - - pure [ (maybe (error $ show n) id $ fp2pid n,bsl) - | e@(Tar.Entry { Tar.entryContent = Tar.NormalFile bsl _ }) <- ents - , let n = Tar.entryPath e - , takeExtension n == ".cabal" - ] - -getLicenseFiles :: PkgId -> UnitId -> [FilePath] -> IO [BS.ByteString] -getLicenseFiles compilerId (UnitId uidt) fns = do - storeDir <- getAppUserDataDirectory "cabal/store" - let docDir = storeDir </> T.unpack (dispPkgId compilerId) </> T.unpack uidt </> "share" </> "doc" - forM fns $ \fn -> BS.readFile (docDir </> fn) - -{- WARNING: the code that follows will make you cry; a safety pig is provided below for your benefit. - - _ - _._ _..._ .-', _.._(`)) -'-. ` ' /-._.-' ',/ - ) \ '. - / _ _ | \ - | a a / | - \ .-. ; - '-('' ).-' ,' ; - '-; | .' - \ \ / - | 7 .__ _.-\ \ - | | | ``/ /` / - /,_| | /,_/ / - /,_/ '`-' - --} - --- TODO: emit report to Text or Text builder -generateLicenseReport :: Maybe FilePath -> PlanJson -> UnitId -> CompName -> IO () -generateLicenseReport mlicdir plan uid0 cn0 = do - let pidsOfInterest = Set.fromList (map uPId (Map.elems $ pjUnits plan)) - - indexDb <- Map.fromList . filter (flip Set.member pidsOfInterest . fst) <$> readHackageIndex - - let -- generally, units belonging to the same package as 'root' - rootPkgUnits = [ u | u@(Unit { uPId = PkgId pn' _ }) <- Map.elems (pjUnits plan), pn' == pn0 ] - rootPkgUnitIds = Set.fromList (map uId rootPkgUnits) - - -- the component of interest - Just root@Unit { uPId = PkgId pn0 _ } = Map.lookup uid0 (pjUnits plan) - - fwdDeps = planJsonIdGraph' plan - revDeps = invertMap fwdDeps - - let transUids = transDeps fwdDeps (uId root) Set.\\ rootPkgUnitIds - - indirectDeps = Set.fromList [ u | u <- Set.toList transUids, Set.null (Map.findWithDefault mempty u revDeps `Set.intersection` rootPkgUnitIds) ] - - directDeps = transUids Set.\\ indirectDeps - - - let printInfo :: UnitId -> IO () - printInfo uid = do - let Just u = Map.lookup uid (pjUnits plan) - - PkgId (PkgName pn) pv = uPId u - - case BSL.toStrict <$> Map.lookup (uPId u) indexDb of - Nothing - | PkgId (PkgName "rts") _ <- uPId u -> pure () - | otherwise -> fail (show u) - - Just x -> do - gpd <- maybe (fail "parseGenericPackageDescriptionMaybe") pure $ - parseGenericPackageDescriptionMaybe x - - let desc = escapeDesc $ synopsis $ packageDescription gpd - lic = license $ packageDescription gpd - -- cr = copyright $ packageDescription gpd - lfs = licenseFiles $ packageDescription gpd - - usedBy = Set.fromList [ uPId (Map.findWithDefault undefined unit (pjUnits plan)) - | unit <- Set.toList (Map.findWithDefault mempty uid revDeps) - , unit `Set.member` (directDeps <> indirectDeps) - ] - - let url = "http://hackage.haskell.org/package/" <> dispPkgId (uPId u) - - isB = uType u == UnitTypeBuiltin - - -- special core libs whose reverse deps are too noisy - baseLibs = ["base", "ghc-prim", "integer-gmp", "integer-simple", "rts"] - - licurl = case lfs of - [] -> url - (l:_) - | Just licdir <- mlicdir, uType u == UnitTypeGlobal -> T.pack (licdir </> T.unpack (dispPkgId (uPId u)) </> takeFileName l) - | otherwise -> url <> "/src/" <> T.pack l - - T.putStrLn $ mconcat - [ if isB then "| **`" else "| `", pn, if isB then "`** | [`" else "` | [`", dispVer pv, "`](", url , ")", " | " - , "[`", T.pack (prettyShow lic), "`](", licurl , ")", " | " - , T.pack desc, " | " - , if pn `elem` baseLibs then "*(core library)*" - else T.intercalate ", " [ T.singleton '`' <> (j :: T.Text) <> "`" | PkgId (z@(PkgName j)) _ <- Set.toList usedBy, z /= pn0], " |" - ] - - -- print (pn, pv, prettyShow lic, cr, lfs, [ j | PkgId (PkgName j) _ <- Set.toList usedBy ]) - - forM_ mlicdir $ \licdir -> do - - case uType u of - UnitTypeGlobal -> do - let lfs' = nub (map takeFileName lfs) - - when (length lfs' /= length lfs) $ do - T.hPutStrLn stderr ("WARNING: Overlapping license filenames for " <> dispPkgId (uPId u)) - - crdat <- getLicenseFiles (pjCompilerId plan) uid lfs' - - forM_ (zip lfs' crdat) $ \(fn,txt) -> do - let d = licdir </> T.unpack (dispPkgId (uPId u)) - createDirectoryIfMissing True d - BS.writeFile (d </> fn) txt - - -- forM_ crdat $ print - pure () - - -- TODO: - -- UnitTypeBuiltin - -- UnitTypeLocal - -- UnitTypeInplace - - UnitTypeBuiltin -> T.hPutStrLn stderr ("WARNING: license files for " <> dispPkgId (uPId u) <> " (global/GHC bundled) not copied") - UnitTypeLocal -> T.hPutStrLn stderr ("WARNING: license files for " <> dispPkgId (uPId u) <> " (project-local package) not copied") - UnitTypeInplace -> T.hPutStrLn stderr ("WARNING: license files for " <> dispPkgId (uPId u) <> " (project-inplace package) not copied") - - unless (length lfs == Set.size (Set.fromList lfs)) $ - fail ("internal invariant broken for " <> show (uPId u)) - - pure () - - T.putStrLn "# Dependency License Report" - T.putStrLn "" - T.putStrLn ("Bold-faced **`package-name`**s denote standard libraries bundled with `" <> dispPkgId (pjCompilerId plan) <> "`.") - T.putStrLn "" - - T.putStrLn ("## Direct dependencies of `" <> unPkgN pn0 <> ":" <> dispCompNameTarget pn0 cn0 <> "`") - T.putStrLn "" - T.putStrLn "| Name | Version | [SPDX](https://spdx.org/licenses/) License Id | Description | Also depended upon by |" - T.putStrLn "| --- | --- | --- | --- | --- |" - forM_ directDeps $ printInfo - T.putStrLn "" - - T.putStrLn "## Indirect transitive dependencies" - T.putStrLn "" - T.putStrLn "| Name | Version | [SPDX](https://spdx.org/licenses/) License Id | Description | Depended upon by |" - T.putStrLn "| --- | --- | --- | --- | --- |" - forM_ indirectDeps $ printInfo - T.putStrLn "" - - pure () - -escapeDesc :: String -> String -escapeDesc [] = [] -escapeDesc ('\n':rest) = ' ':escapeDesc rest -escapeDesc ('|':rest) = '\\':'|':escapeDesc rest -escapeDesc (x:xs) = x:escapeDesc xs - -unPkgN :: PkgName -> T.Text -unPkgN (PkgName t) = t - -planItemAllLibDeps :: Unit -> Set.Set UnitId -planItemAllLibDeps Unit{..} = mconcat [ ciLibDeps | (cn,CompInfo{..}) <- Map.toList uComps, wantC cn ] - where - wantC (CompNameSetup) = False - wantC (CompNameTest _) = False - wantC (CompNameBench _) = False - wantC _ = True - -planJsonIdGraph':: PlanJson -> Map UnitId (Set UnitId) -planJsonIdGraph' PlanJson{..} = Map.fromList [ (uId unit, planItemAllLibDeps unit) | unit <- Map.elems pjUnits ] - - - -invertMap :: Ord k => Map k (Set k) -> Map k (Set k) -invertMap m0 = Map.fromListWith mappend [ (v, Set.singleton k) | (k,vs) <- Map.toList m0, v <- Set.toList vs ] - -transDeps :: Map UnitId (Set UnitId) -> UnitId -> Set UnitId -transDeps g n0 = go mempty [n0] - where - go :: Set UnitId -> [UnitId] -> Set UnitId - go acc [] = acc - go acc (n:ns) - | Set.member n acc = go acc ns - | otherwise = go (Set.insert n acc) (ns ++ Set.toList (Map.findWithDefault undefined n g)) - -#else - ----------------------------------------------------------------------------- -import Cabal.Plan -import System.Exit -import System.IO - -generateLicenseReport :: Maybe FilePath -> PlanJson -> UnitId -> CompName -> IO () -generateLicenseReport _ _ _ _ = do - hPutStrLn stderr "ERROR: `cabal-plan license-report` sub-command not available! Please recompile/reinstall `cabal-plan` with the `license-report` Cabal flag activated." - exitFailure - -#endif diff --git a/cabal-plan/src-exe/cabal-plan.hs b/cabal-plan/src-exe/cabal-plan.hs deleted file mode 100644 index fd1cc72..0000000 --- a/cabal-plan/src-exe/cabal-plan.hs +++ /dev/null @@ -1,856 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - -module Main where - -import Prelude () -import Prelude.Compat - -import Control.Monad.Compat (forM_, guard, unless, when) -import Control.Monad.RWS.Strict (RWS, evalRWS, gets, modify', tell) -import Control.Monad.ST (runST) -import Data.Char (isAlphaNum) -import Data.Foldable (for_, toList) -import qualified Data.Graph as G -import Data.Map (Map) -import qualified Data.Map as M -import Data.Maybe (fromMaybe, isJust, mapMaybe) -import Data.Monoid (Any (..)) -import Data.Semigroup (Semigroup (..)) -import Data.Set (Set) -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Text.IO as T -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Builder as LT -import qualified Data.Text.Lazy.IO as LT -import qualified Data.Tree as Tr -import Data.Tuple (swap) -import qualified Data.Vector.Unboxed as U -import qualified Data.Vector.Unboxed.Mutable as MU -import Data.Version -import Options.Applicative -import System.Console.ANSI -import System.Directory (getCurrentDirectory) -import System.Exit (exitFailure) -import System.IO (hPutStrLn, stderr) -import qualified Text.Parsec as P -import qualified Text.Parsec.String as P -import qualified Topograph as TG - -import Cabal.Plan -import LicenseReport (generateLicenseReport) -import Paths_cabal_plan (version) - -haveUnderlineSupport :: Bool -#if defined(UNDERLINE_SUPPORT) -haveUnderlineSupport = True -#else -haveUnderlineSupport = False -#endif - -data GlobalOptions = GlobalOptions - { buildDir :: Maybe FilePath - , optsShowBuiltin :: Bool - , optsShowGlobal :: Bool - , cmd :: Command - } - -data Command - = InfoCommand - | ShowCommand - | FingerprintCommand - | ListBinsCommand MatchCount [Pattern] - | DotCommand Bool Bool [Highlight] - | TopoCommand Bool - | LicenseReport (Maybe FilePath) Pattern - -------------------------------------------------------------------------------- --- Pattern -------------------------------------------------------------------------------- - --- | patterns are @[[pkg:]kind;]cname@ -data Pattern = Pattern (Maybe T.Text) (Maybe CompType) (Maybe T.Text) - deriving (Show, Eq) - -data CompType = CompTypeLib | CompTypeFLib | CompTypeExe | CompTypeTest | CompTypeBench | CompTypeSetup - deriving (Show, Eq, Enum, Bounded) - -parsePattern :: String -> Either String Pattern -parsePattern = either (Left . show) Right . P.runParser (patternP <* P.eof) () "<argument>" - where - patternP = do - -- first we parse up to 3 tokens - x <- tokenP - y <- optional $ do - _ <- P.char ':' - y <- tokenP - z <- optional $ P.char ':' >> tokenP - return (y, z) - -- then depending on how many tokens we got, we make a pattern - case y of - Nothing -> return $ Pattern Nothing Nothing x - Just (y', Nothing) -> do - t <- traverse toCompType x - return $ Pattern Nothing t y' - Just (y', Just z') -> do - t <- traverse toCompType y' - return $ Pattern x t z' - - tokenP :: P.Parser (Maybe T.Text) - tokenP = - Nothing <$ P.string "*" - <|> (Just . T.pack <$> some (P.satisfy (\c -> isAlphaNum c || c `elem` ("-_" :: String))) P.<?> "part of pattern") - - toCompType :: T.Text -> P.Parser CompType - toCompType "bench" = return $ CompTypeBench - toCompType "exe" = return $ CompTypeExe - toCompType "lib" = return $ CompTypeLib - toCompType "flib" = return $ CompTypeFLib - toCompType "setup" = return $ CompTypeSetup - toCompType "test" = return $ CompTypeTest - toCompType t = fail $ "Unknown component type: " ++ show t - -patternCompleter :: Bool -> Completer -patternCompleter onlyWithExes = mkCompleter $ \pfx -> do - plan <- getCurrentDirectory >>= findAndDecodePlanJson . ProjectRelativeToDir - let tpfx = T.pack pfx - components = findComponents plan - - -- One scenario - -- $ cabal-plan list-bin cab<TAB> - -- $ cabal-plan list-bin cabal-plan<TAB> - -- $ cabal-plan list-bin cabal-plan:exe:cabal-plan - -- - -- Note: if this package had `tests` -suite, then we can - -- $ cabal-plan list-bin te<TAB> - -- $ cabal-plan list-bin tests<TAB> - -- $ cabal-plan list-bin cabal-plan:test:tests - -- - -- *BUT* at least zsh script have to be changed to complete from non-prefix. - return $ map T.unpack $ firstNonEmpty - -- 1. if tpfx matches component exacty, return full path - [ single $ map fst $ filter ((tpfx ==) . snd) components - - -- 2. match component parts - , uniques $ filter (T.isPrefixOf tpfx) $ map snd components - - -- otherwise match full paths - , filter (T.isPrefixOf tpfx) $ map fst components - ] - where - firstNonEmpty :: [[a]] -> [a] - firstNonEmpty [] = [] - firstNonEmpty ([] : xss) = firstNonEmpty xss - firstNonEmpty (xs : _) = xs - - -- single - single :: [a] -> [a] - single xs@[_] = xs - single _ = [] - - -- somewhat like 'nub' but drop duplicate names. Doesn't preserve order - uniques :: Ord a => [a] -> [a] - uniques = M.keys . M.filter (== 1) . M.fromListWith (+) . map (\x -> (x, 1 :: Int)) - - impl :: Bool -> Bool -> Bool - impl False _ = True - impl True x = x - - -- returns (full, cname) pair - findComponents :: PlanJson -> [(T.Text, T.Text)] - findComponents plan = do - (_, Unit{..}) <- M.toList $ pjUnits plan - (cn, ci) <- M.toList $ uComps - - -- if onlyWithExes, component should have binFile - guard (onlyWithExes `impl` isJust (ciBinFile ci)) - - let PkgId pn@(PkgName pnT) _ = uPId - g = pnT <> T.pack":" <> dispCompNameTarget pn cn - - let cnT = extractCompName pn cn - [ (g, cnT) ] - -compNameType :: CompName -> CompType -compNameType CompNameLib = CompTypeLib -compNameType (CompNameSubLib _) = CompTypeLib -compNameType (CompNameFLib _) = CompTypeFLib -compNameType (CompNameExe _) = CompTypeExe -compNameType (CompNameTest _) = CompTypeTest -compNameType (CompNameBench _) = CompTypeBench -compNameType CompNameSetup = CompTypeSetup - -checkPattern :: Pattern -> PkgName -> CompName -> Any -checkPattern (Pattern n k c) pn cn = - Any $ nCheck && kCheck && cCheck - where - nCheck = case n of - Nothing -> True - Just pn' -> pn == PkgName pn' - - kCheck = case k of - Nothing -> True - Just k' -> k' == compNameType cn - cCheck = case c of - Nothing -> True - Just c' -> c' == extractCompName pn cn - -extractCompName :: PkgName -> CompName -> T.Text -extractCompName (PkgName pn) CompNameLib = pn -extractCompName (PkgName pn) CompNameSetup = pn -extractCompName _ (CompNameSubLib cn) = cn -extractCompName _ (CompNameFLib cn) = cn -extractCompName _ (CompNameExe cn) = cn -extractCompName _ (CompNameTest cn) = cn -extractCompName _ (CompNameBench cn) = cn - -------------------------------------------------------------------------------- --- Highlight -------------------------------------------------------------------------------- - -data Highlight - = Path Pattern Pattern - | Revdep Pattern - deriving (Show, Eq) - -highlightParser :: Parser Highlight -highlightParser = pathParser <|> revdepParser - where - pathParser = Path - <$> option (eitherReader parsePattern) - (long "path-from" <> metavar "PATTERN" <> help "Highlight dependency paths from ...") - <*> option (eitherReader parsePattern) - (long "path-to" <> metavar "PATTERN") - - revdepParser = Revdep - <$> option (eitherReader parsePattern) - (long "revdep" <> metavar "PATTERN" <> help "Highlight reverse dependencies") - -------------------------------------------------------------------------------- --- Main -------------------------------------------------------------------------------- - -main :: IO () -main = do - GlobalOptions{..} <- execParser $ info (helper <*> optVersion <*> optParser) fullDesc - (searchMethod, mProjRoot) <- case buildDir of - Just dir -> pure (InBuildDir dir, Nothing) - Nothing -> do - cwd <- getCurrentDirectory - root <- findProjectRoot cwd - pure (ProjectRelativeToDir cwd, root) - - plan <- findAndDecodePlanJson searchMethod - case cmd of - InfoCommand -> doInfo mProjRoot plan - ShowCommand -> mapM_ print mProjRoot >> print plan - ListBinsCommand count pats -> do - let bins = doListBin plan pats - case (count, bins) of - (MatchMany, _) -> for_ bins $ \(g, fn) -> - putStrLn (g ++ " " ++ fn) - (MatchOne, [(_,p)]) -> putStrLn p - (MatchOne, []) -> do - hPutStrLn stderr "No matches found." - exitFailure - (MatchOne, _) -> do - hPutStrLn stderr "Found more than one matching pattern:" - for_ bins $ \(p,_) -> hPutStrLn stderr $ " " ++ p - exitFailure - FingerprintCommand -> doFingerprint plan - DotCommand tred tredWeights highlights -> doDot optsShowBuiltin optsShowGlobal plan tred tredWeights highlights - TopoCommand rev -> doTopo optsShowBuiltin optsShowGlobal plan rev - LicenseReport mfp pat -> doLicenseReport mfp pat - where - optVersion = infoOption ("cabal-plan " ++ showVersion version) - (long "version" <> help "output version information and exit") - - optParser = GlobalOptions - <$> dirParser - <*> showHide "builtin" "Show / hide packages in global (non-nix-style) package db" - <*> showHide "global" "Show / hide packages in nix-store" - <*> (cmdParser <|> defaultCommand) - - showHide n d = - flag' True (long ("show-" ++ n) <> help d) - <|> flag' False (long ("hide-" ++ n)) - <|> pure True - - dirParser = optional . strOption $ mconcat - [ long "builddir", metavar "DIR" - , help "Build directory to read plan.json from." ] - - subCommand name desc val = command name $ info val (progDesc desc) - - patternParser = argument (eitherReader parsePattern) . mconcat - - switchM = switch . mconcat - - cmdParser = subparser $ mconcat - [ subCommand "info" "Info" $ pure InfoCommand - , subCommand "show" "Show" $ pure ShowCommand - , subCommand "list-bins" "List All Binaries" . - listBinParser MatchMany . many $ patternParser - [ metavar "PATTERNS...", help "Patterns to match.", completer $ patternCompleter True ] - , subCommand "list-bin" "List Single Binary" . - listBinParser MatchOne $ pure <$> patternParser - [ metavar "PATTERN", help "Pattern to match.", completer $ patternCompleter True ] - , subCommand "fingerprint" "Fingerprint" $ pure FingerprintCommand - , subCommand "dot" "Dependency .dot" $ DotCommand - <$> switchM - [ long "tred", help "Transitive reduction" ] - <*> switchM - [ long "tred-weights", help "Adjust edge thickness during transitive reduction" ] - <*> many highlightParser - <**> helper - , subCommand "topo" "Plan in a topological sort" $ TopoCommand - <$> switchM - [ long "reverse", help "Reverse order" ] - <**> helper - , subCommand "license-report" "Generate license report for a component" $ LicenseReport - <$> optional (strOption $ mconcat [ long "licensedir", metavar "DIR", help "Write per-package license documents to folder" ]) - <*> patternParser - [ metavar "PATTERN", help "Pattern to match.", completer $ patternCompleter False ] - <**> helper - ] - - defaultCommand = pure InfoCommand - -------------------------------------------------------------------------------- --- list-bin -------------------------------------------------------------------------------- - -listBinParser - :: MatchCount - -> Parser [Pattern] - -> Parser Command -listBinParser count pats - = ListBinsCommand count <$> pats <**> helper -data MatchCount = MatchOne | MatchMany - deriving (Show, Eq) - -doListBin :: PlanJson -> [Pattern] -> [(String, FilePath)] -doListBin plan patterns = do - (_, Unit{..}) <- M.toList $ pjUnits plan - (cn, ci) <- M.toList $ uComps - case ciBinFile ci of - Nothing -> [] - Just fn -> do - let PkgId pn@(PkgName pnT) _ = uPId - g = case cn of - CompNameLib -> T.unpack (pnT <> T.pack":lib:" <> pnT) - _ -> T.unpack (pnT <> T.pack":" <> dispCompNameTarget pn cn) - guard . getAny $ patternChecker pn cn - [(g, fn)] - where - patternChecker :: PkgName -> CompName -> Any - patternChecker = case patterns of - [] -> \_ _ -> Any True - _ -> mconcat $ map checkPattern patterns - -------------------------------------------------------------------------------- --- fingerprint -------------------------------------------------------------------------------- - -doFingerprint :: PlanJson -> IO () -doFingerprint plan = do - let pids = M.fromList [ (uPId u, u) | (_,u) <- M.toList (pjUnits plan) ] - - for_ (M.toList pids) $ \(_,Unit{..}) -> do - let h = maybe "________________________________________________________________" - dispSha256 $ uSha256 - case uType of - UnitTypeBuiltin -> T.putStrLn (h <> " B " <> dispPkgId uPId) - UnitTypeGlobal -> T.putStrLn (h <> " G " <> dispPkgId uPId) - UnitTypeLocal -> T.putStrLn (h <> " L " <> dispPkgId uPId) - UnitTypeInplace -> T.putStrLn (h <> " I " <> dispPkgId uPId) - -------------------------------------------------------------------------------- --- info -------------------------------------------------------------------------------- - -doInfo :: Maybe FilePath -> PlanJson -> IO () -doInfo mProjbase plan = do - forM_ mProjbase $ \projbase -> - putStrLn ("using '" ++ projbase ++ "' as project root") - putStrLn "" - putStrLn "Tree" - putStrLn "~~~~" - putStrLn "" - LT.putStrLn (dumpPlanJson plan) - - -- print (findCycles (planJsonIdGrap v)) - - putStrLn "" - putStrLn "Top-sorted" - putStrLn "~~~~~~~~~~" - putStrLn "" - - let xs = toposort (planJsonIdGraph plan) - for_ xs print - - putStrLn "" - putStrLn "Direct deps" - putStrLn "~~~~~~~~~~~" - putStrLn "" - - let locals = [ Unit{..} | Unit{..} <- M.elems pm, uType == UnitTypeLocal ] - pm = pjUnits plan - - for_ locals $ \pitem -> do - print (uPId pitem) - for_ (M.toList $ uComps pitem) $ \(ct,ci) -> do - print ct - for_ (S.toList $ ciLibDeps ci) $ \dep -> do - let Just dep' = M.lookup dep pm - pid = uPId dep' - putStrLn (" " ++ T.unpack (dispPkgId pid)) - putStrLn "" - - return () - -------------------------------------------------------------------------------- --- Dot -------------------------------------------------------------------------------- - --- | vertex of dot graph. --- --- if @'Maybe' 'CompName'@ is Nothing, this is legacy, multi-component unit. -data DotUnitId = DU UnitId (Maybe CompName) - deriving (Eq, Ord, Show) - -planJsonDotUnitGraph :: PlanJson -> Map DotUnitId (Set DotUnitId) -planJsonDotUnitGraph plan = M.fromList $ do - unit <- M.elems units - let mkDU = DU (uId unit) - let mkDeps cname ci = (mkDU (Just cname), deps ci) - case M.toList (uComps unit) of - [(cname, ci)] -> - [ mkDeps cname ci ] - cs -> - [ (mkDU Nothing, S.fromList $ map (mkDU . Just . fst) cs) ] - ++ map (uncurry mkDeps) cs - where - units = pjUnits plan - - unitToDot :: Unit -> DotUnitId - unitToDot unit = DU (uId unit) $ case M.toList (uComps unit) of - [(cname, _)] -> Just cname - _ -> Nothing - - unitIdToDot :: UnitId -> Maybe DotUnitId - unitIdToDot i = unitToDot <$> M.lookup i units - - deps :: CompInfo -> Set DotUnitId - deps CompInfo{..} = - S.fromList $ mapMaybe unitIdToDot $ S.toList $ ciLibDeps <> ciExeDeps - --- | Tree which counts paths under it. -data Tr a = No !Int a [Tr a] - deriving (Show) - -trPaths :: Tr a -> Int -trPaths (No n _ _) = n - --- | Create 'Tr' maintaining the invariant -mkNo :: a -> [Tr a] -> Tr a -mkNo x [] = No 1 x [] -mkNo x xs = No (sum $ map trPaths xs) x xs - -trFromTree :: Tr.Tree a -> Tr a -trFromTree (Tr.Node i is) = mkNo i (map trFromTree is) - -trPairs :: Tr a -> [(Int,a,a)] -trPairs (No _ i js) = - [ (n, i, j) | No n j _ <- js ] ++ concatMap trPairs js - -doDot :: Bool -> Bool -> PlanJson -> Bool -> Bool -> [Highlight] -> IO () -doDot showBuiltin showGlobal plan tred tredWeights highlights = either loopGraph id $ TG.runG am $ \g' -> do - let g = if tred then TG.reduction g' else g' - - -- Highlights - let paths :: [(DotUnitId, DotUnitId)] - paths = flip concatMap highlights $ \h -> case h of - Path a b -> - [ (x, y) - | x <- filter (getAny . checkPatternDotUnit a) $ toList dotUnits - , y <- filter (getAny . checkPatternDotUnit b) $ toList dotUnits - ] - Revdep _ -> [] - - let paths' :: [(DotUnitId, DotUnitId)] - paths' = flip concatMap paths $ \(a, b) -> fromMaybe [] $ do - i <- TG.gToVertex g a - j <- TG.gToVertex g b - pure $ concatMap TG.pairs $ (fmap . fmap) (TG.gFromVertex g) (TG.allPaths g i j) - - let revdeps :: [DotUnitId] - revdeps = flip concatMap highlights $ \h -> case h of - Path _ _ -> [] - Revdep a -> filter (getAny . checkPatternDotUnit a) $ toList dotUnits - - let tg = TG.transpose g - - let revdeps' :: [(DotUnitId, DotUnitId)] - revdeps' = flip concatMap revdeps $ \a -> fromMaybe [] $ do - i <- TG.gToVertex tg a - pure $ map swap $ TG.treePairs $ fmap (TG.gFromVertex tg) (TG.dfsTree tg i) - - let redVertices :: Set DotUnitId - redVertices = foldMap (\(a,b) -> S.fromList [a,b]) $ paths' ++ revdeps' - - let redEdges :: Set (DotUnitId, DotUnitId) - redEdges = S.fromList $ paths' ++ revdeps' - - -- Edge weights - let weights' :: U.Vector Double - weights' = runST $ do - let orig = TG.edgesSet g' - redu = TG.edgesSet g - len = TG.gVerticeCount g - v <- MU.replicate (len * len) (0 :: Double) - - -- for each edge (i, j) in original graph, but not in the reduction - for_ (S.difference orig redu) $ \(i, j) -> do - -- calculate all paths from i to j, in the reduction - for_ (fmap trFromTree $ TG.allPathsTree g i j) $ \ps -> do - -- divide weight across paths - let r = 1 / fromIntegral (trPaths ps) - - -- and add that weight to every edge on each path - for_ (trPairs ps) $ \(k, a, b) -> - MU.modify v - (\n -> n + fromIntegral k * r) - (TG.gToInt g b + TG.gToInt g a * len) - - U.freeze v - - let weights :: Map (DotUnitId, DotUnitId) Double - weights = - if tred && tredWeights - then M.fromList - [ ((a, b), w + 1) - | ((i, j), w) <- zip ((,) <$> TG.gVertices g <*> TG.gVertices g) (U.toList weights') - , w > 0 - , let a = TG.gFromVertex g i - , let b = TG.gFromVertex g j - ] - else M.empty - - -- Beging outputting - - putStrLn "digraph plan {" - putStrLn "overlap = false;" - putStrLn "rankdir=LR;" - putStrLn "node [penwidth=2];" - - -- vertices - for_ (TG.gVertices g) $ \i -> vertex redVertices (TG.gFromVertex g i) - - -- edges - for_ (TG.gVertices g) $ \i -> for_ (TG.gEdges g i) $ \j -> - edge weights redEdges (TG.gFromVertex g i) (TG.gFromVertex g j) - - putStrLn "}" - where - loopGraph [] = putStrLn "digraph plan {}" - loopGraph (u : us) = do - putStrLn "digraph plan {" - for_ (zip (u : us) (us ++ [u])) $ \(unitA, unitB) -> - T.putStrLn $ mconcat - [ "\"" - , dispDotUnit unitA - , "\"" - , " -> " - , "\"" - , dispDotUnit unitB - , "\"" - ] - putStrLn "}" - - am = planJsonDotUnitGraph plan - - dotUnits :: Set DotUnitId - dotUnits = S.fromList $ M.keys am - - units :: Map UnitId Unit - units = pjUnits plan - - duShape :: DotUnitId -> T.Text - duShape (DU unitId _) = case M.lookup unitId units of - Nothing -> "oval" - Just unit -> case uType unit of - UnitTypeBuiltin -> "octagon" - UnitTypeGlobal -> "box" - UnitTypeInplace -> "box" - UnitTypeLocal -> "box,style=rounded" - - duShow :: DotUnitId -> Bool - duShow (DU unitId _) = case M.lookup unitId units of - Nothing -> False - Just unit -> case uType unit of - UnitTypeBuiltin -> showBuiltin - UnitTypeGlobal -> showGlobal - UnitTypeLocal -> True - UnitTypeInplace -> True - - vertex :: Set DotUnitId -> DotUnitId -> IO () - vertex redVertices du = when (duShow du) $ T.putStrLn $ mconcat - [ "\"" - , dispDotUnit du - , "\"" - -- shape - , " [shape=" - , duShape du - -- color - , ",color=" - , color - , "];" - ] - where - color | S.member du redVertices = "red" - | otherwise = borderColor du - - borderColor :: DotUnitId -> T.Text - borderColor (DU _ Nothing) = "darkviolet" - borderColor (DU unitId (Just cname)) = case cname of - CompNameLib -> case M.lookup unitId units of - Nothing -> "black" - Just unit -> case uType unit of - UnitTypeLocal -> "blue" - UnitTypeInplace -> "blue" - _ -> "black" - (CompNameSubLib _) -> "gray" - (CompNameFLib _) -> "darkred" - (CompNameExe _) -> "brown" - (CompNameBench _) -> "darkorange" - (CompNameTest _) -> "darkgreen" - CompNameSetup -> "gold" - - edge - :: Map (DotUnitId, DotUnitId) Double - -> Set (DotUnitId, DotUnitId) - -> DotUnitId -> DotUnitId -> IO () - edge weights redEdges duA duB = when (duShow duA) $ when (duShow duB) $ - T.putStrLn $ mconcat - [ "\"" - , dispDotUnit duA - , "\"" - , " -> " - , "\"" - , dispDotUnit duB - , "\" [color=" - , color - , ",penwidth=" - , T.pack $ show $ logBase 4 w + 1 - , ",weight=" - , T.pack $ show $ logBase 4 w + 1 - , "];" - ] - where - idPair = (duA, duB) - - color | S.member idPair redEdges = "red" - | otherwise = borderColor duA - - w = fromMaybe 1 $ M.lookup idPair weights - - checkPatternDotUnit :: Pattern -> DotUnitId -> Any - checkPatternDotUnit p (DU unitId mcname) = case M.lookup unitId units of - Nothing -> Any False - Just unit -> case mcname of - Just cname -> checkPattern p pname cname - Nothing -> foldMap (checkPattern p pname) (M.keys (uComps unit)) - where - PkgId pname _ = uPId unit - - dispDotUnit :: DotUnitId -> T.Text - dispDotUnit (DU unitId mcname) = case M.lookup unitId units of - Nothing -> "?" - Just unit -> - let PkgId pn _ = uPId unit in - dispPkgId (uPId unit) <> maybe ":*" (dispCompName' pn) mcname - - dispCompName' :: PkgName -> CompName -> T.Text - dispCompName' _ CompNameLib = "" - dispCompName' pn cname = ":" <> dispCompNameTarget pn cname - -------------------------------------------------------------------------------- --- license-report -------------------------------------------------------------------------------- - -doLicenseReport :: Maybe FilePath -> Pattern -> IO () -doLicenseReport mlicdir pat = do - plan <- getCurrentDirectory >>= findAndDecodePlanJson . ProjectRelativeToDir - - case findUnit plan of - [] -> do - hPutStrLn stderr "No matches found." - exitFailure - - lst@(_:_:_) -> do - hPutStrLn stderr "Multiple matching components found:" - forM_ lst $ \(pat', uid, cn) -> do - hPutStrLn stderr ("- " ++ T.unpack pat' ++ " " ++ show (uid, cn)) - exitFailure - - [(_,uid,cn)] -> generateLicenseReport mlicdir plan uid cn - - where - findUnit plan = do - (_, Unit{..}) <- M.toList $ pjUnits plan - (cn, _) <- M.toList $ uComps - - let PkgId pn@(PkgName pnT) _ = uPId - g = case cn of - CompNameLib -> pnT <> T.pack":lib:" <> pnT - _ -> pnT <> T.pack":" <> dispCompNameTarget pn cn - - guard (getAny $ checkPattern pat pn cn) - - pure (g, uId, cn) - - -------------------------------------------------------------------------------- --- topo -------------------------------------------------------------------------------- - -doTopo :: Bool -> Bool -> PlanJson -> Bool -> IO () -doTopo showBuiltin showGlobal plan rev = do - let units = pjUnits plan - - let topo = TG.runG (planJsonIdGraph plan) $ \TG.G {..} -> - map gFromVertex gVertices - - let showUnit unit = case uType unit of - UnitTypeBuiltin -> showBuiltin - UnitTypeGlobal -> showGlobal - UnitTypeLocal -> True - UnitTypeInplace -> True - - let rev' = if rev then reverse else id - - for_ topo $ \topo' -> for_ (rev' topo') $ \unitId -> - for_ (M.lookup unitId units) $ \unit -> - when (showUnit unit) $ do - let colour = case uType unit of - UnitTypeBuiltin -> Blue - UnitTypeGlobal -> White - UnitTypeLocal -> Green - UnitTypeInplace -> Red - let PkgId pn _ = uPId unit - let components = case M.keys (uComps unit) of - [] -> "" - [CompNameLib] -> "" - names -> " " <> T.intercalate " " (map (dispCompNameTarget pn) names) - putStrLn $ - colorify colour (T.unpack $ dispPkgId $ uPId unit) - ++ T.unpack components - ----------------------------------------------------------------------------- - -dumpPlanJson :: PlanJson -> LT.Text -dumpPlanJson (PlanJson { pjUnits = pm }) = LT.toLazyText out - where - ((),out) = evalRWS (mapM_ (go2 []) (S.toList roots)) () mempty - - id2pid :: Map UnitId PkgId - id2pid = M.fromList [ (uId, uPId) | Unit{..} <- M.elems pm ] - - lupPid uid = M.findWithDefault undefined uid id2pid - - go2 :: [(CompName,Bool)] -> UnitId -> (RWS () LT.Builder (Set UnitId)) () - go2 lvl pid = do - pidSeen <- gets (S.member pid) - - let pid_label = if preExists then (prettyId pid) else colorify_ White (prettyId pid) - - if not pidSeen - then do - tell $ LT.fromString (linepfx ++ pid_label ++ "\n") - showDeps - else do - tell $ LT.fromString (linepfx ++ pid_label ++ ccol CompNameLib " ┄┄\n") - -- tell $ LT.fromString (linepfx' ++ " └┄\n") - - modify' (S.insert pid) - - return () - where - Just x' = M.lookup pid pm - - preExists = uType x' == UnitTypeBuiltin - - showDeps = for_ (M.toList $ uComps x') $ \(ct,deps) -> do - unless (ct == CompNameLib) $ - tell (LT.fromString $ linepfx' ++ " " ++ prettyCompTy (lupPid pid) ct ++ "\n") - for_ (lastAnn $ S.toList (ciLibDeps deps)) $ \(l,y) -> do - go2 (lvl ++ [(ct, not l)]) y - - - linepfx = case unsnoc lvl of - Nothing -> "" - Just (xs,(zt,z)) -> concat [ if x then ccol xt " │ " else " " | (xt,x) <- xs ] - ++ (ccol zt $ if z then " ├─ " else " └─ ") - - linepfx' = concat [ if x then " │ " else " " | (_,x) <- lvl ] - - roots :: Set UnitId - roots = M.keysSet pm `S.difference` leafs - where - leafs = mconcat $ concatMap (map (ciLibDeps . snd) . M.toList . uComps) (M.elems pm) - - prettyId :: UnitId -> String - prettyId = prettyPid . lupPid - prettyPid = T.unpack . dispPkgId - - prettyCompTy :: PkgId -> CompName -> String - prettyCompTy _pid c@CompNameLib = ccol c "[lib]" - prettyCompTy _pid c@CompNameSetup = ccol c "[setup]" - prettyCompTy pid c@(CompNameExe n) = ccol c $ "[" ++ prettyPid pid ++ ":exe:" ++ show n ++ "]" - prettyCompTy pid c@(CompNameTest n) = ccol c $ "[" ++ prettyPid pid ++ ":test:" ++ show n ++ "]" - prettyCompTy pid c@(CompNameBench n) = ccol c $ "[" ++ prettyPid pid ++ ":bench:" ++ show n ++ "]" - prettyCompTy pid c@(CompNameSubLib n) = ccol c $ "[" ++ prettyPid pid ++ ":lib:" ++ show n ++ "]" - prettyCompTy pid c@(CompNameFLib n) = ccol c $ "[" ++ prettyPid pid ++ ":flib:" ++ show n ++ "]" - - ccol CompNameLib = colorify White - ccol (CompNameExe _) = colorify Green - ccol CompNameSetup = colorify Red - ccol (CompNameTest _) = colorify Yellow - ccol (CompNameBench _) = colorify Cyan - ccol (CompNameSubLib _) = colorify Blue - ccol (CompNameFLib _) = colorify Magenta - -colorify :: Color -> String -> String -colorify col s = setSGRCode [SetColor Foreground Vivid col] ++ s ++ setSGRCode [Reset] - -colorify_ :: Color -> String -> String -colorify_ col s - | haveUnderlineSupport = setSGRCode [SetUnderlining SingleUnderline, SetColor Foreground Vivid col] ++ s ++ setSGRCode [Reset] - | otherwise = colorify col s - -lastAnn :: [x] -> [(Bool,x)] -lastAnn = reverse . firstAnn . reverse - -firstAnn :: [x] -> [(Bool,x)] -firstAnn [] = [] -firstAnn (x:xs) = (True,x) : map ((,) False) xs - -unsnoc :: [x] -> Maybe ([x],x) -unsnoc [] = Nothing -unsnoc xs = Just (init xs, last xs) - -toposort :: Ord a => Map a (Set a) -> [a] -toposort m = reverse . map f . G.topSort $ g - where - (g, f) = graphFromMap m - -graphFromMap :: Ord a => Map a (Set a) -> (G.Graph, G.Vertex -> a) -graphFromMap m = (g, v2k') - where - v2k' v = case v2k v of ((), k, _) -> k - - (g, v2k, _) = G.graphFromEdges [ ((), k, S.toList v) - | (k,v) <- M.toList m ] diff --git a/cabal-plan/src-topograph/LICENSE b/cabal-plan/src-topograph/LICENSE deleted file mode 100644 index b4696d3..0000000 --- a/cabal-plan/src-topograph/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) 2018, Oleg Grenrus - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Oleg Grenrus nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-plan/src-topograph/Topograph.hs b/cabal-plan/src-topograph/Topograph.hs deleted file mode 100644 index 13c17a6..0000000 --- a/cabal-plan/src-topograph/Topograph.hs +++ /dev/null @@ -1,527 +0,0 @@ -{-# LANGUAGE RankNTypes, ScopedTypeVariables, RecordWildCards #-} --- | Copyright: (c) 2018, Oleg Grenrus --- SPDX-License-Identifier: BSD-3-Clause --- --- Tools to work with Directed Acyclic Graphs, --- by taking advantage of topological sorting. --- -module Topograph ( - -- * Graph - -- $setup - - G (..), - runG, - runG', - -- * All paths - allPaths, - allPaths', - allPathsTree, - -- * DFS - dfs, - dfsTree, - -- * Longest path - longestPathLengths, - -- * Transpose - transpose, - -- * Transitive reduction - reduction, - -- * Transitive closure - closure, - -- * Query - edgesSet, - adjacencyMap, - adjacencyList, - -- * Helper functions - treePairs, - pairs, - getDown, - ) where - -import Prelude () -import Prelude.Compat -import Data.Orphans () - -import Control.Monad.ST (ST, runST) -import Data.Maybe (fromMaybe, catMaybes, mapMaybe) -import Data.Monoid (First (..)) -import Data.List (sort) -import Data.Foldable (for_) -import Data.Ord (Down (..)) -import qualified Data.Graph as G -import Data.Tree as T -import Data.Map (Map) -import qualified Data.Map as M -import Data.Set (Set) -import qualified Data.Set as S -import qualified Data.Vector as V -import qualified Data.Vector.Unboxed as U -import qualified Data.Vector.Unboxed.Mutable as MU - -import Debug.Trace - --- | Graph representation. -data G v a = G - { gVertices :: [a] -- ^ all vertices, in topological order. - , gFromVertex :: a -> v -- ^ retrieve original vertex data. /O(1)/ - , gToVertex :: v -> Maybe a -- ^ /O(log n)/ - , gEdges :: a -> [a] -- ^ Outgoing edges. - , gDiff :: a -> a -> Int -- ^ Upper bound of the path length. Negative if there aren't path. /O(1)/ - , gVerticeCount :: Int - , gToInt :: a -> Int - } - --- | Run action on topologically sorted representation of the graph. --- --- === __Examples__ --- --- ==== Topological sorting --- --- >>> runG example $ \G {..} -> map gFromVertex gVertices --- Right "axbde" --- --- Vertices are sorted --- --- >>> runG example $ \G {..} -> map gFromVertex $ sort gVertices --- Right "axbde" --- --- ==== Outgoing edges --- --- >>> runG example $ \G {..} -> map (map gFromVertex . gEdges) gVertices --- Right ["xbde","de","d","e",""] --- --- Note: edges are always larger than source vertex: --- --- >>> runG example $ \G {..} -> getAll $ foldMap (\a -> foldMap (\b -> All (a < b)) (gEdges a)) gVertices --- Right True --- --- ==== Not DAG --- --- >>> let loop = M.map S.fromList $ M.fromList [('a', "bx"), ('b', "cx"), ('c', "ax"), ('x', "")] --- >>> runG loop $ \G {..} -> map gFromVertex gVertices --- Left "abc" --- --- >>> runG (M.singleton 'a' (S.singleton 'a')) $ \G {..} -> map gFromVertex gVertices --- Left "aa" --- -runG - :: forall v r. Ord v - => Map v (Set v) -- ^ Adjacency Map - -> (forall i. Ord i => G v i -> r) -- ^ function on linear indices - -> Either [v] r -- ^ Return the result or a cycle in the graph. -runG m f - | Just l <- loop = Left (map (indices V.!) l) - | otherwise = Right (f g) - where - gr :: G.Graph - r :: G.Vertex -> ((), v, [v]) - _t :: v -> Maybe G.Vertex - - (gr, r, _t) = G.graphFromEdges [ ((), v, S.toAscList us) | (v, us) <- M.toAscList m ] - - r' :: G.Vertex -> v - r' i = case r i of (_, v, _) -> v - - topo :: [G.Vertex] - topo = G.topSort gr - - indices :: V.Vector v - indices = V.fromList (map r' topo) - - revIndices :: Map v Int - revIndices = M.fromList $ zip (map r' topo) [0..] - - edges :: V.Vector [Int] - edges = V.map - (\v -> maybe - [] - (\sv -> sort $ mapMaybe (\v' -> M.lookup v' revIndices) $ S.toList sv) - (M.lookup v m)) - indices - - -- TODO: let's see if this check is too expensive - loop :: Maybe [Int] - loop = getFirst $ foldMap (\a -> foldMap (check a) (gEdges g a)) (gVertices g) - where - check a b - | a < b = First Nothing - -- TODO: here we could use shortest path - | otherwise = First $ case allPaths g b a of - [] -> Nothing - (p : _) -> Just p - - g :: G v Int - g = G - { gVertices = [0 .. V.length indices - 1] - , gFromVertex = (indices V.!) - , gToVertex = (`M.lookup` revIndices) - , gDiff = \a b -> b - a - , gEdges = (edges V.!) - , gVerticeCount = V.length indices - , gToInt = id - } - --- | Like 'runG' but returns 'Maybe' -runG' - :: forall v r. Ord v - => Map v (Set v) -- ^ Adjacency Map - -> (forall i. Ord i => G v i -> r) -- ^ function on linear indices - -> Maybe r -- ^ Return the result or 'Nothing' if there is a cycle. -runG' m f = either (const Nothing) Just (runG m f) - -------------------------------------------------------------------------------- --- All paths -------------------------------------------------------------------------------- - --- | All paths from @a@ to @b@. Note that every path has at least 2 elements, start and end. --- Use 'allPaths'' for the intermediate steps only. --- --- >>> runG example $ \g@G{..} -> fmap3 gFromVertex $ allPaths g <$> gToVertex 'a' <*> gToVertex 'e' --- Right (Just ["axde","axe","abde","ade","ae"]) --- --- >>> runG example $ \g@G{..} -> fmap3 gFromVertex $ allPaths g <$> gToVertex 'a' <*> gToVertex 'a' --- Right (Just []) --- -allPaths :: forall v a. Ord a => G v a -> a -> a -> [[a]] -allPaths g a b = map (\p -> a : p) (allPaths' g a b [b]) - --- | 'allPaths' without begin and end elements. --- --- >>> runG example $ \g@G{..} -> fmap3 gFromVertex $ allPaths' g <$> gToVertex 'a' <*> gToVertex 'e' <*> pure [] --- Right (Just ["xd","x","bd","d",""]) --- -allPaths' :: forall v a. Ord a => G v a -> a -> a -> [a] -> [[a]] -allPaths' G {..} a b end = concatMap go (gEdges a) where - go :: a -> [[a]] - go i - | i == b = [end] - | otherwise = - let js :: [a] - js = filter (<= b) $ gEdges i - - js2b :: [[a]] - js2b = concatMap go js - - in map (i:) js2b - - - --- | Like 'allPaths' but return a 'T.Tree'. --- --- >>> let t = runG example $ \g@G{..} -> fmap3 gFromVertex $ allPathsTree g <$> gToVertex 'a' <*> gToVertex 'e' --- >>> fmap3 (T.foldTree $ \a bs -> if null bs then [[a]] else concatMap (map (a:)) bs) t --- Right (Just (Just ["axde","axe","abde","ade","ae"])) --- --- >>> fmap3 (S.fromList . treePairs) t --- Right (Just (Just (fromList [('a','b'),('a','d'),('a','e'),('a','x'),('b','d'),('d','e'),('x','d'),('x','e')]))) --- --- >>> let ls = runG example $ \g@G{..} -> fmap3 gFromVertex $ allPaths g <$> gToVertex 'a' <*> gToVertex 'e' --- >>> fmap2 (S.fromList . concatMap pairs) ls --- Right (Just (fromList [('a','b'),('a','d'),('a','e'),('a','x'),('b','d'),('d','e'),('x','d'),('x','e')])) --- --- >>> traverse3_ dispTree t --- 'a' --- 'x' --- 'd' --- 'e' --- 'e' --- 'b' --- 'd' --- 'e' --- 'd' --- 'e' --- 'e' --- --- >>> traverse3_ (putStrLn . T.drawTree . fmap show) t --- 'a' --- | --- +- 'x' --- | | --- | +- 'd' --- | | | --- | | `- 'e' --- | | --- | `- 'e' --- ... --- -allPathsTree :: forall v a. Ord a => G v a -> a -> a -> Maybe (T.Tree a) -allPathsTree G {..} a b = go a where - go :: a -> Maybe (T.Tree a) - go i - | i == b = Just (T.Node b []) - | otherwise = case mapMaybe go $ filter (<= b) $ gEdges i of - [] -> Nothing - js -> Just (T.Node i js) - -------------------------------------------------------------------------------- --- DFS -------------------------------------------------------------------------------- - --- | Depth-first paths starting at a vertex. --- --- >>> runG example $ \g@G{..} -> fmap3 gFromVertex $ dfs g <$> gToVertex 'x' --- Right (Just ["xde","xe"]) --- -dfs :: forall v a. Ord a => G v a -> a -> [[a]] -dfs G {..} = go where - go :: a -> [[a]] - go a = case gEdges a of - [] -> [[a]] - bs -> concatMap (\b -> map (a :) (go b)) bs - --- | like 'dfs' but returns a 'T.Tree'. --- --- >>> traverse2_ dispTree $ runG example $ \g@G{..} -> fmap2 gFromVertex $ dfsTree g <$> gToVertex 'x' --- 'x' --- 'd' --- 'e' --- 'e' -dfsTree :: forall v a. Ord a => G v a -> a -> T.Tree a -dfsTree G {..} = go where - go :: a -> Tree a - go a = case gEdges a of - [] -> T.Node a [] - bs -> T.Node a $ map go bs - -------------------------------------------------------------------------------- --- Longest / shortest path -------------------------------------------------------------------------------- - --- | Longest paths lengths starting from a vertex. --- --- >>> runG example $ \g@G{..} -> longestPathLengths g <$> gToVertex 'a' --- Right (Just [0,1,1,2,3]) --- --- >>> runG example $ \G {..} -> map gFromVertex gVertices --- Right "axbde" --- --- >>> runG example $ \g@G{..} -> longestPathLengths g <$> gToVertex 'b' --- Right (Just [0,0,0,1,2]) --- -longestPathLengths :: Ord a => G v a -> a -> [Int] -longestPathLengths = pathLenghtsImpl max - --- | Shortest paths lengths starting from a vertex. --- --- >>> runG example $ \g@G{..} -> shortestPathLengths g <$> gToVertex 'a' --- Right (Just [0,1,1,1,1]) --- --- >>> runG example $ \g@G{..} -> shortestPathLengths g <$> gToVertex 'b' --- Right (Just [0,0,0,1,2]) --- -shortestPathLengths :: Ord a => G v a -> a -> [Int] -shortestPathLengths = pathLenghtsImpl min' where - min' 0 y = y - min' x y = min x y - -pathLenghtsImpl :: forall v a. Ord a => (Int -> Int -> Int) -> G v a -> a -> [Int] -pathLenghtsImpl merge G {..} a = runST $ do - v <- MU.replicate (length gVertices) (0 :: Int) - go v (S.singleton a) - v' <- U.freeze v - pure (U.toList v') - where - go :: MU.MVector s Int -> Set a -> ST s () - go v xs = do - case S.minView xs of - Nothing -> pure () - Just (x, xs') -> do - c <- MU.unsafeRead v (gToInt x) - let ys = S.fromList $ gEdges x - for_ ys $ \y -> - flip (MU.unsafeModify v) (gToInt y) $ \d -> merge d (c + 1) - go v (xs' `S.union` ys) - -------------------------------------------------------------------------------- --- Transpose -------------------------------------------------------------------------------- - --- | Graph with all edges reversed. --- --- >>> runG example $ adjacencyList . transpose --- Right [('a',""),('b',"a"),('d',"abx"),('e',"adx"),('x',"a")] --- --- === __Properties__ --- --- Commutes with 'closure' --- --- >>> runG example $ adjacencyList . closure . transpose --- Right [('a',""),('b',"a"),('d',"abx"),('e',"abdx"),('x',"a")] --- --- >>> runG example $ adjacencyList . transpose . closure --- Right [('a',""),('b',"a"),('d',"abx"),('e',"abdx"),('x',"a")] --- --- Commutes with 'reduction' --- --- >>> runG example $ adjacencyList . reduction . transpose --- Right [('a',""),('b',"a"),('d',"bx"),('e',"d"),('x',"a")] --- --- >>> runG example $ adjacencyList . transpose . reduction --- Right [('a',""),('b',"a"),('d',"bx"),('e',"d"),('x',"a")] --- -transpose :: forall v a. Ord a => G v a -> G v (Down a) -transpose G {..} = G - { gVertices = map Down $ reverse gVertices - , gFromVertex = gFromVertex . getDown - , gToVertex = fmap Down . gToVertex - , gEdges = gEdges' - , gDiff = \(Down a) (Down b) -> gDiff b a - , gVerticeCount = gVerticeCount - , gToInt = \(Down a) -> gVerticeCount - gToInt a - 1 - } - where - gEdges' :: Down a -> [Down a] - gEdges' (Down a) = es V.! gToInt a - - -- Note: in original order! - es :: V.Vector [Down a] - es = V.fromList $ map (map Down . revEdges) gVertices - - revEdges :: a -> [a] - revEdges x = concatMap (\y -> [y | x `elem` gEdges y ]) gVertices - - -------------------------------------------------------------------------------- --- Reduction -------------------------------------------------------------------------------- - --- | Transitive reduction. --- --- Smallest graph, --- such that if there is a path from /u/ to /v/ in the original graph, --- then there is also such a path in the reduction. --- --- >>> runG example $ \g -> adjacencyList $ reduction g --- Right [('a',"bx"),('b',"d"),('d',"e"),('e',""),('x',"d")] --- --- Taking closure first doesn't matter: --- --- >>> runG example $ \g -> adjacencyList $ reduction $ closure g --- Right [('a',"bx"),('b',"d"),('d',"e"),('e',""),('x',"d")] --- -reduction :: Ord a => G v a -> G v a -reduction = transitiveImpl (== 1) - -------------------------------------------------------------------------------- --- Closure -------------------------------------------------------------------------------- - --- | Transitive closure. --- --- A graph, --- such that if there is a path from /u/ to /v/ in the original graph, --- then there is an edge from /u/ to /v/ in the closure. --- --- >>> runG example $ \g -> adjacencyList $ closure g --- Right [('a',"bdex"),('b',"de"),('d',"e"),('e',""),('x',"de")] --- --- Taking reduction first, doesn't matter: --- --- >>> runG example $ \g -> adjacencyList $ closure $ reduction g --- Right [('a',"bdex"),('b',"de"),('d',"e"),('e',""),('x',"de")] --- -closure :: Ord a => G v a -> G v a -closure = transitiveImpl (/= 0) - -transitiveImpl :: forall v a. Ord a => (Int -> Bool) -> G v a -> G v a -transitiveImpl pred g@G {..} = g { gEdges = gEdges' } where - gEdges' :: a -> [a] - gEdges' a = es V.! gToInt a - - es :: V.Vector [a] - es = V.fromList $ map f gVertices where - - f :: a -> [a] - f x = catMaybes $ zipWith edge gVertices (longestPathLengths g x) - - edge y i | pred i = Just y - | otherwise = Nothing - -------------------------------------------------------------------------------- --- Display -------------------------------------------------------------------------------- - --- | Recover adjacency map representation from the 'G'. --- --- >>> runG example adjacencyMap --- Right (fromList [('a',fromList "bdex"),('b',fromList "d"),('d',fromList "e"),('e',fromList ""),('x',fromList "de")]) -adjacencyMap :: Ord v => G v a -> Map v (Set v) -adjacencyMap G {..} = M.fromList $ map f gVertices where - f x = (gFromVertex x, S.fromList $ map gFromVertex $ gEdges x) - --- | Adjacency list representation of 'G'. --- --- >>> runG example adjacencyList --- Right [('a',"bdex"),('b',"d"),('d',"e"),('e',""),('x',"de")] -adjacencyList :: Ord v => G v a -> [(v, [v])] -adjacencyList = flattenAM . adjacencyMap - -flattenAM :: Map a (Set a) -> [(a, [a])] -flattenAM = map (fmap S.toList) . M.toList - --- | --- --- >>> runG example $ \g@G{..} -> map (\(a,b) -> [gFromVertex a, gFromVertex b]) $ S.toList $ edgesSet g --- Right ["ax","ab","ad","ae","xd","xe","bd","de"] -edgesSet :: Ord a => G v a -> Set (a, a) -edgesSet G {..} = S.fromList - [ (x, y) - | x <- gVertices - , y <- gEdges x - ] - -------------------------------------------------------------------------------- --- Utilities -------------------------------------------------------------------------------- - --- | Like 'pairs' but for 'T.Tree'. -treePairs :: Tree a -> [(a,a)] -treePairs (T.Node i js) = - [ (i, j) | T.Node j _ <- js ] ++ concatMap treePairs js - --- | Consequtive pairs. --- --- >>> pairs [1..10] --- [(1,2),(2,3),(3,4),(4,5),(5,6),(6,7),(7,8),(8,9),(9,10)] --- --- >>> pairs [] --- [] --- -pairs :: [a] -> [(a, a)] -pairs [] = [] -pairs xs = zip xs (tail xs) - --- | Unwrap 'Down'. -getDown :: Down a -> a -getDown (Down a) = a - -------------------------------------------------------------------------------- --- Setup -------------------------------------------------------------------------------- - --- $setup --- --- Graph used in examples (with all arrows pointing down) --- --- @ --- a ----- --- / | \\ \\ --- b | x \\ --- \\ | / \\ | --- d \\ | --- ------- e --- @ --- --- See <https://en.wikipedia.org/wiki/Transitive_reduction> for a picture. --- --- >>> let example :: Map Char (Set Char); example = M.map S.fromList $ M.fromList [('a', "bxde"), ('b', "d"), ('x', "de"), ('d', "e"), ('e', "")] --- --- >>> :set -XRecordWildCards --- >>> import Data.Monoid (All (..)) --- >>> import Data.Foldable (traverse_) --- --- >>> let fmap2 = fmap . fmap --- >>> let fmap3 = fmap . fmap2 --- >>> let traverse2_ = traverse_ . traverse_ --- >>> let traverse3_ = traverse_ . traverse2_ --- --- >>> let dispTree :: Show a => Tree a -> IO (); dispTree = go 0 where go i (T.Node x xs) = putStrLn (replicate (i * 2) ' ' ++ show x) >> traverse_ (go (succ i)) xs diff --git a/cabal-plan/src/Cabal/Plan.hs b/cabal-plan/src/Cabal/Plan.hs deleted file mode 100755 index d65c581..0000000 --- a/cabal-plan/src/Cabal/Plan.hs +++ /dev/null @@ -1,586 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - --- | SPDX-License-Identifier: GPL-2.0-or-later --- --- Utilities for reading @cabal@'s @plan.json@ file --- --- @plan.json@ are generated when using @cabal@ --- <http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html Nix-style Local Builds>. -module Cabal.Plan - ( - PlanJson(..) - , Unit(..) - , CompName(..) - , dispCompName - , dispCompNameTarget - , CompInfo(..) - , UnitType(..) - - -- * Basic types - , Ver(..) - , dispVer - , PkgName(..) - , PkgId(..) - , dispPkgId - , UnitId(..) - , FlagName(..) - - -- ** SHA-256 - , Sha256 - , dispSha256 - , parseSha256 - , sha256ToByteString - , sha256FromByteString - - -- ** PkgLoc - , PkgLoc(..) - , Repo(..) - , SourceRepo(..) - , URI(..) - , RepoType(..) - - -- * Utilities - , planJsonIdGraph - , planJsonIdRoots - - -- * Convenience functions - , SearchPlanJson(..) - , findAndDecodePlanJson - , findProjectRoot - , decodePlanJson - ) where - -import Control.Applicative as App -import Control.Monad -import Data.Aeson -import Data.Aeson.Types -import qualified Data.ByteString as B -import qualified Data.ByteString.Base16 as B16 -import Data.List -import Data.Map (Map) -import qualified Data.Map as M -import Data.Monoid -import Data.Set (Set) -import qualified Data.Set as S -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Version as DV -import qualified System.Directory as Dir -import System.FilePath -import Text.ParserCombinators.ReadP - ----------------------------------------------------------------------------- - --- | Equivalent to @Cabal@'s @Distribution.Package.Version@ -newtype Ver = Ver [Int] - deriving (Show,Eq,Ord) - --- | Equivalent to @Cabal@'s @Distribution.Package.UnitId@ -newtype UnitId = UnitId Text - deriving (Show,Eq,Ord,FromJSON,ToJSON,FromJSONKey,ToJSONKey) - --- | Equivalent to @Cabal@'s @Distribution.Package.PackageName@ -newtype PkgName = PkgName Text - deriving (Show,Eq,Ord,FromJSON,ToJSON,FromJSONKey,ToJSONKey) - --- | Equivalent to @Cabal@'s @Distribution.Package.PackageIdentifier@ -data PkgId = PkgId !PkgName !Ver - deriving (Show,Eq,Ord) - --- | Equivalent to @Cabal@'s @Distribution.PackageDescription.FlagName@ --- --- @since 0.3.0.0 -newtype FlagName = FlagName Text - deriving (Show,Eq,Ord,FromJSON,ToJSON,FromJSONKey,ToJSONKey) - --- | <https://en.wikipedia.org/wiki/SHA-2 SHA-256> hash -newtype Sha256 = Sha256 B.ByteString -- internal invariant: exactly 32 bytes long - deriving (Eq,Ord) --- | Equivalent to @Cabal@\'s @Distribution.Client.Types.PackageLocation@ -data PkgLoc - = LocalUnpackedPackage !FilePath - | LocalTarballPackage !FilePath - | RemoteTarballPackage !URI - | RepoTarballPackage !Repo - | RemoteSourceRepoPackage !SourceRepo - deriving (Show,Eq,Ord) - --- | Equivalent to @Cabal@\'s @Distribution.Types.SourceRepo@ -data Repo - = RepoLocal !FilePath - | RepoRemote !URI - | RepoSecure !URI - deriving (Show,Eq,Ord) - --- | Equivalent to @Cabal@\'s @Distribution.Client.Types.Repo@ -data SourceRepo = SourceRepo - { srType :: !(Maybe RepoType) - , srLocation :: !(Maybe Text) - , srModule :: !(Maybe Text) - , srBranch :: !(Maybe Text) - , srTag :: !(Maybe Text) - , srSubdir :: !(Maybe FilePath) - } deriving (Show,Eq,Ord) - -newtype URI = URI Text - deriving (Show,Eq,Ord,FromJSON,ToJSON,FromJSONKey,ToJSONKey) - --- | Equivalent to @Cabal@\'s @Distribution.Client.SourceRepo.RepoType@ -data RepoType - = Darcs - | Git - | SVN - | CVS - | Mercurial - | GnuArch - | Bazaar - | Monotone - | OtherRepoType Text - deriving (Show,Eq,Ord) - --- | Represents the information contained in cabal's @plan.json@ file. --- --- This comprises basic information describing the environment as well --- as the install/build plan computed by @cabal@. -data PlanJson = PlanJson - { pjCabalVersion :: !Ver -- ^ Version of @cabal@ frontend - , pjCabalLibVersion :: !Ver -- ^ Version of Cabal library - , pjCompilerId :: !PkgId -- ^ Name and version of Haskell compiler - , pjArch :: !Text -- ^ Architecture name - , pjOs :: !Text -- ^ Operating system name - , pjUnits :: !(M.Map UnitId Unit) -- ^ install/build plan - } deriving Show - --- | Describes kind of build unit and its provenance -data UnitType = UnitTypeBuiltin -- ^ Lives in global (non-nix-style) package db - | UnitTypeGlobal -- ^ Lives in Nix-store cache - | UnitTypeLocal -- ^ Local package - | UnitTypeInplace -- ^ Local in-place package - deriving (Show,Eq) - --- | Represents a build-plan unit uniquely identified by its 'UnitId' -data Unit = Unit - { uId :: !UnitId -- ^ Unit ID uniquely identifying a 'Unit' in install plan - , uPId :: !PkgId -- ^ Package name and version (not necessarily unique within plan) - , uType :: !UnitType -- ^ Describes type of build item, see 'UnitType' - , uSha256 :: !(Maybe Sha256) -- ^ SHA256 source tarball checksum (as used by e.g. @hackage-security@) - , uComps :: !(Map CompName CompInfo) -- ^ Components identified by 'UnitId' - -- - -- When @cabal@ needs to fall back to legacy-mode (currently for - -- @custom@ build-types or obsolete @cabal-version@ values), 'uComps' - -- may contain more than one element. - , uFlags :: !(Map FlagName Bool) -- ^ cabal flag settings (not available for 'UnitTypeBuiltin') - , uDistDir :: !(Maybe FilePath) -- ^ In-place dist-dir (if available) - -- - -- @since 0.3.0.0 - , uPkgSrc :: !(Maybe PkgLoc) - -- ^ Source of the package - -- - -- @since 0.5.0.0 (TODO) - } deriving Show - --- | Component name inside a build-plan unit --- --- A similiar type exists in @Cabal@ codebase, see --- @Distribution.Simple.LocalBuildInfo.ComponentName@ -data CompName = - CompNameLib - | CompNameSubLib !Text - | CompNameFLib !Text -- ^ @since 0.3.0.0 - | CompNameExe !Text - | CompNameTest !Text - | CompNameBench !Text - | CompNameSetup - deriving (Show, Eq, Ord) - --- | Describes component-specific information inside a 'Unit' -data CompInfo = CompInfo - { ciLibDeps :: Set UnitId -- ^ library dependencies - , ciExeDeps :: Set UnitId -- ^ executable dependencies - , ciBinFile :: Maybe FilePath -- ^ path-name of artifact if available - } deriving Show - ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- - --- JSON instances - -instance FromJSON CompName where - parseJSON = withText "CompName" (maybe (fail "invalid CompName") pure . parseCompName) - -instance ToJSON CompName where - toJSON = toJSON . dispCompName - -instance FromJSONKey CompName where - fromJSONKey = FromJSONKeyTextParser (maybe (fail "CompName") pure . parseCompName) - -instance ToJSONKey CompName where - toJSONKey = toJSONKeyText dispCompName - ----- - -instance FromJSON CompInfo where - parseJSON = withObject "CompInfo" $ \o -> - CompInfo <$> o .:?! "depends" - <*> o .:?! "exe-depends" - <*> o .:? "bin-file" - ----- - -instance FromJSON PkgId where - parseJSON = withText "PkgId" (maybe (fail "invalid PkgId") pure . parsePkgId) - -instance ToJSON PkgId where - toJSON = toJSON . dispPkgId - -instance FromJSONKey PkgId where - fromJSONKey = FromJSONKeyTextParser (maybe (fail "PkgId") pure . parsePkgId) - -instance ToJSONKey PkgId where - toJSONKey = toJSONKeyText dispPkgId - ----- - -instance FromJSON PkgLoc where - parseJSON = withObject "PkgSrc" $ \o -> do - ty <- o .: "type" - case ty :: Text of - "local" -> LocalUnpackedPackage <$> o .: "path" - "local-tar" -> LocalTarballPackage <$> o .: "path" - "remote-tar" -> RemoteTarballPackage <$> o .: "uri" - "repo-tar" -> RepoTarballPackage <$> o .: "repo" - "source-repo" -> RemoteSourceRepoPackage <$> o .: "source-repo" - _ -> fail "invalid PkgSrc \"type\"" - -instance FromJSON Repo where - parseJSON = withObject "Repo" $ \o -> do - ty <- o .: "type" - case ty :: Text of - "local-repo" -> RepoLocal <$> o .: "path" - "remote-repo" -> RepoRemote <$> o .: "uri" - "secure-repo" -> RepoSecure <$> o .: "uri" - _ -> fail "invalid Repo \"type\"" - -instance FromJSON SourceRepo where - parseJSON = withObject "SourceRepo" $ \o -> do - SourceRepo <$> o .:? "type" - <*> o .:? "location" - <*> o .:? "module" - <*> o .:? "branch" - <*> o .:? "tag" - <*> o .:? "subdir" - -instance FromJSON RepoType where - parseJSON = withText "RepoType" $ \ty -> return $ - case ty of - "darcs" -> Darcs - "git" -> Git - "svn" -> SVN - "cvs" -> CVS - "mercurial" -> Mercurial - "gnuarch" -> GnuArch - "bazaar" -> Bazaar - "monotone" -> Monotone - _ -> OtherRepoType ty - ----------------------------------------------------------------------------- --- parser helpers - -parseCompName :: Text -> Maybe CompName -parseCompName t0 = case T.splitOn ":" t0 of - ["lib"] -> Just CompNameLib - ["lib",n] -> Just $! CompNameSubLib n - ["flib",n] -> Just $! CompNameFLib n - ["exe",n] -> Just $! CompNameExe n - ["bench",n] -> Just $! CompNameBench n - ["test",n] -> Just $! CompNameTest n - ["setup"] -> Just CompNameSetup - _ -> Nothing - --- | Pretty print 'CompName' in cabal's target-selector syntax. -dispCompNameTarget :: PkgName -> CompName -> Text -dispCompNameTarget (PkgName pkg) cn = case cn of - CompNameLib -> "lib:" <> pkg - _ -> dispCompName cn - --- | Pretty print 'CompName' in the same syntax that is used in --- @plan.json@. Note that this string can not be used as a target-selector on --- the cabal command-line. See 'dispCompNameTarget' for a target-selector --- compatible pretty printer. -dispCompName :: CompName -> Text -dispCompName cn = case cn of - CompNameLib -> "lib" - CompNameSubLib n -> "lib:" <> n - CompNameFLib n -> "flib:" <> n - CompNameExe n -> "exe:" <> n - CompNameBench n -> "bench:" <> n - CompNameTest n -> "test:" <> n - CompNameSetup -> "setup" - -instance FromJSON PlanJson where - parseJSON = withObject "PlanJson" $ \o -> do - pjCabalVersion <- o .: "cabal-version" - - unless (pjCabalVersion >= Ver [2]) $ - fail ("plan.json version " ++ T.unpack (dispVer pjCabalVersion) ++ " not supported") - - pjCabalLibVersion <- o .: "cabal-lib-version" - pjCompilerId <- o .: "compiler-id" - pjArch <- o .: "arch" - pjOs <- o .: "os" - pjUnits <- toMap =<< o .: "install-plan" - - App.pure PlanJson{..} - where - toMap pil = do - let pim = M.fromList [ (uId pi',pi') | pi' <- pil ] - unless (M.size pim == length pil) $ - fail "install-plan[] has duplicate ids" - pure pim - -(.:?!) :: (FromJSON a, Monoid a) => Object -> Text -> Parser a -o .:?! fld = o .:? fld .!= mempty - -planItemAllDeps :: Unit -> Set UnitId -planItemAllDeps Unit{..} = mconcat [ ciLibDeps <> ciExeDeps | CompInfo{..} <- M.elems uComps ] - -instance FromJSON Unit where - parseJSON = withObject "Unit" $ \o -> do - mcomponents <- o .:? "components" - mcomponentname <- o .:? "component-name" - ty <- o .: "type" - mstyle <- o .:? "style" - - uId <- o .: "id" - uPId <- PkgId <$> o .: "pkg-name" <*> o .: "pkg-version" - uType <- case (ty :: Text, mstyle :: Maybe Text) of - ("pre-existing",Nothing) -> pure UnitTypeBuiltin - ("configured",Just "global") -> pure UnitTypeGlobal - ("configured",Just "local") -> pure UnitTypeLocal - ("configured",Just "inplace") -> pure UnitTypeInplace - _ -> fail (show (ty,mstyle)) - uFlags <- o .:?! "flags" - uSha256 <- o .:? "pkg-src-sha256" - uComps <- case (mcomponents, mcomponentname) of - (Just comps0, Nothing) -> - pure comps0 - (Nothing, Just cname) -> - M.singleton cname <$> parseJSON (Object o) - (Nothing, Nothing) | uType == UnitTypeBuiltin -> - M.singleton CompNameLib <$> parseJSON (Object o) - _ -> fail (show o) - - uDistDir <- o .:? "dist-dir" - - uPkgSrc <- o .:? "pkg-src" - - pure Unit{..} - ----------------------------------------------------------------------------- --- Convenience helper - --- | Where/how to search for the plan.json file. -data SearchPlanJson - = ProjectRelativeToDir FilePath -- ^ Find the project root relative to - -- specified directory and look for - -- plan.json there. - | InBuildDir FilePath -- ^ Look for plan.json in specified build - -- directory. - deriving (Eq, Show, Read) - --- | Locates the project root for cabal project relative to specified --- directory. --- --- @plan.json@ is located from either the optional build dir argument, or in --- the default directory (@dist-newstyle@) relative to the project root. --- --- The folder assumed to be the project-root is returned as well. --- --- This function determines the project root in a slightly more liberal manner --- than cabal-install. If no cabal.project is found, cabal-install assumes an --- implicit cabal.project if the current directory contains any *.cabal files. --- --- This function looks for any *.cabal files in directories above the current --- one and behaves as if there is an implicit cabal.project in that directory --- when looking for a plan.json. --- --- Throws 'IO' exceptions on errors. --- -findAndDecodePlanJson - :: SearchPlanJson - -> IO PlanJson -findAndDecodePlanJson searchLoc = do - distFolder <- case searchLoc of - InBuildDir builddir -> pure builddir - ProjectRelativeToDir fp -> do - mRoot <- findProjectRoot fp - case mRoot of - Nothing -> fail ("missing project root relative to: " ++ fp) - Just dir -> pure $ dir </> "dist-newstyle" - - haveDistFolder <- Dir.doesDirectoryExist distFolder - - unless haveDistFolder $ - fail ("missing " ++ show distFolder ++ " folder; do you need to run 'cabal new-build'?") - - let planJsonFn = distFolder </> "cache" </> "plan.json" - - havePlanJson <- Dir.doesFileExist planJsonFn - - unless havePlanJson $ - fail "missing 'plan.json' file; do you need to run 'cabal new-build'?" - - decodePlanJson planJsonFn - --- | Decodes @plan.json@ file location provided as 'FilePath' --- --- This is a trivial convenience function so that the caller doesn't --- have to depend on @aeson@ directly --- --- Throws 'IO' exceptions on errors. --- -decodePlanJson :: FilePath -> IO PlanJson -decodePlanJson planJsonFn = do - jsraw <- B.readFile planJsonFn - either fail pure $ eitherDecodeStrict' jsraw - --- | Find project root relative to a directory, this emulates cabal's current --- heuristic, but is slightly more liberal. If no cabal.project is found, --- cabal-install looks for *.cabal files in the specified directory only. This --- function also considers *.cabal files in directories higher up in the --- hierarchy. -findProjectRoot :: FilePath -> IO (Maybe FilePath) -findProjectRoot dir = do - normalisedPath <- Dir.canonicalizePath dir - let checkCabalProject d = do - ex <- Dir.doesFileExist fn - return $ if ex then Just d else Nothing - where - fn = d </> "cabal.project" - - checkCabal d = do - files <- listDirectory d - return $ if any (isExtensionOf ".cabal") files - then Just d - else Nothing - - result <- walkUpFolders checkCabalProject normalisedPath - case result of - Just rootDir -> pure $ Just rootDir - Nothing -> walkUpFolders checkCabal normalisedPath - where - isExtensionOf :: String -> FilePath -> Bool - isExtensionOf ext fp = ext == takeExtension fp - - listDirectory :: FilePath -> IO [FilePath] - listDirectory fp = filter isSpecialDir <$> Dir.getDirectoryContents fp - where - isSpecialDir f = f /= "." && f /= ".." - -walkUpFolders - :: (FilePath -> IO (Maybe a)) -> FilePath -> IO (Maybe a) -walkUpFolders dtest d0 = do - home <- Dir.getHomeDirectory - - let go d | d == home = pure Nothing - | isDrive d = pure Nothing - | otherwise = do - t <- dtest d - case t of - Nothing -> go $ takeDirectory d - x@Just{} -> pure x - - go d0 - -parseVer :: Text -> Maybe Ver -parseVer str = case reverse $ readP_to_S DV.parseVersion (T.unpack str) of - (ver, "") : _ | not (null (DV.versionBranch ver)), all (>= 0) (DV.versionBranch ver) - -> Just (Ver $ DV.versionBranch ver) - _ -> Nothing - --- | Pretty print 'Ver' -dispVer :: Ver -> Text -dispVer (Ver ns) = T.pack $ intercalate "." (map show ns) - -instance FromJSON Ver where - parseJSON = withText "Ver" (maybe (fail "Ver") pure . parseVer) - -instance ToJSON Ver where - toJSON = toJSON . dispVer - -parsePkgId :: Text -> Maybe PkgId -parsePkgId t = do - let (pns_, pvs) = T.breakOnEnd "-" t - pv <- parseVer pvs - - pn <- T.stripSuffix "-" pns_ - - -- TODO: validate pn - pure (PkgId (PkgName pn) pv) - --- | Pretty print 'PkgId' -dispPkgId :: PkgId -> Text -dispPkgId (PkgId (PkgName pn) pv) = pn <> "-" <> dispVer pv - - --- | Pretty print 'Sha256' as base-16. -dispSha256 :: Sha256 -> Text -dispSha256 (Sha256 s) = T.decodeLatin1 (B16.encode s) - --- | Parse base-16 encoded 'Sha256'. --- --- Returns 'Nothing' in case of parsing failure. --- --- @since 0.3.0.0 -parseSha256 :: Text -> Maybe Sha256 -parseSha256 t - | B.length s == 32, B.null rest = Just (Sha256 s) - | otherwise = Nothing - where - (s, rest) = B16.decode $ T.encodeUtf8 t - --- | Export the 'Sha256' digest to a 32-byte 'B.ByteString'. --- --- @since 0.3.0.0 -sha256ToByteString :: Sha256 -> B.ByteString -sha256ToByteString (Sha256 bs) = bs - --- | Import the 'Sha256' digest from a 32-byte 'B.ByteString'. --- --- Returns 'Nothing' if input 'B.ByteString' has incorrect length. --- --- @since 0.3.0.0 -sha256FromByteString :: B.ByteString -> Maybe Sha256 -sha256FromByteString bs - | B.length bs == 32 = Just (Sha256 bs) - | otherwise = Nothing - -instance FromJSON Sha256 where - parseJSON = withText "Sha256" (maybe (fail "Sha256") pure . parseSha256) - -instance ToJSON Sha256 where - toJSON = toJSON . dispSha256 - -instance Show Sha256 where - show = show . dispSha256 - ----------------------------------------------------------------------------- - --- | Extract directed 'UnitId' dependency graph edges from 'pjUnits' --- --- This graph contains both, library and executable dependencies edges -planJsonIdGraph :: PlanJson -> Map UnitId (Set UnitId) -planJsonIdGraph PlanJson{..} = M.fromList [ (uId unit, planItemAllDeps unit) - | unit <- M.elems pjUnits - ] - --- | Extract 'UnitId' root nodes from dependency graph computed by 'planJsonIdGraph' -planJsonIdRoots :: PlanJson -> Set UnitId -planJsonIdRoots PlanJson{..} = M.keysSet pjUnits `S.difference` nonRoots - where - nonRoots :: Set UnitId - nonRoots = mconcat $ M.elems $ planJsonIdGraph PlanJson{..} diff --git a/cabal.project b/cabal.project index 6c7bbcf..e6fdbad 100644 --- a/cabal.project +++ b/cabal.project @@ -1,2 +1 @@ -packages: . cabal-plan/ -allow-newer: cabal-plan:base cabal-plan:containers +packages: . |