Update cabal-helper to version 0.8.1.2 that supports Cabal (>=1.14 && <1.26 || >=2.0 && <2.5)

Building cabal-helper-0.8.1.2 with Stack failed with 'Dependency cycle detected' error. It seems to be https://github.com/commercialhaskell/stack/issues/4265 Stack bug. As a temporary solution I added source code of cabal-helper package to vendor directory and commented out 'build-tool-depends:  cabal-helper:cabal-helper-wrapper' line in the cabal-helper.cabal file.
This commit is contained in:
alexwl 2018-10-08 02:40:18 +03:00
parent 579a0f16c4
commit f38daf6773
57 changed files with 4847 additions and 1 deletions

View File

@ -1,5 +1,10 @@
resolver: lts-11.3
packages:
- '.'
packages:
- .
- location: vendor/cabal-helper-0.8.1.2
extra-dep: true
extra-deps:
- cabal-helper-0.8.0.2
- cabal-plan-0.4.0.0
- pretty-show-1.8.2

15
vendor/cabal-helper-0.8.1.2/.gitignore vendored Normal file
View File

@ -0,0 +1,15 @@
dist/
*~
/.cabal-sandbox/
add-source-timestamps
package.cache
cabal.sandbox.config
# Mac OS generates
# .DS_Store
*.o
*.dyn_o
*.hi
*.dyn_hi
# Emacs lock files
.#*

View File

@ -0,0 +1,27 @@
stages:
- build
job-ghc8.4.3-cabal-install2.2.0.0:
image: registry.gitlab.com/dxld/ghc-mod:ghc8.4.3-cabal-install2.2.0.0
stage: build
script: "$CI_PROJECT_DIR/scripts/ci/build.sh"
job-ghc8.2.2-cabal-install2.0.0.0:
image: registry.gitlab.com/dxld/ghc-mod:ghc8.2.2-cabal-install2.0.0.0
stage: build
script: "$CI_PROJECT_DIR/scripts/ci/build.sh"
job-ghc8.0.2-cabal-install2.0.0.0:
image: registry.gitlab.com/dxld/ghc-mod:ghc8.0.2-cabal-install2.0.0.0
stage: build
script: "$CI_PROJECT_DIR/scripts/ci/build.sh"
job-ghc7.10.3-cabal-install2.0.0.0:
image: registry.gitlab.com/dxld/ghc-mod:ghc7.10.3-cabal-install2.0.0.0
stage: build
script: "$CI_PROJECT_DIR/scripts/ci/build.sh"
job-ghc7.8.4-cabal-install2.0.0.0:
image: registry.gitlab.com/dxld/ghc-mod:ghc7.8.4-cabal-install2.0.0.0
stage: build
script: "$CI_PROJECT_DIR/scripts/ci/build.sh"

46
vendor/cabal-helper-0.8.1.2/.travis.yml vendored Normal file
View File

@ -0,0 +1,46 @@
language: haskell
ghc:
- 7.4
- 7.6
- 7.8
sudo: false
addons:
apt:
packages:
- zlib1g-dev
cache:
apt: true
directories:
- ~/.cabal
- ~/.ghc
- ~/.stack
install:
- export HOME=/tmp
- cabal update
- echo $PATH
- which cabal
- cabal install -j --only-dependencies --enable-tests
- if [ -n "$(ghc --version | awk '{ print $8 }' | sed -n '/^7.4/p')" ]; then cabal install Cabal --constraint "Cabal == 1.16.*"; fi
before_script:
- rm -f ~/.ghc-mod cabal-helper-*-Cabal-*
script:
- touch ChangeLog # Create ChangeLog if we're not on the release branch
- cabal check
- cabal sdist
- export SRC_TGZ="$PWD/dist/$(cabal info . | awk '{print $2 ".tar.gz";exit}')"
- rm -rf /tmp/cabal-helper* && cd /tmp
- tar -xf $SRC_TGZ && cd cabal-helper*/
- if [ -n "$(ghc --version | awk '{ print $8 }' | sed -n '/^7.8/p')" ]; then export WERROR="--ghc-option=-Werror"; fi
- cabal configure --enable-tests $WERROR
- cabal build
- ./dist/build/cabal-helper-wrapper-v0.7/cabal-helper-wrapper-v0.7 . dist "compiler-version" "entrypoints" "source-dirs" "ghc-options" "ghc-src-options" "ghc-pkg-options" "ghc-lang-options"
- ./dist/build/spec/spec

674
vendor/cabal-helper-0.8.1.2/LICENSE vendored Normal file
View File

@ -0,0 +1,674 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<http://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<http://www.gnu.org/philosophy/why-not-lgpl.html>.

34
vendor/cabal-helper-0.8.1.2/README.md vendored Normal file
View File

@ -0,0 +1,34 @@
# cabal-helper
[![build status](https://gitlab.com/dxld/cabal-helper/badges/master/build.svg)](https://gitlab.com/dxld/cabal-helper/commits/master)
Cabal's little helper provides access to build information gathered by `cabal`
when configuring a project. Specifically we're interested in retrieving enough
information to bring up a compiler session, using the GHC API, which is similar
to running `cabal repl` in a project.
While simple in principle this is complicated by the fact that the information
Cabal writes to disk is in an unstable format and only really accessible through
the Cabal API itself.
Since we do not want to bind the user of a development tool which utilises this
library to a specific version of Cabal we compile the code which interfaces with
the Cabal library's API on the user's machine, at runtime, against whichever
version of Cabal was used to write the on disk information for a given project.
If this version of Cabal is not available on the users machine anymore, which is
fairly likely since cabal-install is usually linked statically, we have support
for compiling the Cabal library also. In this case the library is installed into
a private, isolated, package database in `$XDG_CACHE_HOME/cabal-helper` so as to
not interfere with the user's package database.
## IRC
If you have any problems, suggestions, comments swing by
[\#ghc-mod (web client)](https://kiwiirc.com/client/irc.freenode.org/ghc-mod) on
Freenode. If you're reporting a bug please also create an issue
[here](https://github.com/DanielG/cabal-helper/issues) so we have a way to
contact you if you don't have time to stay.
Do hang around for a while if no one answers and repeat your question if you
still haven't gotten any answer after a day or so. You're most likely to get an
answer during the day in GMT+1.

2
vendor/cabal-helper-0.8.1.2/Setup.hs vendored Normal file
View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View File

@ -0,0 +1,291 @@
name: cabal-helper
version: 0.8.1.2
synopsis:
Simple interface to some of Cabal's configuration state, mainly used by ghc-mod
description:
Cabal's little helper provides access to build information gathered by
@cabal@ when configuring a project. Specifically we're interested in
retrieving enough information to bring up a compiler session, using the GHC
API, which is similar to running @cabal repl@ in a project.
.
While simple in principle this is complicated by the fact that the
information Cabal writes to disk is in an unstable format and only really
accessible through the Cabal API itself.
.
Since we do not want to bind the user of a development tool which utilises
this library to a specific version of Cabal we compile the code which
interfaces with the Cabal library's API on the user's machine, at runtime,
against whichever version of Cabal was used to write the on disk information
for a given project.
.
If this version of Cabal is not available on the users machine anymore,
which is fairly likely since cabal-install is usually linked statically, we
have support for compiling the Cabal library also. In this case the library
is installed into a private, isolated, package database in
@$XDG_CACHE_HOME/cabal-helper@ so as to not interfere with the user's
package database.
license: GPL-3
license-file: LICENSE
author: Daniel Gröber <cabal-helper@dxld.at>
maintainer: cabal-helper@dxld.at
category: Distribution
build-type: Custom
cabal-version: 2.0
extra-source-files: README.md
src/CabalHelper/Runtime/*.hs
tests/*.hs
tests/exelib/*.hs
tests/exelib/*.cabal
tests/exelib/lib/*.hs
tests/exeintlib/*.hs
tests/exeintlib/*.cabal
tests/exeintlib/lib/*.hs
tests/exeintlib/intlib/*.hs
tests/fliblib/*.hs
tests/fliblib/*.cabal
tests/fliblib/lib/*.hs
tests/bkpregex/*.cabal
tests/bkpregex/*.hs
tests/bkpregex/regex-example/*.hs
tests/bkpregex/regex-indef/*.hs
tests/bkpregex/regex-indef/*.hsig
tests/bkpregex/regex-types/Regex/*.hs
tests/bkpregex/str-impls/Str/*.hs
source-repository head
type: git
location: https://github.com/DanielG/cabal-helper.git
flag dev
description: Build development components
default: False
manual: True
custom-setup
setup-depends: base
, Cabal < 3 && >= 2.0.0.0
-- [Note test dependencies] Vaious tests need access to modules used in other
-- components, unfortunately we can't use Cabal 2.0's new internal libraries for
-- this because we'd like to support ancient Cabal versions. Instead we just
-- copy 'hs-source-dirs', 'build-depends' and 'other-modules' fields as
-- appropriate.
--
-- The following awk command will copy paragraphs starting with:
-- -- Common some-name
-- to following paragraphs starting with:
-- -- Instantiate common some-name
--
-- $ gawk -i inplace -f scripts/update-cabal-common-section-instantiations.awk cabal-helper.cabal
--
-- FIXME: We can use Cabal 2.0 features now, yey!
library
default-language: Haskell2010
default-extensions: NondecreasingIndentation
hs-source-dirs: lib, src
exposed-modules: Distribution.Helper
other-modules:
CabalHelper.Shared.InterfaceTypes
CabalHelper.Shared.Sandbox
Paths_cabal_helper
autogen-modules: Paths_cabal_helper
ghc-options: -Wall
-- well actually this is a "runtime"-tool-depends :)
-- build-tool-depends: cabal-helper:cabal-helper-wrapper
build-depends: base < 5 && >= 4.7
build-depends: Cabal < 2.5 && >= 2.0 || < 1.26 && >= 1.14
, cabal-plan < 0.5 && >= 0.3.0.0
, containers < 1 && >= 0.5.5.1
, directory < 1.4 && >= 1.2.1.0
, filepath < 1.5 && >= 1.3.0.0
, transformers < 0.6 && >= 0.3.0.0
, mtl < 2.3 && >= 2.0
, process < 1.7 && >= 1.1.0.1
if !os(windows)
build-depends: unix < 2.8 && >= 2.5.1.1
build-depends: unix-compat < 0.6 && >= 0.4.3.1
, semigroupoids < 5.3 && >= 5.2
executable cabal-helper-wrapper
main-is: CabalHelper/Compiletime/Wrapper.hs
if flag(dev)
ghc-options: -Wall
scope: private
-- Common c-h-wrapper-fields -- See [Note test dependencies]
default-language: Haskell2010
default-extensions: NondecreasingIndentation
other-extensions: TemplateHaskell
hs-source-dirs: src
other-modules:
CabalHelper.Compiletime.Compat.Environment
CabalHelper.Compiletime.Compat.ProgramDb
CabalHelper.Compiletime.Compat.Version
CabalHelper.Compiletime.Compile
CabalHelper.Compiletime.Data
CabalHelper.Compiletime.Log
CabalHelper.Compiletime.Types
CabalHelper.Shared.Common
CabalHelper.Shared.InterfaceTypes
CabalHelper.Shared.Sandbox
Paths_cabal_helper
build-tool-depends: cabal-install:cabal
build-depends: base < 5 && >= 4.7
if os(windows)
build-depends: base >= 4.7
build-depends: Cabal < 2.5 && >= 2.0 || < 1.26 && >= 1.14
, cabal-plan < 0.5 && >= 0.3.0.0
, containers < 1 && >= 0.5.5.1
, bytestring < 0.11 && >= 0.9.2.1
, directory < 1.4 && >= 1.2.1.0
, filepath < 1.5 && >= 1.3.0.0
, mtl < 2.3 && >= 2.0
, process < 1.7 && >= 1.1.0.1
, pretty-show < 1.9 && >= 1.8.1
, text < 1.3 && >= 1.0.0.0
, template-haskell < 2.14 && >= 2.7.0.0
, temporary < 1.3 && >= 1.2.1
, transformers < 0.6 && >= 0.3.0.0
if !os(windows)
build-depends: unix < 2.8 && >= 2.5.1.1
build-depends: unix-compat < 0.6 && >= 0.4.3.1
, utf8-string < 1.1 && >= 1.0.1.1
build-tools: cabal
test-suite compile-test
type: exitcode-stdio-1.0
main-is: CompileTest.hs
hs-source-dirs: tests
ghc-options: -Wall
build-tools: cabal
-- Instantiate common c-h-wrapper-fields -- See [Note test dependencies]
default-language: Haskell2010
default-extensions: NondecreasingIndentation
other-extensions: TemplateHaskell
hs-source-dirs: src
other-modules:
CabalHelper.Compiletime.Compat.Environment
CabalHelper.Compiletime.Compat.ProgramDb
CabalHelper.Compiletime.Compat.Version
CabalHelper.Compiletime.Compile
CabalHelper.Compiletime.Data
CabalHelper.Compiletime.Log
CabalHelper.Compiletime.Types
CabalHelper.Shared.Common
CabalHelper.Shared.InterfaceTypes
CabalHelper.Shared.Sandbox
Paths_cabal_helper
build-tool-depends: cabal-install:cabal
build-depends: base < 5 && >= 4.7
if os(windows)
build-depends: base >= 4.7
build-depends: Cabal < 2.5 && >= 2.0 || < 1.26 && >= 1.14
, cabal-plan < 0.5 && >= 0.3.0.0
, containers < 1 && >= 0.5.5.1
, bytestring < 0.11 && >= 0.9.2.1
, directory < 1.4 && >= 1.2.1.0
, filepath < 1.5 && >= 1.3.0.0
, mtl < 2.3 && >= 2.0
, process < 1.7 && >= 1.1.0.1
, pretty-show < 1.9 && >= 1.8.1
, text < 1.3 && >= 1.0.0.0
, template-haskell < 2.14 && >= 2.7.0.0
, temporary < 1.3 && >= 1.2.1
, transformers < 0.6 && >= 0.3.0.0
if !os(windows)
build-depends: unix < 2.8 && >= 2.5.1.1
build-depends: unix-compat < 0.6 && >= 0.4.3.1
, utf8-string < 1.1 && >= 1.0.1.1
build-tools: cabal
test-suite ghc-session
type: exitcode-stdio-1.0
main-is: GhcSession.hs
hs-source-dirs: tests
ghc-options: -Wall
build-depends: base < 5 && >= 4.7
, ghc < 8.5 && >= 7.8
, ghc-paths < 0.2 && >= 0.1.0.9
, cabal-helper
-- Instantiate common c-h-wrapper-fields -- See [Note test dependencies]
default-language: Haskell2010
default-extensions: NondecreasingIndentation
other-extensions: TemplateHaskell
hs-source-dirs: src
other-modules:
CabalHelper.Compiletime.Compat.Environment
CabalHelper.Compiletime.Compat.ProgramDb
CabalHelper.Compiletime.Compat.Version
CabalHelper.Compiletime.Compile
CabalHelper.Compiletime.Data
CabalHelper.Compiletime.Log
CabalHelper.Compiletime.Types
CabalHelper.Shared.Common
CabalHelper.Shared.InterfaceTypes
CabalHelper.Shared.Sandbox
Paths_cabal_helper
build-tool-depends: cabal-install:cabal
build-depends: base < 5 && >= 4.7
if os(windows)
build-depends: base >= 4.7
build-depends: Cabal < 2.5 && >= 2.0 || < 1.26 && >= 1.14
, cabal-plan < 0.5 && >= 0.3.0.0
, containers < 1 && >= 0.5.5.1
, bytestring < 0.11 && >= 0.9.2.1
, directory < 1.4 && >= 1.2.1.0
, filepath < 1.5 && >= 1.3.0.0
, mtl < 2.3 && >= 2.0
, process < 1.7 && >= 1.1.0.1
, pretty-show < 1.9 && >= 1.8.1
, text < 1.3 && >= 1.0.0.0
, template-haskell < 2.14 && >= 2.7.0.0
, temporary < 1.3 && >= 1.2.1
, transformers < 0.6 && >= 0.3.0.0
if !os(windows)
build-depends: unix < 2.8 && >= 2.5.1.1
build-depends: unix-compat < 0.6 && >= 0.4.3.1
, utf8-string < 1.1 && >= 1.0.1.1
build-tools: cabal
executable cabal-helper-main
default-language: Haskell2010
default-extensions: NondecreasingIndentation
main-is: CabalHelper/Runtime/Main.hs
hs-source-dirs: src
other-modules:
CabalHelper.Shared.Common
CabalHelper.Shared.InterfaceTypes
CabalHelper.Shared.Sandbox
-- This component is usually built at runtime by cabal-helper-wrapper but
-- during development it's convinient to build it via cabal
if flag(dev)
buildable: True
else
buildable: False
-- Common c-h-main-fields -- See [Note test dependencies]
ghc-options: -Wall -fno-warn-unused-imports
build-depends: base < 5 && >= 4.7
, Cabal
, containers
, bytestring
, filepath
, directory
, ghc-prim

View File

@ -0,0 +1,2 @@
packages: .

View File

@ -0,0 +1,589 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE CPP, RecordWildCards, FlexibleContexts, ConstraintKinds,
GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric, DeriveFunctor,
NamedFieldPuns, OverloadedStrings
#-}
{-|
Module : Distribution.Helper
License : GPL-3
Maintainer : cabal-helper@dxld.at
Portability : POSIX
-}
module Distribution.Helper (
-- * Running Queries
Query
, runQuery
-- * Queries against Cabal\'s on disk state
-- ** Package queries
, packageId
, packageDbStack
, packageFlags
, compilerVersion
, ghcMergedPkgOptions
-- ** cabal-install queries
, configFlags
, nonDefaultConfigFlags
-- ** Component queries
, ComponentQuery
, components
, ghcSrcOptions
, ghcPkgOptions
, ghcLangOptions
, ghcOptions
, sourceDirs
, entrypoints
, needsBuildOutput
-- * Query environment
, QueryEnv
, mkQueryEnv
, qeReadProcess
, qePrograms
, qeProjectDir
, qeDistDir
, qeCabalPkgDb
, qeCabalVer
, Programs(..)
, defaultPrograms
-- * Result types
, ChModuleName(..)
, ChComponentName(..)
, ChPkgDb(..)
, ChEntrypoint(..)
, NeedsBuildOutput(..)
-- * General information
, buildPlatform
-- * Stuff that cabal-install really should export
, Distribution.Helper.getSandboxPkgDb
-- * Managing @dist/@
, prepare
, reconfigure
, writeAutogenFiles
-- * $libexec related error handling
, LibexecNotFoundError(..)
, libexecNotFoundError
-- * Reexports
, module Data.Functor.Apply
) where
import Cabal.Plan
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.State.Strict
import Control.Monad.Reader
import Control.Exception as E
import Data.Char
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import Data.Version
import Data.Typeable
import Data.Function
import Data.Functor.Apply
import Distribution.System (buildOS, OS(Windows))
import System.Environment
import System.FilePath hiding ((<.>))
import qualified System.FilePath as FP
import System.Directory
import System.Process
import System.IO.Unsafe
import Text.Printf
import GHC.Generics
import Prelude
import Paths_cabal_helper (getLibexecDir)
import CabalHelper.Shared.InterfaceTypes
import CabalHelper.Shared.Sandbox
-- | Paths or names of various programs we need.
data Programs = Programs {
-- | The path to the @cabal@ program.
cabalProgram :: FilePath,
-- | The path to the @ghc@ program.
ghcProgram :: FilePath,
-- | The path to the @ghc-pkg@ program. If
-- not changed it will be derived from the path to 'ghcProgram'.
ghcPkgProgram :: FilePath
} deriving (Eq, Ord, Show, Read, Generic, Typeable)
-- | Default all programs to their unqualified names, i.e. they will be searched
-- for on @PATH@.
defaultPrograms :: Programs
defaultPrograms = Programs "cabal" "ghc" "ghc-pkg"
-- | Environment for running a 'Query'. The real constructor is not exposed,
-- the field accessors are however. See below. Use the 'mkQueryEnv' smart
-- constructor to construct one.
data QueryEnv = QueryEnv {
-- | Field accessor for 'QueryEnv'. Defines how to start the cabal-helper
-- process. Useful if you need to capture stderr output from the helper.
qeReadProcess :: FilePath -> [String] -> String -> IO String,
-- | Field accessor for 'QueryEnv'.
qePrograms :: Programs,
-- | Field accessor for 'QueryEnv'. Defines path to the project directory,
-- i.e. a directory containing a @project.cabal@ file
qeProjectDir :: FilePath,
-- | Field accessor for 'QueryEnv'. Defines path to the @dist/@ directory,
-- /builddir/ in Cabal terminology.
qeDistDir :: FilePath,
-- | Field accessor for 'QueryEnv'. Defines where to look for the Cabal
-- library when linking the helper.
qeCabalPkgDb :: Maybe FilePath,
-- | Field accessor for 'QueryEnv'. If @dist/setup-config@ wasn\'t written
-- by this version of Cabal an error is thrown when running the query.
qeCabalVer :: Maybe Version
}
-- | @mkQueryEnv projdir distdir@. Smart constructor for 'QueryEnv'.
-- Sets fields 'qeProjectDir' and 'qeDistDir' to @projdir@ and @distdir@
-- respectively and provides sensible defaults for the other fields.
mkQueryEnv :: FilePath
-- ^ Path to the project directory, i.e. the directory containing a
-- @project.cabal@ file
-> FilePath
-- ^ Path to the @dist/@ directory, called /builddir/ in Cabal
-- terminology.
-> QueryEnv
mkQueryEnv projdir distdir = QueryEnv {
qeReadProcess = readProcess
, qePrograms = defaultPrograms
, qeProjectDir = projdir
, qeDistDir = distdir
, qeCabalPkgDb = Nothing
, qeCabalVer = Nothing
}
data SomeLocalBuildInfo = SomeLocalBuildInfo {
slbiPackageDbStack :: [ChPkgDb],
slbiPackageFlags :: [(String, Bool)],
slbiCompilerVersion :: (String, Version),
slbiGhcMergedPkgOptions :: [String],
slbiConfigFlags :: [(String, Bool)],
slbiNonDefaultConfigFlags :: [(String, Bool)],
slbiGhcSrcOptions :: [(ChComponentName, [String])],
slbiGhcPkgOptions :: [(ChComponentName, [String])],
slbiGhcLangOptions :: [(ChComponentName, [String])],
slbiGhcOptions :: [(ChComponentName, [String])],
slbiSourceDirs :: [(ChComponentName, [String])],
slbiEntrypoints :: [(ChComponentName, ChEntrypoint)],
slbiNeedsBuildOutput :: [(ChComponentName, NeedsBuildOutput)]
} deriving (Eq, Ord, Read, Show)
-- | A lazy, cached, query against a package's Cabal configuration. Use
-- 'runQuery' to execute it.
newtype Query m a = Query { unQuery :: StateT (Maybe SomeLocalBuildInfo)
(ReaderT QueryEnv m) a }
deriving (Functor, Applicative, Monad, MonadIO)
instance MonadTrans Query where
lift = Query . lift . lift
type MonadQuery m = ( MonadIO m
, MonadState (Maybe SomeLocalBuildInfo) m
, MonadReader QueryEnv m)
-- | A 'Query' to run on all components of a package. Use 'components' to get a
-- regular 'Query'.
newtype ComponentQuery m a = ComponentQuery (Query m [(ChComponentName, a)])
deriving (Functor)
instance (Functor m, Monad m) => Apply (ComponentQuery m) where
ComponentQuery flab <.> ComponentQuery fla =
ComponentQuery $ liftM2 go flab fla
where
go :: [(ChComponentName, a -> b)]
-> [(ChComponentName, a)]
-> [(ChComponentName, b)]
go lab la =
[ (cn, ab a)
| (cn, ab) <- lab
, (cn', a) <- la
, cn == cn'
]
run :: Monad m => QueryEnv -> Maybe SomeLocalBuildInfo -> Query m a -> m a
run e s action = flip runReaderT e (flip evalStateT s (unQuery action))
-- | @runQuery env query@. Run a 'Query' under a given 'QueryEnv'.
runQuery :: Monad m
=> QueryEnv
-> Query m a
-> m a
runQuery qe action = run qe Nothing action
getSlbi :: MonadQuery m => m SomeLocalBuildInfo
getSlbi = do
s <- get
case s of
Nothing -> do
slbi <- getSomeConfigState
put (Just slbi)
return slbi
Just slbi -> return slbi
-- | List of package databases to use.
packageDbStack :: MonadIO m => Query m [ChPkgDb]
-- | Like @ghcPkgOptions@ but for the whole package not just one component
ghcMergedPkgOptions :: MonadIO m => Query m [String]
-- | Flag definitions from cabal file
packageFlags :: MonadIO m => Query m [(String, Bool)]
-- | Flag assignments from setup-config
configFlags :: MonadIO m => Query m [(String, Bool)]
-- | Flag assignments from setup-config which differ from the default
-- setting. This can also include flags which cabal decided to modify,
-- i.e. don't rely on these being the flags set by the user directly.
nonDefaultConfigFlags :: MonadIO m => Query m [(String, Bool)]
-- | The version of GHC the project is configured to use
compilerVersion :: MonadIO m => Query m (String, Version)
-- | Package identifier, i.e. package name and version
packageId :: MonadIO m => Query m (String, Version)
-- | Run a ComponentQuery on all components of the package.
components :: Monad m => ComponentQuery m (ChComponentName -> b) -> Query m [b]
components (ComponentQuery sc) = map (\(cn, f) -> f cn) `liftM` sc
-- | Modules or files Cabal would have the compiler build directly. Can be used
-- to compute the home module closure for a component.
entrypoints :: MonadIO m => ComponentQuery m ChEntrypoint
-- | The component has a non-default module renaming, so needs build output ().
needsBuildOutput :: MonadIO m => ComponentQuery m NeedsBuildOutput
-- | A component's @source-dirs@ field, beware since if this is empty implicit
-- behaviour in GHC kicks in.
sourceDirs :: MonadIO m => ComponentQuery m [FilePath]
-- | All options Cabal would pass to GHC.
ghcOptions :: MonadIO m => ComponentQuery m [String]
-- | Only search path related GHC options.
ghcSrcOptions :: MonadIO m => ComponentQuery m [String]
-- | Only package related GHC options, sufficient for things don't need to
-- access any home modules.
ghcPkgOptions :: MonadIO m => ComponentQuery m [String]
-- | Only language related options, i.e. @-XSomeExtension@
ghcLangOptions :: MonadIO m => ComponentQuery m [String]
packageId = Query $ getPackageId
packageDbStack = Query $ slbiPackageDbStack `liftM` getSlbi
packageFlags = Query $ slbiPackageFlags `liftM` getSlbi
compilerVersion = Query $ slbiCompilerVersion `liftM` getSlbi
ghcMergedPkgOptions = Query $ slbiGhcMergedPkgOptions `liftM` getSlbi
configFlags = Query $ slbiConfigFlags `liftM` getSlbi
nonDefaultConfigFlags = Query $ slbiNonDefaultConfigFlags `liftM` getSlbi
ghcSrcOptions = ComponentQuery $ Query $ slbiGhcSrcOptions `liftM` getSlbi
ghcPkgOptions = ComponentQuery $ Query $ slbiGhcPkgOptions `liftM` getSlbi
ghcOptions = ComponentQuery $ Query $ slbiGhcOptions `liftM` getSlbi
ghcLangOptions = ComponentQuery $ Query $ slbiGhcLangOptions `liftM` getSlbi
sourceDirs = ComponentQuery $ Query $ slbiSourceDirs `liftM` getSlbi
entrypoints = ComponentQuery $ Query $ slbiEntrypoints `liftM` getSlbi
needsBuildOutput = ComponentQuery $ Query $ slbiNeedsBuildOutput `liftM` getSlbi
-- | Run @cabal configure@
reconfigure :: MonadIO m
=> (FilePath -> [String] -> String -> IO String)
-> Programs -- ^ Program paths
-> [String] -- ^ Command line arguments to be passed to @cabal@
-> m ()
reconfigure readProc progs cabalOpts = do
let progOpts =
[ "--with-ghc=" ++ ghcProgram progs ]
-- Only pass ghc-pkg if it was actually set otherwise we
-- might break cabal's guessing logic
++ if ghcPkgProgram progs /= "ghc-pkg"
then [ "--with-ghc-pkg=" ++ ghcPkgProgram progs ]
else []
++ cabalOpts
_ <- liftIO $ readProc (cabalProgram progs) ("configure":progOpts) ""
return ()
readHelper :: (MonadIO m, MonadQuery m) => [String] -> m [Maybe ChResponse]
readHelper args = ask >>= \qe -> liftIO $ do
out <- either error id <$> invokeHelper qe args
let res = read out
liftIO $ evaluate res `E.catch` \se@(SomeException _) -> do
md <- lookupEnv' "CABAL_HELPER_DEBUG"
let msg = "readHelper: exception: '" ++ show se ++ "'"
error $ msg ++ case md of
Nothing -> ", for more information set the environment variable CABAL_HELPER_DEBUG"
Just _ -> ", output: '"++ out ++"'"
invokeHelper :: QueryEnv -> [String] -> IO (Either String String)
invokeHelper QueryEnv {..} args = do
let progArgs = [ "--with-ghc=" ++ ghcProgram qePrograms
, "--with-ghc-pkg=" ++ ghcPkgProgram qePrograms
, "--with-cabal=" ++ cabalProgram qePrograms
]
exe <- findLibexecExe
let args' = progArgs ++ "v1-style":qeProjectDir:qeDistDir:args
out <- qeReadProcess exe args' ""
(Right <$> evaluate out) `E.catch` \(SomeException _) ->
return $ Left $ concat
["invokeHelper", ": ", exe, " "
, intercalate " " (map show args')
, " failed"
]
getPackageId :: MonadQuery m => m (String, Version)
getPackageId = ask >>= \QueryEnv {..} -> do
[ Just (ChResponseVersion pkgName pkgVer) ] <- readHelper [ "package-id" ]
return (pkgName, pkgVer)
getSomeConfigState :: MonadQuery m => m SomeLocalBuildInfo
getSomeConfigState = ask >>= \QueryEnv {..} -> do
res <- readHelper
[ "package-db-stack"
, "flags"
, "compiler-version"
, "ghc-merged-pkg-options"
, "config-flags"
, "non-default-config-flags"
, "ghc-src-options"
, "ghc-pkg-options"
, "ghc-lang-options"
, "ghc-options"
, "source-dirs"
, "entrypoints"
, "needs-build-output"
]
let [ Just (ChResponsePkgDbs slbiPackageDbStack),
Just (ChResponseFlags slbiPackageFlags),
Just (ChResponseVersion comp compVer),
Just (ChResponseList slbiGhcMergedPkgOptions),
Just (ChResponseFlags slbiConfigFlags),
Just (ChResponseFlags slbiNonDefaultConfigFlags),
Just (ChResponseCompList slbiGhcSrcOptions),
Just (ChResponseCompList slbiGhcPkgOptions),
Just (ChResponseCompList slbiGhcLangOptions),
Just (ChResponseCompList slbiGhcOptions),
Just (ChResponseCompList slbiSourceDirs),
Just (ChResponseEntrypoints slbiEntrypoints),
Just (ChResponseNeedsBuild slbiNeedsBuildOutput)
] = res
slbiCompilerVersion = (comp, compVer)
return $ SomeLocalBuildInfo {..}
-- | Make sure the appropriate helper executable for the given project is
-- installed and ready to run queries.
prepare :: MonadIO m => QueryEnv -> m ()
prepare qe =
liftIO $ void $ invokeHelper qe []
-- | Create @cabal_macros.h@ and @Paths_\<pkg\>@ possibly other generated files
-- in the usual place.
writeAutogenFiles :: MonadIO m => QueryEnv -> m ()
writeAutogenFiles qe =
liftIO $ void $ invokeHelper qe ["write-autogen-files"]
-- | Get the path to the sandbox package-db in a project
getSandboxPkgDb :: (FilePath -> [String] -> String -> IO String)
-> String
-- ^ Cabal build platform, i.e. @buildPlatform@
-> Version
-- ^ GHC version (@cProjectVersion@ is your friend)
-> IO (Maybe FilePath)
getSandboxPkgDb readProc =
CabalHelper.Shared.Sandbox.getSandboxPkgDb $ unsafePerformIO $ buildPlatform readProc
buildPlatform :: (FilePath -> [String] -> String -> IO String) -> IO String
buildPlatform readProc = do
exe <- findLibexecExe
CabalHelper.Shared.Sandbox.dropWhileEnd isSpace <$> readProc exe ["print-build-platform"] ""
-- | This exception is thrown by all 'runQuery' functions if the internal
-- wrapper executable cannot be found. You may catch this and present the user
-- an appropriate error message however the default is to print
-- 'libexecNotFoundError'.
data LibexecNotFoundError = LibexecNotFoundError String FilePath
deriving (Typeable)
instance Exception LibexecNotFoundError
instance Show LibexecNotFoundError where
show (LibexecNotFoundError exe dir) =
libexecNotFoundError exe dir "https://github.com/DanielG/cabal-helper/issues"
findLibexecExe :: IO FilePath
findLibexecExe = do
libexecdir <- getLibexecDir
let exeName = "cabal-helper-wrapper"
exe = libexecdir </> exeName FP.<.> exeExtension'
exists <- doesFileExist exe
if exists
then return exe
else do
mdir <- tryFindCabalHelperTreeDistDir
dir <- case mdir of
Nothing ->
throwIO $ LibexecNotFoundError exeName libexecdir
Just dir ->
return dir
return $ dir </> "build" </> exeName </> exeName
findPlanJson :: FilePath -> IO (Maybe FilePath)
findPlanJson base =
findFile (map (</> "cache") $ parents base) "plan.json"
parents :: FilePath -> [FilePath]
parents path = takeWhile (not . (`elem` ["", "."]) . dropDrive) dirs
where dirs = iterate takeDirectory path
data DistDir = DistDir { ddType :: DistDirType, unDistDir :: FilePath }
deriving (Eq, Ord, Read, Show)
data DistDirType = NewBuildDist | OldBuildDist
deriving (Eq, Ord, Read, Show)
tryFindCabalHelperTreeDistDir :: IO (Maybe FilePath)
tryFindCabalHelperTreeDistDir = do
exe <- canonicalizePath =<< getExecutablePath'
mplan <- findPlanJson exe
let mdistdir = takeDirectory . takeDirectory <$> mplan
cwd <- getCurrentDirectory
let candidates = sortBy (compare `on` ddType) $ concat
[ maybeToList $ DistDir NewBuildDist <$> mdistdir
, [ DistDir OldBuildDist $ (!!3) $ iterate takeDirectory exe ]
, if takeFileName exe == "ghc" -- we're probably in ghci; try CWD
then [ DistDir NewBuildDist $ cwd </> "dist-newstyle"
, DistDir NewBuildDist $ cwd </> "dist"
, DistDir OldBuildDist $ cwd </> "dist"
]
else []
]
distdirs
<- filterM isDistDir candidates
>>= mapM toOldBuildDistDir
return $ fmap unDistDir $ join $ listToMaybe $ distdirs
isCabalHelperSourceDir :: FilePath -> IO Bool
isCabalHelperSourceDir dir =
doesFileExist $ dir </> "cabal-helper.cabal"
isDistDir :: DistDir -> IO Bool
isDistDir (DistDir NewBuildDist dir) =
doesFileExist (dir </> "cache" </> "plan.json")
isDistDir (DistDir OldBuildDist dir) =
doesFileExist (dir </> "setup-config")
toOldBuildDistDir :: DistDir -> IO (Maybe DistDir)
toOldBuildDistDir (DistDir NewBuildDist dir) = do
PlanJson {pjUnits} <- decodePlanJson $ dir </> "cache" </> "plan.json"
let munit = find isCabalHelperUnit $ Map.elems pjUnits
return $ DistDir OldBuildDist <$> join ((\Unit { uDistDir = mdistdir } -> mdistdir) <$> munit)
where
isCabalHelperUnit
Unit { uPId = PkgId (PkgName n) _
, uType = UnitTypeLocal
, uComps
} | n == "cabal-helper" &&
Map.member (CompNameExe "cabal-helper-wrapper") uComps
= True
isCabalHelperUnit _ = False
toOldBuildDistDir x = return $ Just x
libexecNotFoundError :: String -- ^ Name of the executable we were trying to
-- find
-> FilePath -- ^ Path to @$libexecdir@
-> String -- ^ URL the user will be directed towards to
-- report a bug.
-> String
libexecNotFoundError exe dir reportBug = printf
( "Could not find $libexecdir/%s\n"
++"\n"
++"If you are a cabal-helper developer you can set the environment variable\n"
++"`cabal_helper_libexecdir' to override $libexecdir[1]. The following will\n"
++"work in the cabal-helper source tree:\n"
++"\n"
++" $ export cabal_helper_libexecdir=$PWD/dist/build/%s\n"
++"\n"
++"[1]: %s\n"
++"\n"
++"If you don't know what I'm talking about something went wrong with your\n"
++"installation. Please report this problem here:\n"
++"\n"
++" %s") exe exe dir reportBug
getExecutablePath' :: IO FilePath
getExecutablePath' =
#if MIN_VERSION_base(4,6,0)
getExecutablePath
#else
getProgName
#endif
lookupEnv' :: String -> IO (Maybe String)
lookupEnv' k = lookup k <$> getEnvironment
exeExtension' :: FilePath
exeExtension'
| Windows <- buildOS = "exe"
| otherwise = ""

24
vendor/cabal-helper-0.8.1.2/scripts/bump.sh vendored Executable file
View File

@ -0,0 +1,24 @@
#!/bin/sh
set -e
if [ -z "$1" ]; then
echo "Usage: $0 VERSION" >&2
exit 1
fi
VERSION=$1
if ! echo $VERSION | grep "^[0-9.]"; then
echo "invalid version";
exit 1
fi
cd $(dirname $0)/..
sed -r -i 's/^(version:[[:space:]]*)[0-9.]+/\1'"$VERSION"'/' cabal-helper.cabal
git add cabal-helper.cabal
git commit -m "Bump version to $VERSION"
git tag "v$VERSION"

View File

@ -0,0 +1,9 @@
#!/bin/sh
set -ex
CI_SCRIPTS_DIR="$(realpath "$(dirname "$0")")"
for step in $(printf '%s\n' "$CI_SCRIPTS_DIR"/steps/* | sort); do
. $step
done

View File

@ -0,0 +1,5 @@
if [ -e cabal.sandbox.config ]; then
cabal sandbox hc-pkg list
else
ghc-pkg list
fi

View File

@ -0,0 +1,50 @@
#!/usr/bin/env bash
# MIT LICENSE
#
# Copyright (c) 2016 Travis CI GmbH <contact@travis-ci.org>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.
#
#
# Copied from github.com/travis-ci/travis-build and modified to pass shellcheck.
# Copied from https://github.com/cockroachdb/cockroach/blob/b4b7412d1c899a7488a9839eb4e01a616e4de135/scripts/travis_retry.sh and modified slightly
retry() {
local result=0
local count=1
while [ $count -le 3 ]; do
[ $result -ne 0 ] && {
echo -e "\n${ANSI_RED}The command \"$*\" failed. Retrying, $count of 3.${ANSI_RESET}\n" >&2
}
"$@"
result=$?
[ $result -eq 0 ] && break
count=$((count + 1))
sleep 10
done
[ $count -gt 3 ] && {
echo -e "\n${ANSI_RED}The command \"$*\" failed 3 times.${ANSI_RESET}\n" >&2
}
return $result
}
retry "$@"

View File

@ -0,0 +1,12 @@
if [ -w . ]; then
sandbox="$PWD"/.cabal-sandbox
sandbox_config="$PWD"/cabal.sandbox.config
else
sandbox="$HOME"/cabal-sandbox
sandbox_config="$HOME"/cabal.sandbox.config
fi
source_dir="$(mktemp --tmpdir -d "cabal-helper.sdistXXXXXXXXX")"
build_dir="$(mktemp --tmpdir -d "cabal-helper.distXXXXXXXXX")"
NPROC=${NPROC:-1}

View File

@ -0,0 +1 @@
../print-packages.sh

View File

@ -0,0 +1,3 @@
"$CI_SCRIPTS_DIR"/retry.sh cabal update
cabal --sandbox-config="$sandbox_config" sandbox init --sandbox="$sandbox"
cabal --sandbox-config="$sandbox_config" install --only-dependencies --enable-tests

View File

@ -0,0 +1 @@
../print-packages.sh

View File

@ -0,0 +1,6 @@
mkdir -p "$source_dir"
mkdir -p "$build_dir"
cabal --sandbox-config="$sandbox_config" sdist --builddir="$build_dir" --output-directory="$source_dir"
cd "$source_dir"

View File

@ -0,0 +1,4 @@
# -fdev enables building the helper "main" exe directly and enables more warnings
cabal --sandbox-config="$sandbox_config" configure --builddir="$build_dir" --enable-tests -fdev
cabal --sandbox-config="$sandbox_config" build --builddir="$build_dir"
cabal --sandbox-config="$sandbox_config" haddock --builddir="$build_dir"

View File

@ -0,0 +1,2 @@
cabal_helper_libexecdir="$build_dir"/build/cabal-helper-wrapper \
cabal --sandbox-config="$sandbox_config" test --builddir="$build_dir" --show-details=streaming

View File

@ -0,0 +1,34 @@
BEGIN {
delete sections;
section="";
ignoring=0;
}
/^[[:space:]]*$/ {
section="";
ignoring=0;
}
{
if(section) {
tmp = sections[section];
sections[section] = tmp (tmp ? RS : "") $0;
}
}
/^[[:space:]]*-- *Common/ {
section = $3
}
/^[[:space:]]*-- *Instantiate *common/ {
ignoring=1
print $0;
print sections[$4];
}
{
if(!ignoring) {
print $0;
}
}

View File

@ -0,0 +1,35 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2017 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE CPP #-}
module CabalHelper.Compiletime.Compat.Environment where
import qualified System.Environment
#ifndef mingw32_HOST_OS
import qualified System.Posix.Env (setEnv)
#endif
lookupEnv :: String -> IO (Maybe String)
lookupEnv var =
do env <- System.Environment.getEnvironment
return (lookup var env)
setEnv :: String -> String -> IO ()
#ifdef mingw32_HOST_OS
setEnv = System.Environment.setEnv
#else
setEnv k v = System.Posix.Env.setEnv k v True
#endif

View File

@ -0,0 +1,30 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE CPP #-}
module CabalHelper.Compiletime.Compat.ProgramDb
( defaultProgramDb
, programPath
, lookupProgram
, ghcProgram
, ghcPkgProgram
) where
import Distribution.Simple.Program
#if !MIN_VERSION_Cabal(2,0,0)
defaultProgramDb = defaultProgramConfiguration
#endif

View File

@ -0,0 +1,49 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2017-2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE CPP #-}
module CabalHelper.Compiletime.Compat.Version
( DataVersion
, toDataVersion
, fromDataVersion
, Data.Version.showVersion
, makeDataVersion
) where
import qualified Data.Version
import qualified Distribution.Version (Version)
#if MIN_VERSION_Cabal(2,0,0)
import qualified Distribution.Version (versionNumbers, mkVersion)
#endif
type DataVersion = Data.Version.Version
toDataVersion :: Distribution.Version.Version -> Data.Version.Version
fromDataVersion :: Data.Version.Version -> Distribution.Version.Version
#if MIN_VERSION_Cabal(2,0,0)
toDataVersion v = Data.Version.Version (Distribution.Version.versionNumbers v) []
fromDataVersion (Data.Version.Version vs _) = Distribution.Version.mkVersion vs
#else
toDataVersion = id
fromDataVersion = id
#endif
makeDataVersion :: [Int] -> Data.Version.Version
#if MIN_VERSION_base(4,8,0)
makeDataVersion = Data.Version.makeVersion
#else
makeDataVersion xs = Data.Version.Version xs []
#endif

View File

@ -0,0 +1,736 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE RecordWildCards, FlexibleContexts, NamedFieldPuns, DeriveFunctor,
GADTs #-}
{-|
Module : CabalHelper.Compiletime.Compile
Description : Runtime compilation machinery
License : GPL-3
-}
module CabalHelper.Compiletime.Compile where
import Cabal.Plan
import Control.Applicative
import Control.Arrow
import Control.Exception as E
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Data.Char
import Data.List
import Data.Maybe
import Data.String
import Data.Version
import GHC.IO.Exception (IOErrorType(OtherError))
import Text.Printf
import Text.Read
import System.Directory
import System.FilePath
import System.Process
import System.Exit
import System.Environment
import System.IO
import System.IO.Error
import System.IO.Temp
import Prelude
import qualified Data.Text as Text
import qualified Data.Map.Strict as Map
import Distribution.System (buildPlatform)
import Distribution.Text (display)
import Paths_cabal_helper (version)
import CabalHelper.Compiletime.Data
import CabalHelper.Compiletime.Log
import CabalHelper.Compiletime.Types
import CabalHelper.Shared.Common
import CabalHelper.Shared.Sandbox (getSandboxPkgDb)
data Compile
= CompileWithCabalSource
{ compCabalSourceDir :: CabalSourceDir
, compCabalSourceVersion :: Version
}
| CompileWithCabalPackage
{ compPackageDb :: Maybe PackageDbDir
, compCabalVersion :: CabalVersion
, compPackageDeps :: [String]
, compProductTarget :: CompilationProductScope
}
data CompPaths = CompPaths
{ compSrcDir :: FilePath
, compOutDir :: FilePath
, compExePath :: FilePath
}
-- | The Helper executable we produce as a compilation product can either be
-- placed in a per-project location, or a per-user/global location in the user's
-- home directory. This type controls where the compilation process places the
-- executable.
data CompilationProductScope = CPSGlobal | CPSProject
compileHelper :: Options -> Version -> FilePath -> Maybe (PlanJson, FilePath) -> FilePath -> IO (Either ExitCode FilePath)
compileHelper opts hdrCabalVersion projdir mnewstyle distdir = do
ghcVer <- ghcVersion opts
Just (prepare, comp) <- runMaybeT $ msum $
case oCabalPkgDb opts of
Nothing ->
[ compileCabalSource
, compileNewBuild ghcVer
, compileSandbox ghcVer
, compileGlobal
, MaybeT $ Just <$> compileWithCabalInPrivatePkgDb
]
Just db ->
[ return $ (return (), compileWithPkg (Just db) hdrCabalVersion CPSProject)
]
appdir <- appCacheDir
let cp@CompPaths {compExePath} = compPaths appdir distdir comp
exists <- doesFileExist compExePath
if exists
then do
vLog opts $ "helper already compiled, using exe: "++compExePath
return (Right compExePath)
else do
vLog opts $ "helper exe does not exist, compiling "++compExePath
prepare >> compile comp cp opts
where
logMsg = "using helper compiled with Cabal from "
-- for relaxed deps: find (sameMajorVersionAs hdrCabalVersion) . reverse . sort
-- | Check if this version is globally available
compileGlobal :: MaybeT IO (IO (), Compile)
compileGlobal = do
cabal_versions <- listCabalVersions opts
ver <- MaybeT $ return $ find (== hdrCabalVersion) cabal_versions
vLog opts $ logMsg ++ "user/global package-db"
return $ (return (), compileWithPkg Nothing ver CPSGlobal)
-- | Check if this version is available in the project sandbox
compileSandbox :: Version -> MaybeT IO (IO (), Compile)
compileSandbox ghcVer = do
let mdb_path = getSandboxPkgDb projdir (display buildPlatform) ghcVer
sandbox <- PackageDbDir <$> MaybeT mdb_path
cabal_versions <- listCabalVersions' opts (Just sandbox)
ver <- MaybeT $ return $ find (== hdrCabalVersion) cabal_versions
vLog opts $ logMsg ++ "sandbox package-db"
return $ (return (), compileWithPkg (Just sandbox) ver CPSProject)
compileNewBuild :: Version -> MaybeT IO (IO (), Compile)
compileNewBuild ghcVer = do
(PlanJson {pjUnits}, distdir_newstyle) <- maybe mzero pure mnewstyle
let cabal_pkgid =
PkgId (PkgName (Text.pack "Cabal"))
(Ver $ versionBranch hdrCabalVersion)
mcabal_unit = listToMaybe $
Map.elems $ Map.filter (\Unit {..} -> uPId == cabal_pkgid) pjUnits
Unit {} <- maybe mzero pure mcabal_unit
let inplace_db_path = distdir_newstyle
</> "packagedb" </> ("ghc-" ++ showVersion ghcVer)
inplace_db = PackageDbDir inplace_db_path
cabal_versions <- listCabalVersions' opts (Just inplace_db)
ver <- MaybeT $ return $ find (== hdrCabalVersion) cabal_versions
vLog opts $ logMsg ++ "v2-build package-db " ++ inplace_db_path
return $ (return (), compileWithPkg (Just inplace_db) ver CPSProject)
-- | Compile the requested Cabal version into an isolated package-db if it's
-- not there already
compileWithCabalInPrivatePkgDb :: IO (IO (), Compile)
compileWithCabalInPrivatePkgDb = do
db@(PackageDbDir db_path)
<- getPrivateCabalPkgDb opts (CabalVersion hdrCabalVersion)
vLog opts $ logMsg ++ "private package-db in " ++ db_path
return (prepare db, compileWithPkg (Just db) hdrCabalVersion CPSGlobal)
where
prepare db = do
db_exists <- liftIO $ cabalVersionExistsInPkgDb opts hdrCabalVersion db
when (not db_exists) $
void $ installCabal opts (Right hdrCabalVersion) `E.catch`
\(SomeException _) -> errorInstallCabal hdrCabalVersion distdir
-- | See if we're in a cabal source tree
compileCabalSource :: MaybeT IO (IO (), Compile)
compileCabalSource = do
let cabalFile = projdir </> "Cabal.cabal"
cabalSrc <- liftIO $ doesFileExist cabalFile
let projdir' = CabalSourceDir projdir
case cabalSrc of
False -> mzero
True -> do
vLog opts $ "projdir looks like Cabal source tree (Cabal.cabal exists)"
cf <- liftIO $ readFile cabalFile
let buildType = cabalFileBuildType cf
ver = cabalFileVersion cf
case buildType of
"simple" -> do
vLog opts $ "Cabal source tree is build-type:simple, moving on"
mzero
"custom" -> do
vLog opts $ "compiling helper with local Cabal source tree"
return $ (return (), compileWithCabalSource projdir' ver)
_ -> error $ "compileCabalSource: unknown build-type: '"++buildType++"'"
compileWithCabalSource srcDir ver =
CompileWithCabalSource
{ compCabalSourceDir = srcDir
, compCabalSourceVersion = ver
}
compileWithPkg mdb ver target =
CompileWithCabalPackage
{ compPackageDb = mdb
, compCabalVersion = CabalVersion ver
, compPackageDeps = [cabalPkgId ver]
, compProductTarget = target
}
cabalPkgId v = "Cabal-" ++ showVersion v
compile :: Compile -> CompPaths -> Options -> IO (Either ExitCode FilePath)
compile comp paths@CompPaths {..} opts@Options {..} = do
createDirectoryIfMissing True compOutDir
createHelperSources compSrcDir
vLog opts $ "compSrcDir: " ++ compSrcDir
vLog opts $ "compOutDir: " ++ compOutDir
vLog opts $ "compExePath: " ++ compExePath
invokeGhc opts $ compGhcInvocation comp paths
compPaths :: FilePath -> FilePath -> Compile -> CompPaths
compPaths appdir distdir c =
case c of
CompileWithCabalPackage {compProductTarget=CPSGlobal,..} -> CompPaths {..}
where
compSrcDir = appdir </> exeName compCabalVersion <.> "build"
compOutDir = compSrcDir
compExePath = appdir </> exeName compCabalVersion
CompileWithCabalPackage {compProductTarget=CPSProject,..} -> distdirPaths
CompileWithCabalSource {..} -> distdirPaths
where
distdirPaths = CompPaths {..}
where
compSrcDir = distdir </> "cabal-helper"
compOutDir = compSrcDir
compExePath = compOutDir </> "cabal-helper"
data GhcInvocation = GhcInvocation
{ giOutDir :: FilePath
, giOutput :: FilePath
, giCPPOptions :: [String]
, giPackageDBs :: [PackageDbDir]
, giIncludeDirs :: [FilePath]
, giHideAllPackages :: Bool
, giPackages :: [String]
, giWarningFlags :: [String]
, giInputs :: [String]
}
compGhcInvocation :: Compile -> CompPaths -> GhcInvocation
compGhcInvocation comp CompPaths {..} =
case comp of
CompileWithCabalSource {..} ->
GhcInvocation
{ giIncludeDirs = [compSrcDir, unCabalSourceDir compCabalSourceDir]
, giPackageDBs = []
, giHideAllPackages = False
, giPackages = []
, giCPPOptions = cppOptions compCabalSourceVersion
++ [cabalVersionMacro compCabalSourceVersion]
, ..
}
CompileWithCabalPackage {..} ->
GhcInvocation
{ giIncludeDirs = [compSrcDir]
, giPackageDBs = maybeToList compPackageDb
, giHideAllPackages = True
, giPackages =
[ "base"
, "containers"
, "directory"
, "filepath"
, "process"
, "bytestring"
, "ghc-prim"
] ++ compPackageDeps
, giCPPOptions = cppOptions (unCabalVersion compCabalVersion)
, ..
}
where
unCabalVersion (CabalVersion ver) = ver
unCabalVersion (CabalHEAD _) = Version [10000000, 0, 0] []
cppOptions cabalVer =
[ "-DCABAL_HELPER=1"
, cabalMinVersionMacro cabalVer
]
giOutDir = compOutDir
giOutput = compExePath
giWarningFlags = [ "-w" ] -- no point in bothering end users with warnings
giInputs = [compSrcDir</>"CabalHelper"</>"Runtime"</>"Main.hs"]
cabalVersionMacro :: Version -> String
cabalVersionMacro (Version vs _) =
"-DCABAL_VERSION="++intercalate "," (map show vs)
cabalMinVersionMacro :: Version -> String
cabalMinVersionMacro (Version (mj1:mj2:mi:_) _) =
"-DCH_MIN_VERSION_Cabal(major1,major2,minor)=\
\( (major1) < "++show mj1++" \
\|| (major1) == "++show mj1++" && (major2) < "++show mj2++" \
\|| (major1) == "++show mj1++" && (major2) == "++show mj2++" && (minor) <= "++show mi++
")"
cabalMinVersionMacro _ =
error "cabalMinVersionMacro: Version must have at least 3 components"
invokeGhc :: Options -> GhcInvocation -> IO (Either ExitCode FilePath)
invokeGhc opts@Options {..} GhcInvocation {..} = do
rv <- callProcessStderr' opts Nothing oGhcProgram $ concat
[ [ "-outputdir", giOutDir
, "-o", giOutput
]
, map ("-optP"++) giCPPOptions
, map ("-package-conf="++) $ unPackageDbDir <$> giPackageDBs
, map ("-i"++) $ nub $ "" : giIncludeDirs
, if giHideAllPackages then ["-hide-all-packages"] else []
, concatMap (\p -> ["-package", p]) giPackages
, giWarningFlags
, ["--make"]
, giInputs
]
return $
case rv of
ExitSuccess -> Right giOutput
e@(ExitFailure _) -> Left e
-- | Cabal library version we're compiling the helper exe against.
data CabalVersion
= CabalHEAD { cvCommitId :: CommitId }
| CabalVersion { cabalVersion :: Version }
newtype CommitId = CommitId { unCommitId :: String }
exeName :: CabalVersion -> String
exeName (CabalHEAD commitid) = intercalate "-"
[ "cabal-helper" ++ showVersion version
, "CabalHEAD" ++ unCommitId commitid
]
exeName CabalVersion {cabalVersion} = intercalate "-"
[ "cabal-helper" ++ showVersion version
, "Cabal" ++ showVersion cabalVersion
]
readProcess' :: Options -> FilePath -> [String] -> String -> IO String
readProcess' opts@Options{..} exe args inp = do
vLog opts $ intercalate " " $ map formatProcessArg (oGhcPkgProgram:args)
outp <- readProcess exe args inp
vLog opts $ unlines $ map ("=> "++) $ lines outp
return outp
callProcessStderr'
:: Options -> Maybe FilePath -> FilePath -> [String] -> IO ExitCode
callProcessStderr' opts mwd exe args = do
let cd = case mwd of
Nothing -> []; Just wd -> [ "cd", formatProcessArg wd++";" ]
vLog opts $ intercalate " " $ cd ++ map formatProcessArg (exe:args)
(_, _, _, h) <- createProcess (proc exe args) { std_out = UseHandle stderr
, cwd = mwd }
waitForProcess h
callProcessStderr :: Options -> Maybe FilePath -> FilePath -> [String] -> IO ()
callProcessStderr opts mwd exe args = do
rv <- callProcessStderr' opts mwd exe args
case rv of
ExitSuccess -> return ()
ExitFailure v -> processFailedException "callProcessStderr" exe args v
processFailedException :: String -> String -> [String] -> Int -> IO a
processFailedException fn exe args rv =
ioError $ mkIOError OtherError msg Nothing Nothing
where
msg = concat [ fn, ": ", exe, " "
, intercalate " " (map formatProcessArg args)
, " (exit " ++ show rv ++ ")"
]
formatProcessArg :: String -> String
formatProcessArg xs
| any isSpace xs = "'"++ xs ++"'"
| otherwise = xs
data HEAD = HEAD deriving (Eq, Show)
installCabal :: Options -> Either HEAD Version -> IO (PackageDbDir, CabalVersion)
installCabal opts ever = do
appdir <- appCacheDir
let message ver = do
let sver = showVersion ver
hPutStr stderr $ printf "\
\cabal-helper-wrapper: Installing a private copy of Cabal because we couldn't\n\
\find the right version in your global/user package-db, this might take a\n\
\while but will only happen once per Cabal version you're using.\n\
\\n\
\If anything goes horribly wrong just delete this directory and try again:\n\
\ %s\n\
\\n\
\If you want to avoid this automatic installation altogether install\n\
\version %s of Cabal manually (into your user or global package-db):\n\
\ $ cabal install Cabal --constraint \"Cabal == %s\"\n\
\\n\
\Installing Cabal %s ...\n" appdir sver sver sver
withSystemTempDirectory "cabal-helper-Cabal-source" $ \tmpdir -> do
(srcdir, cabalVer) <- case ever of
Left HEAD -> do
second CabalHEAD <$> unpackCabalHEAD opts tmpdir
Right ver -> do
message ver
let patch = fromMaybe nopCabalPatchDescription $
find ((ver`elem`) . cpdVersions) patchyCabalVersions
(,) <$> unpackPatchedCabal opts ver tmpdir patch <*> pure (CabalVersion ver)
db <- createPkgDb opts cabalVer
runCabalInstall opts db srcdir ever
return (db, cabalVer)
{-
TODO: If the Cabal version we want to install is less than or equal to one we
have available, either through act-as-setup or in a package-db we should be able
to use act-as-setup or build a default Setup.hs exe and patch the Cabal source
to say build-type:simple. This will sidestep bugs in c-i>=1.24
See conversation in
https://github.com/haskell/cabal/commit/e2bf243300957321497353a2f85517e464f764ab
Otherwise we might be able to use the shipped Setup.hs
-}
runCabalInstall
:: Options -> PackageDbDir -> CabalSourceDir -> Either HEAD Version-> IO ()
runCabalInstall opts (PackageDbDir db) (CabalSourceDir srcdir) ever = do
civ@CabalInstallVersion {..} <- cabalInstallVersion opts
cabal_opts <- return $ concat
[
[ "--package-db=clear"
, "--package-db=global"
, "--package-db=" ++ db
, "--prefix=" ++ db </> "prefix"
]
, withGHCProgramOptions opts
, if cabalInstallVer >= Version [1,20,0,0] []
then ["--no-require-sandbox"]
else []
, [ "install", srcdir ]
, if oVerbose opts
then ["-v"]
else []
, [ "--only-dependencies" ]
]
callProcessStderr opts (Just "/") (oCabalProgram opts) cabal_opts
runSetupHs opts db srcdir ever civ
hPutStrLn stderr "done"
withGHCProgramOptions :: Options -> [String]
withGHCProgramOptions opts =
concat [ [ "--with-ghc=" ++ oGhcProgram opts ]
, if oGhcPkgProgram opts /= oGhcPkgProgram defaultOptions
then [ "--with-ghc-pkg=" ++ oGhcPkgProgram opts ]
else []
]
runSetupHs
:: Options
-> FilePath
-> FilePath
-> Either HEAD Version
-> CabalInstallVersion
-> IO ()
runSetupHs opts@Options {..} db srcdir ever CabalInstallVersion {..}
| cabalInstallVer >= parseVer "1.24" = do
go $ \args -> callProcessStderr opts (Just srcdir) oCabalProgram $
[ "act-as-setup", "--" ] ++ args
| otherwise = do
SetupProgram {..} <- compileSetupHs opts db srcdir
go $ callProcessStderr opts (Just srcdir) setupProgram
where
parmake_opt :: Maybe Int -> [String]
parmake_opt nproc'
| Left _ <- ever = ["-j"++nproc]
| Right ver <- ever, ver >= Version [1,20] [] = ["-j"++nproc]
| otherwise = []
where
nproc = fromMaybe "" $ show <$> nproc'
go :: ([String] -> IO ()) -> IO ()
go run = do
run $ [ "configure", "--package-db", db, "--prefix", db </> "prefix" ]
++ withGHCProgramOptions opts
mnproc <- join . fmap readMaybe <$> lookupEnv "NPROC"
run $ [ "build" ] ++ parmake_opt mnproc
run [ "copy" ]
run [ "register" ]
newtype SetupProgram = SetupProgram { setupProgram :: FilePath }
compileSetupHs :: Options -> FilePath -> FilePath -> IO SetupProgram
compileSetupHs opts db srcdir = do
ver <- ghcVersion opts
let no_version_macros
| ver >= Version [8] [] = [ "-fno-version-macros" ]
| otherwise = []
file = srcdir </> "Setup"
callProcessStderr opts (Just srcdir) (oGhcProgram opts) $ concat
[ [ "--make"
, "-package-conf", db
]
, no_version_macros
, [ file <.> "hs"
, "-o", file
]
]
return $ SetupProgram file
data CabalPatchDescription = CabalPatchDescription {
cpdVersions :: [Version],
cpdUnpackVariant :: UnpackCabalVariant,
cpdPatchFn :: FilePath -> IO ()
}
nopCabalPatchDescription :: CabalPatchDescription
nopCabalPatchDescription = CabalPatchDescription [] LatestRevision (const (return ()))
patchyCabalVersions :: [CabalPatchDescription]
patchyCabalVersions = [
let versions = [ Version [1,18,1] [] ]
variant = Pristine
patch = fixArrayConstraint
in CabalPatchDescription versions variant patch,
let versions = [ Version [1,18,0] [] ]
variant = Pristine
patch dir = do
fixArrayConstraint dir
fixOrphanInstance dir
in CabalPatchDescription versions variant patch,
let versions = [ Version [1,24,1,0] [] ]
variant = Pristine
patch _ = return ()
in CabalPatchDescription versions variant patch
]
where
fixArrayConstraint dir = do
let cabalFile = dir </> "Cabal.cabal"
cabalFileTmp = cabalFile ++ ".tmp"
cf <- readFile cabalFile
writeFile cabalFileTmp $ replace "&& < 0.5" "&& < 0.6" cf
renameFile cabalFileTmp cabalFile
fixOrphanInstance dir = do
let versionFile = dir </> "Distribution/Version.hs"
versionFileTmp = versionFile ++ ".tmp"
let languagePragma =
"{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}"
languagePragmaCPP =
"{-# LANGUAGE CPP, DeriveDataTypeable, StandaloneDeriving #-}"
derivingDataVersion =
"deriving instance Data Version"
derivingDataVersionCPP = unlines [
"#if __GLASGOW_HASKELL__ < 707",
derivingDataVersion,
"#endif"
]
vf <- readFile versionFile
writeFile versionFileTmp
$ replace derivingDataVersion derivingDataVersionCPP
$ replace languagePragma languagePragmaCPP vf
renameFile versionFileTmp versionFile
unpackPatchedCabal
:: Options
-> Version
-> FilePath
-> CabalPatchDescription
-> IO CabalSourceDir
unpackPatchedCabal opts cabalVer tmpdir (CabalPatchDescription _ variant patch) = do
res@(CabalSourceDir dir) <- unpackCabal opts cabalVer tmpdir variant
patch dir
return res
data UnpackCabalVariant = Pristine | LatestRevision
newtype CabalSourceDir = CabalSourceDir { unCabalSourceDir :: FilePath }
unpackCabal
:: Options -> Version -> FilePath -> UnpackCabalVariant -> IO CabalSourceDir
unpackCabal opts cabalVer tmpdir variant = do
let cabal = "Cabal-" ++ showVersion cabalVer
dir = tmpdir </> cabal
variant_opts = case variant of Pristine -> [ "--pristine" ]; _ -> []
args = [ "get", cabal ] ++ variant_opts
callProcessStderr opts (Just tmpdir) (oCabalProgram opts) args
return $ CabalSourceDir dir
unpackCabalHEAD :: Options -> FilePath -> IO (CabalSourceDir, CommitId)
unpackCabalHEAD opts tmpdir = do
let dir = tmpdir </> "cabal-head.git"
url = "https://github.com/haskell/cabal.git"
ExitSuccess <- rawSystem "git" [ "clone", "--depth=1", url, dir]
commit <-
withDirectory_ dir $ trim <$> readProcess' opts "git" ["rev-parse", "HEAD"] ""
return (CabalSourceDir $ dir </> "Cabal", CommitId commit)
where
withDirectory_ :: FilePath -> IO a -> IO a
withDirectory_ dir action =
bracket
(liftIO getCurrentDirectory)
(liftIO . setCurrentDirectory)
(\_ -> liftIO (setCurrentDirectory dir) >> action)
errorInstallCabal :: Version -> FilePath -> IO a
errorInstallCabal cabalVer _distdir = panicIO $ printf "\
\Installing Cabal version %s failed.\n\
\\n\
\You have the following choices to fix this:\n\
\\n\
\- The easiest way to try and fix this is just reconfigure the project and try\n\
\ again:\n\
\ $ cabal clean && cabal configure\n\
\\n\
\- If that fails you can try to install the version of Cabal mentioned above\n\
\ into your global/user package-db somehow, you'll probably have to fix\n\
\ something otherwise it wouldn't have failed above:\n\
\ $ cabal install Cabal --constraint 'Cabal == %s'\n\
\\n\
\- If you're using `Build-Type: Simple`:\n\
\ - You can see if you can reinstall your cabal-install executable while\n\
\ having it linked to a version of Cabal that's available in you\n\
\ package-dbs or can be built automatically:\n\
\ $ ghc-pkg list | grep Cabal # find an available Cabal version\n\
\ Cabal-W.X.Y.Z\n\
\ $ cabal install cabal-install --constraint 'Cabal == W.X.*'\n\
\ Afterwards you'll have to reconfigure your project:\n\
\ $ cabal clean && cabal configure\n\
\\n\
\- If you're using `Build-Type: Custom`:\n\
\ - Have cabal-install rebuild your Setup.hs executable with a version of the\n\
\ Cabal library that you have available in your global/user package-db:\n\
\ $ cabal clean && cabal configure\n\
\ You might also have to install some version of the Cabal to do this:\n\
\ $ cabal install Cabal\n\
\\n" sver sver
where
sver = showVersion cabalVer
listCabalVersions :: Options -> MaybeT IO [Version]
listCabalVersions opts = listCabalVersions' opts Nothing
listCabalVersions' :: Options -> Maybe PackageDbDir -> MaybeT IO [Version]
listCabalVersions' opts@Options {..} mdb = do
case mdb of
Nothing -> mzero
Just (PackageDbDir db_path) -> do
exists <- liftIO $ doesDirectoryExist db_path
case exists of
False -> mzero
True -> MaybeT $ logIOError opts "listCabalVersions'" $ Just <$> do
let mdbopt = ("--package-conf="++) <$> unPackageDbDir <$> mdb
args = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt
catMaybes . map (fmap snd . parsePkgId . fromString) . words
<$> readProcess' opts oGhcPkgProgram args ""
cabalVersionExistsInPkgDb :: Options -> Version -> PackageDbDir -> IO Bool
cabalVersionExistsInPkgDb opts cabalVer db@(PackageDbDir db_path) = do
exists <- doesDirectoryExist db_path
case exists of
False -> return False
True -> fromMaybe False <$> runMaybeT (do
vers <- listCabalVersions' opts (Just db)
return $ cabalVer `elem` vers)
ghcVersion :: Options -> IO Version
ghcVersion opts@Options {..} = do
parseVer . trim <$> readProcess' opts oGhcProgram ["--numeric-version"] ""
ghcPkgVersion :: Options -> IO Version
ghcPkgVersion opts@Options {..} = do
parseVer . trim . dropWhile (not . isDigit) <$> readProcess' opts oGhcPkgProgram ["--version"] ""
newtype CabalInstallVersion = CabalInstallVersion { cabalInstallVer :: Version }
cabalInstallVersion :: Options -> IO CabalInstallVersion
cabalInstallVersion opts@Options {..} = do
CabalInstallVersion . parseVer . trim
<$> readProcess' opts oCabalProgram ["--numeric-version"] ""
createPkgDb :: Options -> CabalVersion -> IO PackageDbDir
createPkgDb opts@Options {..} cabalVer = do
db@(PackageDbDir db_path) <- getPrivateCabalPkgDb opts cabalVer
exists <- doesDirectoryExist db_path
when (not exists) $ callProcessStderr opts Nothing oGhcPkgProgram ["init", db_path]
return db
getPrivateCabalPkgDb :: Options -> CabalVersion -> IO PackageDbDir
getPrivateCabalPkgDb opts cabalVer = do
appdir <- appCacheDir
ghcVer <- ghcVersion opts
let db_path = appdir </> exeName cabalVer
++ "-ghc" ++ showVersion ghcVer
++ ".package-db"
return $ PackageDbDir db_path
-- "Cabal" ++ ver ++ "-ghc" ++ showVersion ghcVer
-- | Find @version: XXX@ delcaration in a cabal file
cabalFileVersion :: String -> Version
cabalFileVersion = parseVer . cabalFileTopField "version"
-- | Find @build-type: XXX@ delcaration in a cabal file
cabalFileBuildType :: String -> String
cabalFileBuildType = cabalFileTopField "build-type"
cabalFileTopField :: String -> String -> String
cabalFileTopField field cabalFile = value
where
Just value = extract <$> find ((field++":") `isPrefixOf`) ls
ls = map (map toLower) $ lines cabalFile
extract = dropWhile (/=':') >>> drop 1 >>> dropWhile isSpace >>> takeWhile (not . isSpace)

View File

@ -0,0 +1,81 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2017 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fforce-recomp #-}
{-|
Module : CabalHelper.Compiletime.Data
Description : Embeds source code for runtime component using TH
License : GPL-3
-}
module CabalHelper.Compiletime.Data where
import Control.Monad
import Control.Monad.IO.Class
import Data.Functor
import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as UTF8
import Language.Haskell.TH
import System.Directory
import System.FilePath
import System.IO.Temp
import System.PosixCompat.Files
import System.PosixCompat.Time
import System.PosixCompat.Types
import Prelude
import CabalHelper.Compiletime.Compat.Environment
withSystemTempDirectoryEnv :: String -> (FilePath -> IO b) -> IO b
withSystemTempDirectoryEnv tpl f = do
m <- liftIO $ lookupEnv "CABAL_HELPER_KEEP_SOURCEDIR"
case m of
Nothing -> withSystemTempDirectory tpl f
Just _ -> do
tmpdir <- getCanonicalTemporaryDirectory
f =<< createTempDirectory tmpdir tpl
createHelperSources :: FilePath -> IO ()
createHelperSources dir = do
let chdir = dir </> "CabalHelper"
liftIO $ do
createDirectoryIfMissing True $ chdir </> "Runtime"
createDirectoryIfMissing True $ chdir </> "Shared"
let modtime :: EpochTime
modtime = fromIntegral $ (read :: String -> Integer)
-- See https://reproducible-builds.org/specs/source-date-epoch/
$(runIO $ do
msde :: Maybe Integer
<- fmap read <$> lookupEnv "SOURCE_DATE_EPOCH"
(current_time :: Integer) <- round . toRational <$> epochTime
return $ LitE . StringL $ show $ maybe current_time id msde)
liftIO $ forM_ sourceFiles $ \(fn, src) -> do
let path = chdir </> fn
BS.writeFile path $ UTF8.fromString src
setFileTimes path modtime modtime
sourceFiles :: [(FilePath, String)]
sourceFiles =
[ ("Runtime/Main.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "src/CabalHelper/Runtime/Main.hs")))
, ("Shared/Common.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "src/CabalHelper/Shared/Common.hs")))
, ("Shared/Sandbox.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "src/CabalHelper/Shared/Sandbox.hs")))
, ("Shared/InterfaceTypes.hs", $(LitE . StringL <$> runIO (UTF8.toString <$> BS.readFile "src/CabalHelper/Shared/InterfaceTypes.hs")))
]

View File

@ -0,0 +1,45 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2017-2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : CabalHelper.Compiletime.Log
Description : Basic logging facilities
License : GPL-3
-}
module CabalHelper.Compiletime.Log where
import Control.Monad
import Control.Monad.IO.Class
import Control.Exception as E
import Data.String
import System.IO
import Prelude
import CabalHelper.Compiletime.Types
vLog :: MonadIO m => Options -> String -> m ()
vLog Options { oVerbose = True } msg =
liftIO $ hPutStrLn stderr msg
vLog _ _ = return ()
logIOError :: Options -> String -> IO (Maybe a) -> IO (Maybe a)
logIOError opts label a = do
a `E.catch` \(ex :: IOError) -> do
vLog opts $ label ++ ": " ++ show ex
return Nothing

View File

@ -0,0 +1,42 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures #-}
{-|
Module : CabalHelper.Compiletime.Types
Description : Types used throughout
License : GPL-3
-}
module CabalHelper.Compiletime.Types where
import Data.Version
data Options = Options {
oHelp :: Bool
, oVerbose :: Bool
, oGhcProgram :: FilePath
, oGhcPkgProgram :: FilePath
, oCabalProgram :: FilePath
, oCabalVersion :: Maybe Version
, oCabalPkgDb :: Maybe PackageDbDir
}
newtype PackageDbDir = PackageDbDir { unPackageDbDir :: FilePath }
defaultOptions :: Options
defaultOptions = Options False False "ghc" "ghc-pkg" "cabal" Nothing Nothing

View File

@ -0,0 +1,227 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE RecordWildCards, NamedFieldPuns, FlexibleContexts, ViewPatterns #-}
module Main where
import Cabal.Plan
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.String
import Text.Printf
import Text.Show.Pretty
import System.Console.GetOpt
import System.Environment
import System.Directory
import System.FilePath
import System.Process
import System.Exit
import System.IO
import Prelude
import qualified Data.Text as Text
import qualified Data.Map.Strict as Map
import Distribution.System (buildPlatform)
import Distribution.Text (display)
import Distribution.Verbosity (silent, deafening)
import Distribution.Package (packageName, packageVersion)
import Distribution.Simple.GHC as GHC (configure)
import Paths_cabal_helper (version)
import CabalHelper.Compiletime.Compat.ProgramDb
( defaultProgramDb, programPath, lookupProgram, ghcProgram, ghcPkgProgram)
import CabalHelper.Compiletime.Compat.Version
import CabalHelper.Compiletime.Compile
import CabalHelper.Compiletime.Types
import CabalHelper.Shared.Common
import CabalHelper.Shared.InterfaceTypes
usage :: IO ()
usage = do
prog <- getProgName
hPutStr stderr $ "Usage: " ++ prog ++ " " ++ usageMsg
where
usageMsg = "\
\( print-appcachedir\n\
\| print-build-platform\n\
\| [--verbose]\n\
\ [--with-ghc=GHC_PATH]\n\
\ [--with-ghc-pkg=GHC_PKG_PATH]\n\
\ [--with-cabal=CABAL_PATH]\n\
\ [--with-cabal-version=VERSION]\n\
\ [--with-cabal-pkg-db=PKG_DB]\n\
\ v1-style PROJ_DIR DIST_DIR \n\
\ ( print-exe | package-id | [CABAL_HELPER_ARGS...] )\n\
\ v2-style PROJ_DIR DIST_NEWSTYLE_DIR DIST_DIR\n\
\ ( print-exe | package-id | [CABAL_HELPER_ARGS...] )\n\
\)\n"
globalArgSpec :: [OptDescr (Options -> Options)]
globalArgSpec =
[ option "h" ["help"] "Display help message" $
NoArg $ \o -> o { oHelp = True }
, option "" ["verbose"] "Be more verbose" $
NoArg $ \o -> o { oVerbose = True }
, option "" ["with-ghc"] "GHC executable to use" $
reqArg "PROG" $ \p o -> o { oGhcProgram = p }
, option "" ["with-ghc-pkg"] "ghc-pkg executable to use (only needed when guessing from GHC path fails)" $
reqArg "PROG" $ \p o -> o { oGhcPkgProgram = p }
, option "" ["with-cabal"] "cabal-install executable to use" $
reqArg "PROG" $ \p o -> o { oCabalProgram = p }
, option "" ["with-cabal-version"] "Cabal library version to use" $
reqArg "VERSION" $ \p o -> o { oCabalVersion = Just $ parseVer p }
, option "" ["with-cabal-pkg-db"] "package database to look for Cabal library in" $
reqArg "PKG_DB" $ \p o -> o { oCabalPkgDb = Just (PackageDbDir p) }
]
where
option :: [Char] -> [String] -> String -> ArgDescr a -> OptDescr a
option s l udsc dsc = Option s l dsc udsc
reqArg :: String -> (String -> a) -> ArgDescr a
reqArg udsc dsc = ReqArg dsc udsc
parseCommandArgs :: Options -> [String] -> (Options, [String])
parseCommandArgs opts argv
= case getOpt RequireOrder globalArgSpec argv of
(o,r,[]) -> (foldr id opts o, r)
(_,_,errs) ->
panic $ "Parsing command options failed:\n" ++ concat errs
guessProgramPaths :: Options -> IO Options
guessProgramPaths opts = do
let v | oVerbose opts = deafening
| otherwise = silent
mGhcPath0 | same oGhcProgram opts dopts = Nothing
| otherwise = Just $ oGhcProgram opts
mGhcPkgPath0 | same oGhcPkgProgram opts dopts = Nothing
| otherwise = Just $ oGhcPkgProgram opts
(_compiler, _mplatform, progdb)
<- GHC.configure
v
mGhcPath0
mGhcPkgPath0
defaultProgramDb
let mghcPath1 = programPath <$> lookupProgram ghcProgram progdb
mghcPkgPath1 = programPath <$> lookupProgram ghcPkgProgram progdb
return $ opts { oGhcProgram = fromMaybe (oGhcProgram opts) mghcPath1
, oGhcPkgProgram = fromMaybe (oGhcProgram opts) mghcPkgPath1
}
where
same f o o' = f o == f o'
dopts = defaultOptions
overrideVerbosityEnvVar :: Options -> IO Options
overrideVerbosityEnvVar opts = do
x <- lookup "CABAL_HELPER_DEBUG" <$> getEnvironment
return $ case x of
Just _ -> opts { oVerbose = True }
Nothing -> opts
main :: IO ()
main = handlePanic $ do
(opts', args) <- parseCommandArgs defaultOptions <$> getArgs
opts <- overrideVerbosityEnvVar =<< guessProgramPaths opts'
case args of
_ | oHelp opts -> usage
[] -> usage
"help":[] -> usage
"version":[] -> putStrLn $ showVersion version
"print-appdatadir":[] -> putStrLn =<< appCacheDir
"print-appcachedir":[] -> putStrLn =<< appCacheDir
"print-build-platform":[] -> putStrLn $ display buildPlatform
_:projdir:_distdir:"package-id":[] -> do
let v | oVerbose opts = deafening
| otherwise = silent
-- ghc-mod will catch multiple cabal files existing before we get here
[cfile] <- filter isCabalFile <$> getDirectoryContents projdir
gpd <- readPackageDescription v (projdir </> cfile)
putStrLn $ show $
[Just $ ChResponseVersion (display (packageName gpd)) (toDataVersion $ packageVersion gpd)]
"v2-style":projdir:distdir_newstyle:unitid':args' -> do
let unitid = UnitId $ Text.pack unitid'
let plan_path = distdir_newstyle </> "cache" </> "plan.json"
plan@PlanJson {pjCabalLibVersion=Ver (makeDataVersion -> pjCabalLibVersion) }
<- decodePlanJson plan_path
case oCabalVersion opts of
Just ver | pjCabalLibVersion /= ver -> let
sver = showVersion ver
spjVer = showVersion pjCabalLibVersion
in panic $ printf "\
\Cabal version %s was requested but plan.json was written by version %s" sver spjVer
_ -> case Map.lookup unitid $ pjUnits plan of
Just u@Unit {uType} | uType /= UnitTypeLocal -> do
panic $ "\
\UnitId '"++ unitid' ++"' points to non-local unit: " ++ ppShow u
Just Unit {uDistDir=Nothing} -> panic $ printf "\
\plan.json doesn't contain 'dist-dir' for UnitId '"++ unitid' ++"'"
Just Unit {uType=UnitTypeLocal, uDistDir=Just distdir} ->
runHelper opts projdir (Just (plan, distdir_newstyle)) distdir pjCabalLibVersion args'
_ -> let
units = map (\(UnitId u) -> Text.unpack u)
$ Map.keys
$ Map.filter ((==UnitTypeLocal) . uType)
$ pjUnits plan
units_list = unlines $ map (" "++) units
in
panic $ "\
\UnitId '"++ unitid' ++"' not found in plan.json, available local units:\n" ++ units_list
"v1-style":projdir:distdir:args' -> do
cfgf <- canonicalizePath (distdir </> "setup-config")
mhdr <- getCabalConfigHeader cfgf
case (mhdr, oCabalVersion opts) of
(Nothing, _) -> panic $ printf "\
\Could not read Cabal's persistent setup configuration header\n\
\- Check first line of: %s\n\
\- Maybe try: $ cabal configure" cfgf
(Just (hdrCabalVersion, _), Just ver)
| hdrCabalVersion /= ver -> panic $ printf "\
\Cabal version %s was requested but setup configuration was\n\
\written by version %s" (showVersion ver) (showVersion hdrCabalVersion)
(Just (hdrCabalVersion, _), _) ->
runHelper opts projdir Nothing distdir hdrCabalVersion args'
_ -> do
hPutStrLn stderr "Invalid command line!"
usage
exitWith $ ExitFailure 1
runHelper :: Options -> FilePath -> Maybe (PlanJson, FilePath) -> FilePath -> DataVersion -> [String] -> IO ()
runHelper opts projdir mnewstyle distdir cabal_ver args' = do
eexe <- compileHelper opts cabal_ver projdir mnewstyle distdir
case eexe of
Left e -> exitWith e
Right exe -> do
case args' of
"print-exe":_ -> putStrLn exe
_ -> do
(_,_,_,h) <- createProcess $ proc exe $ projdir : distdir : args'
exitWith =<< waitForProcess h

View File

@ -0,0 +1,841 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE CPP, BangPatterns, RecordWildCards, RankNTypes, ViewPatterns #-}
#ifdef MIN_VERSION_Cabal
#undef CH_MIN_VERSION_Cabal
#define CH_MIN_VERSION_Cabal MIN_VERSION_Cabal
#endif
import Distribution.Simple.Utils (cabalVersion)
import Distribution.Simple.Configure
import Distribution.Package
( PackageIdentifier
, InstalledPackageId
, PackageId
, packageName
, packageVersion
)
import Distribution.PackageDescription
( PackageDescription
, GenericPackageDescription(..)
, Flag(..)
, FlagName(..)
, FlagAssignment
, Executable(..)
, Library(..)
, TestSuite(..)
, Benchmark(..)
, BuildInfo(..)
, TestSuiteInterface(..)
, BenchmarkInterface(..)
, withLib
)
import Distribution.PackageDescription.Configuration
( flattenPackageDescription
)
import Distribution.Simple.Program
( requireProgram
, ghcProgram
)
import Distribution.Simple.Program.Types
( ConfiguredProgram(..)
)
import Distribution.Simple.Configure
( getPersistBuildConfig
)
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..)
, Component(..)
, ComponentName(..)
, ComponentLocalBuildInfo(..)
, componentBuildInfo
, externalPackageDeps
, withComponentsLBI
, withLibLBI
, withExeLBI
)
import Distribution.Simple.GHC
( componentGhcOptions
)
import Distribution.Simple.Program.GHC
( GhcOptions(..)
, renderGhcOptions
)
import Distribution.Simple.Setup
( ConfigFlags(..)
, Flag(..)
, fromFlagOrDefault
)
import Distribution.Simple.Build
( initialBuildSteps
)
import Distribution.Simple.BuildPaths
( autogenModuleName
, cppHeaderName
)
import Distribution.Simple.Compiler
( PackageDB(..)
, compilerId
)
import Distribution.Compiler
( CompilerId(..)
)
import Distribution.ModuleName
( components
)
import qualified Distribution.ModuleName as C
( ModuleName
)
import Distribution.Text
( display
)
import Distribution.Verbosity
( Verbosity
, silent
, deafening
, normal
)
import Distribution.Version
( Version
)
#if CH_MIN_VERSION_Cabal(1,22,0)
-- CPP >= 1.22
import Distribution.Utils.NubList
#endif
#if CH_MIN_VERSION_Cabal(1,23,0)
-- >= 1.23
import Distribution.Simple.LocalBuildInfo
( localUnitId
)
#else
-- <= 1.22
import Distribution.Simple.LocalBuildInfo
( inplacePackageId
)
#endif
#if CH_MIN_VERSION_Cabal(1,25,0)
-- >=1.25
import Distribution.PackageDescription
( unFlagName
-- , mkFlagName
)
import Distribution.Types.ForeignLib
( ForeignLib(..)
)
import Distribution.Types.UnqualComponentName
( unUnqualComponentName
)
#endif
#if CH_MIN_VERSION_Cabal(2,0,0)
-- CPP >= 2.0
import Distribution.Simple.LocalBuildInfo
( allLibModules
, componentBuildDir
)
import Distribution.Simple.Register
( internalPackageDBPath
)
import Distribution.Backpack
( OpenUnitId(..),
OpenModule(..)
)
import Distribution.ModuleName
( ModuleName
)
import Distribution.Types.ComponentId
( unComponentId
)
import Distribution.Types.ComponentLocalBuildInfo
( maybeComponentInstantiatedWith
)
import Distribution.Types.ModuleRenaming
( ModuleRenaming(..),
isDefaultRenaming
)
import Distribution.Types.MungedPackageId
( MungedPackageId
)
import Distribution.Types.UnitId
( UnitId
, unDefUnitId
, unUnitId
)
import Distribution.Types.UnitId
( DefUnitId
)
import Distribution.Utils.NubList
( toNubListR
)
import Distribution.Version
( versionNumbers
, mkVersion
)
import qualified Distribution.InstalledPackageInfo as Installed
#endif
#if CH_MIN_VERSION_Cabal(2,2,0)
import Distribution.Types.GenericPackageDescription
( unFlagAssignment
)
#endif
import Control.Applicative ((<$>))
import Control.Arrow (first, second, (&&&))
import Control.Monad
import Control.Exception (catch, PatternMatchFail(..))
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import Data.Monoid
import Data.IORef
import qualified Data.Version as DataVersion
import System.Environment
import System.Directory
import System.FilePath
import System.Exit
import System.IO
import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)
import Text.Printf
import CabalHelper.Shared.Sandbox
import CabalHelper.Shared.Common
import CabalHelper.Shared.InterfaceTypes
usage :: IO ()
usage = do
prog <- getProgName
hPutStr stderr $ "Usage: " ++ prog ++ " " ++ usageMsg
where
usageMsg = ""
++"PROJ_DIR DIST_DIR [--with-* ...] (\n"
++" version\n"
++" | print-lbi [--human]\n"
++" | package-id\n"
++" | flags\n"
++" | config-flags\n"
++" | non-default-config-flags\n"
++" | write-autogen-files\n"
++" | compiler-version\n"
++" | ghc-options [--with-inplace]\n"
++" | ghc-src-options [--with-inplace]\n"
++" | ghc-pkg-options [--with-inplace]\n"
++" | ghc-merged-pkg-options [--with-inplace]\n"
++" | ghc-lang-options [--with-inplace]\n"
++" | package-db-stack\n"
++" | entrypoints\n"
++" | needs-build-output\n"
++" | source-dirs\n"
++" ) ...\n"
commands :: [String]
commands = [ "print-lbi"
, "package-id"
, "flags"
, "config-flags"
, "non-default-config-flags"
, "write-autogen-files"
, "compiler-version"
, "ghc-options"
, "ghc-src-options"
, "ghc-pkg-options"
, "ghc-lang-options"
, "package-db-stack"
, "entrypoints"
, "needs-build-output"
, "source-dirs"
]
main :: IO ()
main = do
args <- getArgs
projdir:distdir:args' <- case args of
[] -> usage >> exitFailure
_ -> return args
ddexists <- doesDirectoryExist distdir
when (not ddexists) $ do
errMsg $ "distdir '"++distdir++"' does not exist"
exitFailure
[cfile] <- filter isCabalFile <$> getDirectoryContents projdir
v <- maybe silent (const deafening) . lookup "CABAL_HELPER_DEBUG" <$> getEnvironment
lbi <- unsafeInterleaveIO $ getPersistBuildConfig distdir
gpd <- unsafeInterleaveIO $ readPackageDescription v (projdir </> cfile)
let pd = localPkgDescr lbi
let lvd = (lbi, v, distdir)
let
-- a =<< b $$ c == (a =<< b) $$ c
infixr 2 $$
($$) = ($)
collectCmdOptions :: [String] -> [[String]]
collectCmdOptions =
reverse . map reverse . foldl f [] . dropWhile isOpt
where
isOpt = ("--" `isPrefixOf`)
f [] x = [[x]]
f (a:as) x
| isOpt x = (x:a):as
| otherwise = [x]:(a:as)
let cmds = collectCmdOptions args'
if any (["version"] `isPrefixOf`) cmds
then do
putStrLn $
printf "using version %s of the Cabal library" (display cabalVersion)
exitSuccess
else return ()
print =<< flip mapM cmds $$ \x -> do
case x of
"flags":[] -> do
return $ Just $ ChResponseFlags $ sort $
map (flagName' &&& flagDefault) $ genPackageFlags gpd
"config-flags":[] -> do
return $ Just $ ChResponseFlags $ sort $
map (first unFlagName)
#if CH_MIN_VERSION_Cabal(2,2,0)
$ unFlagAssignment $ configConfigurationsFlags
#else
$ configConfigurationsFlags
#endif
$ configFlags lbi
"non-default-config-flags":[] -> do
let flagDefinitons = genPackageFlags gpd
flagAssgnments =
#if CH_MIN_VERSION_Cabal(2,2,0)
unFlagAssignment $ configConfigurationsFlags
#else
configConfigurationsFlags
#endif
$ configFlags lbi
nonDefaultFlags =
[ (flag_name, val)
| MkFlag {flagName=(unFlagName -> flag_name'), flagDefault=def_val} <- flagDefinitons
, (unFlagName -> flag_name, val) <- flagAssgnments
, flag_name == flag_name'
, val /= def_val
]
return $ Just $ ChResponseFlags $ sort nonDefaultFlags
"write-autogen-files":[] -> do
initialBuildStepsForAllComponents distdir pd lbi v
return Nothing
"compiler-version":[] -> do
let CompilerId comp ver = compilerId $ compiler lbi
return $ Just $ ChResponseVersion (show comp) (toDataVersion ver)
"ghc-options":flags -> do
res <- componentOptions lvd True flags id
return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
"ghc-src-options":flags -> do
res <- componentOptions lvd False flags $ \opts -> mempty {
-- Not really needed but "unexpected package db stack: []"
ghcOptPackageDBs = [GlobalPackageDB, UserPackageDB],
ghcOptCppOptions = ghcOptCppOptions opts,
ghcOptCppIncludePath = ghcOptCppIncludePath opts,
ghcOptCppIncludes = ghcOptCppIncludes opts,
ghcOptFfiIncludes = ghcOptFfiIncludes opts,
ghcOptSourcePathClear = ghcOptSourcePathClear opts,
ghcOptSourcePath = ghcOptSourcePath opts
}
return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
"ghc-pkg-options":flags -> do
res <- componentOptions lvd True flags $ \opts -> mempty {
ghcOptPackageDBs = ghcOptPackageDBs opts,
ghcOptPackages = ghcOptPackages opts,
ghcOptHideAllPackages = ghcOptHideAllPackages opts
}
return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
"ghc-merged-pkg-options":flags -> do
res <- mconcat . map snd <$> (componentOptions' lvd True flags (\_ _ o -> return o) $ \opts -> mempty {
ghcOptPackageDBs = [],
ghcOptHideAllPackages = NoFlag,
ghcOptPackages = ghcOptPackages opts
})
let res' = nubPackageFlags $ res { ghcOptPackageDBs = withPackageDB lbi
, ghcOptHideAllPackages = Flag True
}
Just . ChResponseList <$> renderGhcOptions' lbi v res'
"ghc-lang-options":flags -> do
res <- componentOptions lvd False flags $ \opts -> mempty {
ghcOptPackageDBs = [GlobalPackageDB, UserPackageDB],
ghcOptLanguage = ghcOptLanguage opts,
ghcOptExtensions = ghcOptExtensions opts,
ghcOptExtensionMap = ghcOptExtensionMap opts
}
return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
"package-db-stack":[] -> do
let
pkgDb GlobalPackageDB = ChPkgGlobal
pkgDb UserPackageDB = ChPkgUser
pkgDb (SpecificPackageDB s) = ChPkgSpecific s
-- TODO: Setup.hs has access to the sandbox as well: ghc-mod#478
return $ Just $ ChResponsePkgDbs $ map pkgDb $ withPackageDB lbi
"entrypoints":[] -> do
#if CH_MIN_VERSION_Cabal(2,0,0)
includeDirMap <- recursiveDepInfo lbi v distdir
eps <- componentsMap lbi v distdir $ \c clbi _bi -> do
case needsBuildOutput includeDirMap (componentUnitId clbi) of
ProduceBuildOutput -> return $ componentEntrypoints c
NoBuildOutput -> return seps
where (_,_,seps) = recursiveIncludeDirs includeDirMap (componentUnitId clbi)
#else
eps <- componentsMap lbi v distdir $ \c _clbi _bi ->
return $ componentEntrypoints c
#endif
-- MUST append Setup component at the end otherwise CabalHelper gets
-- confused
let eps' = eps ++ [(ChSetupHsName, ChSetupEntrypoint)]
return $ Just $ ChResponseEntrypoints eps'
"needs-build-output":[] -> do
#if CH_MIN_VERSION_Cabal(2,0,0)
includeDirMap <- recursiveDepInfo lbi v distdir
nbs <- componentsMap lbi v distdir $ \c clbi _bi ->
return $ needsBuildOutput includeDirMap (componentUnitId clbi)
#else
nbs <- componentsMap lbi v distdir $ \c _clbi _bi ->
return $ NoBuildOutput
#endif
return $ Just $ ChResponseNeedsBuild nbs
"source-dirs":[] -> do
res <- componentsMap lbi v distdir $$ \_ _ bi -> return $ hsSourceDirs bi
return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
"print-lbi":flags ->
case flags of
["--human"] -> print lbi >> return Nothing
[] -> return $ Just $ ChResponseLbi $ show lbi
cmd:_ | not (cmd `elem` commands) ->
errMsg ("Unknown command: " ++ cmd) >> usage >> exitFailure
_ ->
errMsg "Invalid usage!" >> usage >> exitFailure
flagName' = unFlagName . flagName
-- getLibrary :: PackageDescription -> Library
-- getLibrary pd = unsafePerformIO $ do
-- lr <- newIORef (error "libraryMap: empty IORef")
-- withLib pd (writeIORef lr)
-- readIORef lr
getLibraryClbi pd lbi = unsafePerformIO $ do
lr <- newIORef Nothing
withLibLBI pd lbi $ \ lib clbi ->
writeIORef lr $ Just (lib,clbi)
readIORef lr
getExeClbi pd lbi = unsafePerformIO $ do
lr <- newIORef Nothing
withExeLBI pd lbi $ \ exe clbi ->
writeIORef lr $ Just (exe,clbi)
readIORef lr
componentsMap :: LocalBuildInfo
-> Verbosity
-> FilePath
-> ( Component
-> ComponentLocalBuildInfo
-> BuildInfo
-> IO a)
-> IO [(ChComponentName, a)]
componentsMap lbi _v _distdir f = do
let pd = localPkgDescr lbi
lr <- newIORef []
-- withComponentsLBI is deprecated but also exists in very old versions
-- it's equivalent to withAllComponentsInBuildOrder in newer versions
withComponentsLBI pd lbi $ \c clbi -> do
let bi = componentBuildInfo c
name = componentNameFromComponent c
l' <- readIORef lr
r <- f c clbi bi
#if CH_MIN_VERSION_Cabal(2,0,0)
writeIORef lr $ (componentNameToCh (unUnitId $ componentUnitId clbi) name, r):l'
#else
writeIORef lr $ (componentNameToCh "" name, r):l'
#endif
reverse <$> readIORef lr
componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do
let pd = localPkgDescr lbi
#if CH_MIN_VERSION_Cabal(2,0,0)
includeDirMap <- recursiveDepInfo lbi v distdir
#endif
componentsMap lbi v distdir $ \c clbi bi ->
let
outdir = componentOutDir lbi c
(clbi', adopts) = case flags of
_ | not inplaceFlag -> (clbi, mempty)
["--with-inplace"] -> (clbi, mempty)
#if CH_MIN_VERSION_Cabal(2,0,0)
[] -> removeInplaceDeps v lbi pd clbi includeDirMap
#else
[] -> removeInplaceDeps v lbi pd clbi
#endif
opts = componentGhcOptions normal lbi bi clbi' outdir
opts' = f opts
in rf lbi v $ nubPackageFlags $ opts' `mappend` adopts
componentOptions (lbi, v, distdir) inplaceFlag flags f =
componentOptions' (lbi, v, distdir) inplaceFlag flags renderGhcOptions' f
gmModuleName :: C.ModuleName -> ChModuleName
gmModuleName = ChModuleName . intercalate "." . components
#if CH_MIN_VERSION_Cabal(2,0,0)
removeInplaceDeps :: Verbosity
-> LocalBuildInfo
-> PackageDescription
-> ComponentLocalBuildInfo
-> Map.Map UnitId SubDeps
-> (ComponentLocalBuildInfo, GhcOptions)
removeInplaceDeps _v lbi pd clbi includeDirs = let
removeInplace c =
let
(ideps, incs) = partition (isInplaceCompInc c) (componentIncludes c)
hasIdeps' = not $ null ideps
c' = c { componentPackageDeps = error "using deprecated field:componentPackageDeps"
, componentInternalDeps = []
, componentIncludes = incs }
in (hasIdeps',c')
needsBuild = needsBuildOutput includeDirs (componentUnitId clbi)
cleanRecursiveOpts :: Component
-> BuildInfo -> ComponentLocalBuildInfo -> GhcOptions
cleanRecursiveOpts comp libbi libclbi =
let
liboutdir = componentOutDir lbi comp
(_,libclbi') = removeInplace libclbi
(extraIncludes,extraDeps',_ems) = recursiveIncludeDirs includeDirs (componentUnitId libclbi)
(_,extraDeps) = partition (isInplaceCompInc libclbi) extraDeps'
opts = (componentGhcOptions normal lbi libbi libclbi' liboutdir) {
ghcOptPackageDBs = []
}
in
opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes
, ghcOptPackages = ghcOptPackages opts <> toNubListR extraDeps }
libopts =
case (getLibraryClbi pd lbi,getExeClbi pd lbi) of
(Just (lib, libclbi),_) | hasIdeps ->
let
libbi = libBuildInfo lib
opts = cleanRecursiveOpts (CLib lib) libbi libclbi
in
opts { ghcOptInputModules = ghcOptInputModules opts <> (toNubListR $ allLibModules lib libclbi) }
(_,Just (exe,execlbi)) | hasIdeps ->
let
exebi = buildInfo exe
in
cleanRecursiveOpts (CExe exe) exebi execlbi
_ -> mempty
distDir = fromFlagOrDefault ("." </> "dist") (configDistPref $ configFlags lbi)
packageDbDir = internalPackageDBPath lbi distDir
(hasIdeps,clbi') = case needsBuild of
NoBuildOutput -> removeInplace clbi
ProduceBuildOutput -> (False, clbi)
libopts' = case needsBuild of
NoBuildOutput -> libopts
ProduceBuildOutput -> mempty { ghcOptPackageDBs = [SpecificPackageDB packageDbDir] }
in (clbi', libopts')
#else
removeInplaceDeps :: Verbosity
-> LocalBuildInfo
-> PackageDescription
-> ComponentLocalBuildInfo
-> (ComponentLocalBuildInfo, GhcOptions)
removeInplaceDeps _v lbi pd clbi = let
(ideps, deps) = partition (isInplaceDep lbi) (componentPackageDeps clbi)
hasIdeps = not $ null ideps
libopts =
case getLibraryClbi pd lbi of
Just (lib, libclbi) | hasIdeps ->
let
libbi = libBuildInfo lib
liboutdir = componentOutDir lbi (CLib lib)
in
(componentGhcOptions normal lbi libbi libclbi liboutdir) {
ghcOptPackageDBs = []
}
_ -> mempty
clbi' = clbi { componentPackageDeps = deps }
in (clbi', libopts)
#endif
#if CH_MIN_VERSION_Cabal(2,0,0)
recursiveDepInfo lbi v distdir = do
includeDirs <- componentsMap lbi v distdir $ \c clbi bi -> do
return (componentUnitId clbi
, ( SubDeps
{ sdComponentInternalDeps = componentInternalDeps clbi
, sdHsSourceDirs = hsSourceDirs bi
, sdComponentIncludes = componentIncludes clbi
, sdComponentEntryPoints = componentEntrypoints c}) )
return $ Map.fromList $ map snd includeDirs
data SubDeps = SubDeps
{ sdComponentInternalDeps :: [UnitId]
, sdHsSourceDirs :: [FilePath]
, sdComponentIncludes :: [(OpenUnitId, ModuleRenaming)]
, sdComponentEntryPoints :: ChEntrypoint
}
recursiveIncludeDirs :: Map.Map UnitId SubDeps
-> UnitId -> ([FilePath], [(OpenUnitId, ModuleRenaming)]
, ChEntrypoint)
recursiveIncludeDirs includeDirs unit = go ([],[],Nothing) [unit]
where
go (afp,aci,Nothing ) [] = (afp,aci,error "recursiveIncludeDirs:no ChEntrypoint")
go (afp,aci,Just amep) [] = (afp,aci,amep)
go acc@(afp,aci,amep) (u:us) = case Map.lookup u includeDirs of
Nothing -> go acc us
Just (SubDeps us' sfp sci sep) -> go (afp++sfp,aci++sci,Just (combineEp amep sep)) (us++us')
needsBuildOutput :: Map.Map UnitId SubDeps -> UnitId -> NeedsBuildOutput
needsBuildOutput includeDirs unit = go [unit]
where
isIndef (IndefFullUnitId _ _) = True
isIndef _ = False
go [] = NoBuildOutput
go (u:us) = case Map.lookup u includeDirs of
Nothing -> go us
Just (SubDeps us' sfp sci sep) ->
if any (isIndef . fst) sci
then ProduceBuildOutput
else go (us++us')
-- | combineEP is used to combine the entrypoints when recursively chasing
-- through the dependencies of a given entry point. The first parameter is the
-- current accumulated value, and the second one is the current sub-dependency
-- being considered. So the bias should be to preserve the type of entrypoint
-- from the first parameter.
combineEp Nothing e = e
combineEp (Just ChSetupEntrypoint) e = e
combineEp (Just (ChLibEntrypoint es1 os1 ss1)) (ChLibEntrypoint es2 os2 ss2) = (ChLibEntrypoint (nub $ es2++es1) (nub $ os2++os1) (nub $ ss2++ss1))
combineEp _ e@(ChExeEntrypoint mi os2) = error $ "combineEP: cannot have a sub exe:" ++ show e
combineEp (Just (ChExeEntrypoint mi os1)) (ChLibEntrypoint es2 os2 ss2) = (ChExeEntrypoint mi (nub $ os1++es2++os2++ss2))
-- no, you unconditionally always wrap the result in Just, so instead of `f x = Just y; f x = Just z` do `f x = y; f x = z` and use f as `Just . f`
instantiatedGhcPackage :: (ModuleName,OpenModule) -> [(OpenUnitId, ModuleRenaming)]
instantiatedGhcPackage (_,OpenModule oui@(DefiniteUnitId _) _) = [(oui,DefaultRenaming)]
instantiatedGhcPackage (_, _) = []
#endif
initialBuildStepsForAllComponents distdir pd lbi v =
initialBuildSteps distdir pd lbi v
#if !CH_MIN_VERSION_Cabal(1,25,0)
-- CPP < 1.25
unFlagName (FlagName n) = n
-- mkFlagName n = FlagName n
#endif
toDataVersion :: Version -> DataVersion.Version
--fromDataVersion :: DataVersion.Version -> Version
#if CH_MIN_VERSION_Cabal(2,0,0)
toDataVersion v = DataVersion.Version (versionNumbers v) []
--fromDataVersion (DataVersion.Version vs _) = mkVersion vs
#else
toDataVersion = id
--fromDataVersion = id
#endif
componentNameToCh _uid CLibName = ChLibName
#if CH_MIN_VERSION_Cabal(1,25,0)
-- CPP >= 1.25
#if CH_MIN_VERSION_Cabal(2,0,0)
componentNameToCh uid (CSubLibName n) = ChSubLibName uid
#else
componentNameToCh _uid (CSubLibName n) = ChSubLibName (unUnqualComponentName' n)
#endif
componentNameToCh uid (CFLibName n) = ChFLibName (unUnqualComponentName' n)
#endif
componentNameToCh _uid (CExeName n) = ChExeName (unUnqualComponentName' n)
componentNameToCh _uid (CTestName n) = ChTestName (unUnqualComponentName' n)
componentNameToCh _uid (CBenchName n) = ChBenchName (unUnqualComponentName' n)
#if CH_MIN_VERSION_Cabal(1,25,0)
-- CPP >= 1.25
unUnqualComponentName' = unUnqualComponentName
#else
unUnqualComponentName' = id
#endif
#if !CH_MIN_VERSION_Cabal(1,25,0)
-- CPP < 1.25
componentNameFromComponent (CLib Library {}) = CLibName
#elif CH_MIN_VERSION_Cabal(1,25,0)
-- CPP >= 1.25 (redundant)
componentNameFromComponent (CLib Library { libName = Nothing }) = CLibName
componentNameFromComponent (CLib Library { libName = Just n }) = CSubLibName n
componentNameFromComponent (CFLib ForeignLib {..}) = CFLibName foreignLibName
#endif
componentNameFromComponent (CExe Executable {..}) = CExeName exeName
componentNameFromComponent (CTest TestSuite {..}) = CTestName testName
componentNameFromComponent (CBench Benchmark {..}) = CBenchName benchmarkName
componentOutDir lbi (CLib Library {..})=
buildDir lbi
#if CH_MIN_VERSION_Cabal(2,0,0)
componentOutDir lbi (CFLib ForeignLib {..}) =
componentOutDir' lbi (unUnqualComponentName foreignLibName)
#endif
componentOutDir lbi (CExe Executable {..}) =
componentOutDir' lbi (unUnqualComponentName' exeName)
componentOutDir lbi (CTest TestSuite { testInterface = TestSuiteExeV10 _ _, ..}) =
componentOutDir' lbi (unUnqualComponentName' testName)
componentOutDir lbi (CTest TestSuite { testInterface = TestSuiteLibV09 _ _, ..}) =
componentOutDir' lbi (unUnqualComponentName' testName ++ "Stub")
componentOutDir lbi (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ _, ..})=
componentOutDir' lbi (unUnqualComponentName' benchmarkName)
componentOutDir' :: LocalBuildInfo -> String -> FilePath
componentOutDir' lbi compName' =
----- Copied from Distribution/Simple/GHC.hs:buildOrReplExe
let targetDir = (buildDir lbi) </> compName'
compDir = targetDir </> (compName' ++ "-tmp")
in compDir
componentEntrypoints :: Component -> ChEntrypoint
componentEntrypoints (CLib Library {..})
= ChLibEntrypoint
(map gmModuleName exposedModules)
(map gmModuleName $ otherModules libBuildInfo)
#if CH_MIN_VERSION_Cabal(2,0,0)
(map gmModuleName signatures)
#else
[] -- no signatures prior to Cabal 2.0
#endif
#if CH_MIN_VERSION_Cabal(2,0,0)
componentEntrypoints (CFLib (ForeignLib{..}))
= ChLibEntrypoint
[]
(map gmModuleName $ otherModules foreignLibBuildInfo)
[]
#endif
componentEntrypoints (CExe Executable {..})
= ChExeEntrypoint
modulePath
(map gmModuleName $ otherModules buildInfo)
componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp, ..})
= ChExeEntrypoint fp (map gmModuleName $ otherModules testBuildInfo)
componentEntrypoints (CTest TestSuite { testInterface = TestSuiteLibV09 _ mn, ..})
= ChLibEntrypoint [gmModuleName mn] (map gmModuleName $ otherModules testBuildInfo) []
componentEntrypoints (CTest TestSuite {})
= ChLibEntrypoint [] [] []
componentEntrypoints (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ fp, ..})
= ChExeEntrypoint fp (map gmModuleName $ otherModules benchmarkBuildInfo)
componentEntrypoints (CBench Benchmark {})
= ChLibEntrypoint [] [] []
#if CH_MIN_VERSION_Cabal(2,0,0)
isInplaceCompInc :: ComponentLocalBuildInfo -> (OpenUnitId, ModuleRenaming) -> Bool
isInplaceCompInc clbi (DefiniteUnitId uid, _mr) = unDefUnitId uid `elem` componentInternalDeps clbi
isInplaceCompInc clbi (IndefFullUnitId uid _, _mmr) = False
#endif
#if CH_MIN_VERSION_Cabal(2,0,0)
isInplaceDep :: LocalBuildInfo -> ComponentLocalBuildInfo -> (UnitId, MungedPackageId) -> Bool
isInplaceDep lbi clbi (uid, _mpid) = uid `elem` componentInternalDeps clbi
#else
isInplaceDep :: LocalBuildInfo -> (InstalledPackageId, PackageId) -> Bool
# if CH_MIN_VERSION_Cabal(1,23,0)
-- CPP >= 1.23
isInplaceDep lbi (ipid, _pid) = localUnitId lbi == ipid
# else
-- CPP <= 1.22
isInplaceDep _lbi (ipid, pid) = inplacePackageId pid == ipid
# endif
#endif
#if CH_MIN_VERSION_Cabal(1,22,0)
-- CPP >= 1.22
-- >= 1.22 uses NubListR
nubPackageFlags opts = opts
#else
nubPackageFlags opts = opts { ghcOptPackages = nub $ ghcOptPackages opts }
#endif
renderGhcOptions' :: LocalBuildInfo
-> Verbosity
-> GhcOptions
-> IO [String]
#if !CH_MIN_VERSION_Cabal(1,20,0)
renderGhcOptions' lbi v opts = do
-- CPP < 1.20
(ghcProg, _) <- requireProgram v ghcProgram (withPrograms lbi)
let Just ghcVer = programVersion ghcProg
return $ renderGhcOptions ghcVer opts
#elif CH_MIN_VERSION_Cabal(1,20,0) && !CH_MIN_VERSION_Cabal(1,24,0)
renderGhcOptions' lbi _v opts = do
-- CPP >= 1.20 && < 1.24
return $ renderGhcOptions (compiler lbi) opts
#else
renderGhcOptions' lbi _v opts = do
-- CPP >= 1.24
return $ renderGhcOptions (compiler lbi) (hostPlatform lbi) opts
#endif

View File

@ -0,0 +1,150 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-|
Module : CabalHelper.Shared.Common
Description : Shared utility functions
License : GPL-3
-}
{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings #-}
module CabalHelper.Shared.Common where
#ifdef MIN_VERSION_Cabal
#undef CH_MIN_VERSION_Cabal
#define CH_MIN_VERSION_Cabal MIN_VERSION_Cabal
#endif
import Control.Applicative
import Control.Exception as E
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Version
import Data.Typeable
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
#if CH_MIN_VERSION_Cabal(2,2,0)
import qualified Distribution.PackageDescription.Parsec as P
#else
import qualified Distribution.PackageDescription.Parse as P
#endif
import System.Environment
import System.IO
import qualified System.Info
import System.Exit
import System.Directory
import System.FilePath
import Text.ParserCombinators.ReadP
import Prelude
data Panic = Panic String deriving (Typeable, Show)
instance Exception Panic
panic :: String -> a
panic msg = throw $ Panic msg
panicIO :: String -> IO a
panicIO msg = throwIO $ Panic msg
handlePanic :: IO a -> IO a
handlePanic action =
action `E.catch` \(Panic msg) -> errMsg msg >> exitFailure
errMsg :: String -> IO ()
errMsg str = do
prog <- getProgName
hPutStrLn stderr $ prog ++ ": " ++ str
-- | @getCabalConfigHeader "dist/setup-config"@ returns the cabal version and
-- compiler version
getCabalConfigHeader :: FilePath -> IO (Maybe (Version, (ByteString, Version)))
getCabalConfigHeader file = bracket (openFile file ReadMode) hClose $ \h -> do
parseHeader <$> BS.hGetLine h
parseHeader :: ByteString -> Maybe (Version, (ByteString, Version))
parseHeader header = case BS8.words header of
["Saved", "package", "config", "for", _pkgId ,
"written", "by", cabalId,
"using", compId]
-> liftM2 (,) (snd <$> parsePkgId cabalId) (parsePkgId compId)
_ -> Nothing
parsePkgId :: ByteString -> Maybe (ByteString, Version)
parsePkgId bs =
case BS8.split '-' bs of
[pkg, vers] -> Just (pkg, parseVer $ BS8.unpack vers)
_ -> Nothing
parseVer :: String -> Version
parseVer vers = runReadP parseVersion vers
trim :: String -> String
trim = dropWhileEnd isSpace
majorVer :: Version -> Version
majorVer (Version b _) = Version (take 2 b) []
sameMajorVersionAs :: Version -> Version -> Bool
sameMajorVersionAs a b = majorVer a == majorVer b
runReadP :: ReadP t -> String -> t
runReadP p i = case filter ((=="") . snd) $ readP_to_S p i of
(a,""):[] -> a
_ -> error $ "Error parsing: " ++ show i
appCacheDir :: IO FilePath
appCacheDir =
(</> "cabal-helper") <$> getEnvDefault "XDG_CACHE_HOME" (homeRel cache)
where
-- for GHC 7.4
lookupEnv' var = do env <- getEnvironment; return (lookup var env)
getEnvDefault var def = lookupEnv' var >>= \m -> case m of Nothing -> def; Just x -> return x
homeRel path = (</> path) <$> getHomeDirectory
cache =
case System.Info.os of
"mingw32" -> windowsCache
_ -> unixCache
windowsCache = "Local Settings" </> "Cache"
unixCache = ".cache"
isCabalFile :: FilePath -> Bool
isCabalFile f = takeExtension' f == ".cabal"
takeExtension' :: FilePath -> String
takeExtension' p =
if takeFileName p == takeExtension p
then "" -- just ".cabal" is not a valid cabal file
else takeExtension p
replace :: String -> String -> String -> String
replace n r hs' = go "" hs'
where
go acc h
| take (length n) h == n =
reverse acc ++ r ++ drop (length n) h
go acc (h:hs) = go (h:acc) hs
go acc [] = reverse acc
#if CH_MIN_VERSION_Cabal(2,2,0)
readPackageDescription = P.readGenericPackageDescription
#else
readPackageDescription = P.readPackageDescription
#endif

View File

@ -0,0 +1,81 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2018 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures #-}
{-|
Module : CabalHelper.Shared.InterfaceTypes
Description : Types which are used by c-h library and executable to communicate
License : GPL-3
These types are used to communicate between the cabal-helper library and main
executable, using Show/Read. If any types in this module change the major
version must be bumped since this will be exposed in the @Distribution.Helper@
module.
The cached executables in @$XDG_CACHE_HOME/cabal-helper@ use the cabal-helper
version (among other things) as a cache key so we don't need to worry about
talking to an old executable.
-}
module CabalHelper.Shared.InterfaceTypes where
import GHC.Generics
import Data.Version
data ChResponse
= ChResponseCompList [(ChComponentName, [String])]
| ChResponseEntrypoints [(ChComponentName, ChEntrypoint)]
| ChResponseNeedsBuild [(ChComponentName, NeedsBuildOutput)]
| ChResponseList [String]
| ChResponsePkgDbs [ChPkgDb]
| ChResponseLbi String
| ChResponseVersion String Version
| ChResponseLicenses [(String, [(String, Version)])]
| ChResponseFlags [(String, Bool)]
deriving (Eq, Ord, Read, Show, Generic)
data ChComponentName = ChSetupHsName
| ChLibName
| ChSubLibName String
| ChFLibName String
| ChExeName String
| ChTestName String
| ChBenchName String
deriving (Eq, Ord, Read, Show, Generic)
newtype ChModuleName = ChModuleName String
deriving (Eq, Ord, Read, Show, Generic)
data ChEntrypoint = ChSetupEntrypoint -- ^ Almost like 'ChExeEntrypoint' but
-- @main-is@ could either be @"Setup.hs"@
-- or @"Setup.lhs"@. Since we don't know
-- where the source directory is you have
-- to find these files.
| ChLibEntrypoint { chExposedModules :: [ChModuleName]
, chOtherModules :: [ChModuleName]
, chSignatures :: [ChModuleName] -- backpack only
}
| ChExeEntrypoint { chMainIs :: FilePath
, chOtherModules :: [ChModuleName]
} deriving (Eq, Ord, Read, Show, Generic)
data ChPkgDb = ChPkgGlobal
| ChPkgUser
| ChPkgSpecific FilePath
deriving (Eq, Ord, Read, Show, Generic)
data NeedsBuildOutput = ProduceBuildOutput | NoBuildOutput
deriving (Eq, Ord, Read, Show, Generic)

View File

@ -0,0 +1,78 @@
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2017 Daniel Gröber <cabal-helper@dxld.at>
--
-- 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/>.
{-|
Module : CabalHelper.Shared.Sandbox
Description : Extracting information from @cabal.sandbox.config@ files
License : GPL-3
-}
module CabalHelper.Shared.Sandbox where
import Control.Applicative
import Data.Char
import Data.Maybe
import Data.List
import Data.Version
import System.FilePath
import System.Directory
import Prelude
import qualified Data.Traversable as T
-- | Get the path to the sandbox package-db in a project
getSandboxPkgDb :: FilePath
-- ^ Path to the cabal package root directory (containing the
-- @cabal.sandbox.config@ file)
-> String
-- ^ Cabal build platform, i.e. @buildPlatform@
-> Version
-- ^ GHC version (@cProjectVersion@ is your friend)
-> IO (Maybe FilePath)
getSandboxPkgDb d platform ghcVer = do
mConf <- T.traverse readFile =<< mightExist (d </> "cabal.sandbox.config")
return $ fixPkgDbVer <$> (extractSandboxDbDir =<< mConf)
where
fixPkgDbVer dir =
case takeFileName dir == ghcSandboxPkgDbDir platform ghcVer of
True -> dir
False -> takeDirectory dir </> ghcSandboxPkgDbDir platform ghcVer
ghcSandboxPkgDbDir :: String -> Version -> String
ghcSandboxPkgDbDir platform ghcVer =
platform ++ "-ghc-" ++ showVersion ghcVer ++ "-packages.conf.d"
-- | Extract the sandbox package db directory from the cabal.sandbox.config
-- file. Exception is thrown if the sandbox config file is broken.
extractSandboxDbDir :: String -> Maybe FilePath
extractSandboxDbDir conf = extractValue <$> parse conf
where
key = "package-db:"
keyLen = length key
parse = listToMaybe . filter (key `isPrefixOf`) . lines
extractValue = CabalHelper.Shared.Sandbox.dropWhileEnd isSpace . dropWhile isSpace . drop keyLen
mightExist :: FilePath -> IO (Maybe FilePath)
mightExist f = do
exists <- doesFileExist f
return $ if exists then (Just f) else (Nothing)
-- dropWhileEnd is not provided prior to base 4.5.0.0.
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []

View File

@ -0,0 +1,195 @@
{-# LANGUAGE ScopedTypeVariables, GADTs #-}
import System.Environment (getArgs)
import System.Directory
import System.FilePath
import System.Process
import System.Exit
import System.IO
import Control.Exception as E
import Data.List
import Data.Maybe
import Data.Version
import Data.Functor
import Data.Function
import qualified Distribution.Compat.ReadP as Dist
import Distribution.Version (VersionRange, withinRange)
import Distribution.Text
import Control.Arrow
import Control.Monad
import Prelude
import CabalHelper.Compiletime.Compat.Environment
import CabalHelper.Compiletime.Compat.Version
import CabalHelper.Compiletime.Compile
import CabalHelper.Compiletime.Types
import CabalHelper.Shared.Common
runReadP'Dist :: Dist.ReadP t t -> String -> t
runReadP'Dist p i = case filter ((=="") . snd) $ Dist.readP_to_S p i of
(a,""):[] -> a
_ -> error $ "Error parsing: " ++ show i
withinRange'CH :: Version -> VersionRange -> Bool
withinRange'CH v r =
withinRange (fromDataVersion v) r
setupHOME :: IO ()
setupHOME = do
tmp <- fromMaybe "/tmp" <$> lookupEnv "TMPDIR"
let home = tmp </> "compile-test-home"
_ <- rawSystem "rm" ["-r", home]
createDirectory home
setEnv "HOME" home
main :: IO ()
main = do
args <- getArgs
case args of
"list-versions":[] -> do
mapM_ print =<< (allCabalVersions <$> ghcVersion defaultOptions)
"list-versions":ghc_ver_str:[] ->
mapM_ print $ allCabalVersions (parseVer ghc_ver_str)
_ ->
test args
test args = do
let action
| null args = testAllCabalVersions
| otherwise = testCabalVersions $ map parseVer' args
setupHOME
_ <- rawSystem "cabal" ["update"]
action
parseVer' :: String -> Either HEAD Version
parseVer' "HEAD" = Left HEAD
parseVer' v = Right $ parseVer v
allCabalVersions :: Version -> [Version]
allCabalVersions ghc_ver = let
cabal_versions :: [Version]
cabal_versions = map parseVer
-- "1.14.0" -- not supported at runtime
[ "1.16.0"
, "1.16.0.1"
, "1.16.0.2"
, "1.16.0.3"
, "1.18.0"
, "1.18.1"
, "1.18.1.1"
, "1.18.1.2"
, "1.18.1.3"
, "1.18.1.4"
, "1.18.1.5"
, "1.18.1.6"
, "1.18.1.7"
, "1.20.0.0"
, "1.20.0.1"
, "1.20.0.2"
, "1.20.0.3"
, "1.20.0.4"
, "1.22.0.0"
, "1.22.1.0"
, "1.22.1.1"
, "1.22.2.0"
, "1.22.3.0"
, "1.22.4.0"
, "1.22.5.0"
, "1.22.6.0"
, "1.22.7.0"
, "1.22.8.0"
, "1.24.0.0"
, "1.24.1.0"
, "1.24.2.0"
, "2.0.0.2"
, "2.0.1.0"
, "2.0.1.1"
, "2.2.0.0"
, "2.2.0.1"
]
constraint :: VersionRange
constraint =
fromMaybe (snd $ last constraint_table) $
fmap snd $
find (and . (zipWith (==) `on` versionBranch) ghc_ver . fst) $
constraint_table
constraint_table =
map (parseVer *** runReadP'Dist parse) $
[ ("7.4" , ">= 1.14 && < 2")
, ("7.6" , ">= 1.16 && < 2")
, ("7.8" , ">= 1.18 && < 2")
, ("7.10" , ">= 1.22.2 && < 2")
, ("8.0.1", ">= 1.24 ")
, ("8.0.2", ">= 1.24.2 ")
, ("8.2.1", ">= 2.0.0.2 ")
, ("8.2.2", ">= 2.0.0.2 ")
, ("8.4.1", ">= 2.0.0.2 ")
, ("8.4.2", ">= 2.2.0.1 ")
]
in
reverse $ filter (flip withinRange'CH constraint) cabal_versions
testAllCabalVersions :: IO ()
testAllCabalVersions = do
ghc_ver <- ghcVersion defaultOptions
let relevant_cabal_versions = allCabalVersions ghc_ver
testCabalVersions $ map Right relevant_cabal_versions ++ [Left HEAD]
testCabalVersions :: [Either HEAD Version] -> IO ()
testCabalVersions versions = do
rvs <- forM versions $ \ver -> do
let sver = either show showVersion ver
hPutStrLn stderr $ "\n\n\n\n\n\n====== Compiling with Cabal-" ++ sver
compilePrivatePkgDb ver
let printStatus (cv, rv) = putStrLn $ "- Cabal "++ver++" "++status
where ver = case cv of Left _ -> "HEAD"; Right v -> showVersion v
status = case rv of
Right _ ->
"succeeded"
Left rvc ->
"failed (exit code "++show rvc++")"
let drvs = versions `zip` rvs
mapM_ printStatus drvs
if any isLeft' $ map snd $ filter ((/=Left HEAD) . fst) drvs
then exitFailure
else exitSuccess
where
isLeft' (Left _) = True
isLeft' (Right _) = False
compilePrivatePkgDb :: Either HEAD Version -> IO (Either ExitCode FilePath)
compilePrivatePkgDb eCabalVer = do
res <- E.try $ installCabal defaultOptions { oVerbose = True } eCabalVer
case res of
Right (db, cabalVer) ->
compileWithPkg db cabalVer
Left (ioe :: IOException) -> do
print ioe
return $ Left (ExitFailure 1)
compileWithPkg :: PackageDbDir
-> CabalVersion
-> IO (Either ExitCode FilePath)
compileWithPkg db cabalVer = do
appdir <- appCacheDir
let comp =
CompileWithCabalPackage (Just db) cabalVer [cabalPkgId cabalVer] CPSGlobal
compile
comp
(compPaths appdir (error "compile-test: distdir not available") comp)
defaultOptions { oVerbose = True }
cabalPkgId :: CabalVersion -> String
cabalPkgId (CabalHEAD _commitid) = "Cabal"
cabalPkgId (CabalVersion v) = "Cabal-" ++ showVersion v

View File

@ -0,0 +1,182 @@
{-# LANGUAGE TupleSections, ScopedTypeVariables #-}
module Main where
import GHC
import GHC.Paths (libdir)
import DynFlags
import qualified Control.Exception as E
import Control.Monad
import Control.Monad.IO.Class
import Data.List
import Data.Version
import System.Environment (getArgs)
import System.Exit
import System.FilePath ((</>))
import System.Directory
import System.IO
import System.IO.Temp
import System.Process (rawSystem, readProcess)
import Distribution.Helper
import CabalHelper.Shared.Common
main :: IO ()
main = do
args <- getArgs
topdir <- getCurrentDirectory
res <- mapM (setup topdir test) $ case args of
[] -> [ ("tests/exelib" , parseVer "1.10", parseVer "0")
, ("tests/exeintlib", parseVer "2.0", parseVer "0")
, ("tests/fliblib" , parseVer "2.0", parseVer "0")
, ("tests/bkpregex" , parseVer "2.0", parseVer "8.1")
-- min Cabal lib ver -^ min GHC ver -^
]
xs -> map (, parseVer "0", parseVer "0") xs
if any (==False) $ concat res
then exitFailure
else exitSuccess
cabalInstallVersion :: IO Version
cabalInstallVersion =
parseVer . trim <$> readProcess "cabal" ["--numeric-version"] ""
ghcVersion :: IO Version
ghcVersion =
parseVer . trim <$> readProcess "ghc" ["--numeric-version"] ""
cabalInstallBuiltinCabalVersion :: IO Version
cabalInstallBuiltinCabalVersion =
parseVer . trim <$> readProcess "cabal"
["act-as-setup", "--", "--numeric-version"] ""
setup :: FilePath -> (FilePath -> IO [Bool]) -> (FilePath, Version, Version) -> IO [Bool]
setup topdir act (srcdir, min_cabal_ver, min_ghc_ver) = do
ci_ver <- cabalInstallVersion
c_ver <- cabalInstallBuiltinCabalVersion
g_ver <- ghcVersion
let mreason
| (ci_ver < parseVer "1.24") =
Just $ "cabal-install-" ++ showVersion ci_ver ++ " is too old"
| c_ver < min_cabal_ver =
Just $ "Cabal-" ++ showVersion c_ver
++ " < " ++ showVersion min_cabal_ver
| g_ver < min_ghc_ver =
Just $ "ghc-" ++ showVersion g_ver
++ " < " ++ showVersion min_ghc_ver
| otherwise =
Nothing
case mreason of
Just reason -> do
putStrLn $ "Skipping test '" ++ srcdir ++ "' because " ++ reason ++ "."
return []
Nothing -> do
putStrLn $ "Running test '" ++ srcdir ++ "' ------------------------------"
withSystemTempDirectory "cabal-helper.ghc-session.test" $ \dir -> do
setCurrentDirectory $ topdir </> srcdir
run "cabal" [ "sdist", "--output-dir", dir ]
setCurrentDirectory dir
run "cabal" [ "configure" ]
act dir
run :: String -> [String] -> IO ()
run x xs = do
print $ x:xs
ExitSuccess <- rawSystem x xs
return ()
test :: FilePath -> IO [Bool]
test dir = do
let qe = mkQueryEnv dir (dir </> "dist")
cs <- runQuery qe $ components $ (,,,) <$> entrypoints <.> ghcOptions <.> needsBuildOutput
forM cs $ \(ep, opts, nb, cn) -> do
putStrLn $ "\n" ++ show cn ++ ":::: " ++ show nb
when (nb == ProduceBuildOutput) $ do
run "cabal" [ "build" ]
let opts' = "-Werror" : opts
let sopts = intercalate " " $ map formatArg $ "\nghc" : opts'
putStrLn $ "\n" ++ show cn ++ ": " ++ sopts
hFlush stdout
compileModule nb ep opts'
where
formatArg x
| "-" `isPrefixOf` x = "\n "++x
| otherwise = x
compileModule :: NeedsBuildOutput -> ChEntrypoint -> [String] -> IO Bool
compileModule nb ep opts = do
putStrLn $ "compiling:" ++ show ep ++ " (" ++ show nb ++ ")"
E.handle (\(ec :: ExitCode) -> print ec >> return False) $ do
defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
runGhc (Just libdir) $ do
handleSourceError (\e -> GHC.printException e >> return False) $ do
let target = case nb of
ProduceBuildOutput -> HscNothing -- AZ: what should this be?
NoBuildOutput -> HscInterpreted
dflags0 <- getSessionDynFlags
let dflags1 = dflags0 {
ghcMode = CompManager
, ghcLink = LinkInMemory
, hscTarget = target
, optLevel = 0
}
(dflags2, _, _) <- parseDynamicFlags dflags1 (map noLoc opts)
_ <- setSessionDynFlags dflags2
ts <- mapM (\t -> guessTarget t Nothing) $
case ep of
ChLibEntrypoint ms ms' ss -> map unChModuleName $ ms ++ ms' ++ ss
ChExeEntrypoint m' ms ->
let
-- The options first clear out includes, then put in the build dir. We want the
-- first one after that, so "regex-example" in the following case
--
-- ,"-i"
-- ,"-idist/build/regex-example"
-- ,"-iregex-example"
firstInclude = drop 2 $ head $ drop 2 $ filter (isPrefixOf "-i") opts
m = firstInclude </> m'
in [m] ++ map unChModuleName ms
ChSetupEntrypoint -> ["Setup.hs"]
let ts' = case nb of
NoBuildOutput -> map (\t -> t { targetAllowObjCode = False }) ts
ProduceBuildOutput -> ts
setTargets ts'
_ <- load LoadAllTargets
when (nb == NoBuildOutput) $ do
setContext $ case ep of
ChLibEntrypoint ms ms' ss ->
map (IIModule . mkModuleName . unChModuleName) $ ms ++ ms' ++ ss
ChExeEntrypoint _ ms ->
map (IIModule . mkModuleName . unChModuleName) $ ChModuleName "Main" : ms
ChSetupEntrypoint ->
map (IIModule . mkModuleName) ["Main"]
liftIO $ print ExitSuccess
return True
unChModuleName :: ChModuleName -> String
unChModuleName (ChModuleName mn) = mn

View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View File

@ -0,0 +1,29 @@
name: bkpregex
version: 0.1.0.0
build-type: Simple
cabal-version: 2.0
library str-impls
build-depends: base, bytestring
exposed-modules: Str.String, Str.ByteString
hs-source-dirs: str-impls
library regex-types
build-depends: base
exposed-modules: Regex.Types
hs-source-dirs: regex-types
library regex-indef
build-depends: base, regex-types
signatures: Str
exposed-modules: Regex
hs-source-dirs: regex-indef
executable regex-example
main-is: Main.hs
build-depends: base, regex-indef, regex-types, str-impls
mixins: regex-indef (Regex as Regex.String)
requires (Str as Str.String),
regex-indef (Regex as Regex.ByteString)
requires (Str as Str.ByteString)
hs-source-dirs: regex-example

View File

@ -0,0 +1,12 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Regex.Types
import qualified Regex.String
import qualified Regex.ByteString
nocs = Rep (Alt (Sym 'a') (Sym 'b'))
onec = Seq nocs (Sym 'c')
evencs = Seq (Rep (Seq onec onec)) nocs
main = print (Regex.String.accept evencs "acc") >>
print (Regex.ByteString.accept evencs "acc")

View File

@ -0,0 +1,14 @@
module Regex where
import Prelude hiding (null)
import Str
import Regex.Types
accept :: Reg -> Str -> Bool
accept Eps u = null u
accept (Sym c) u = u == singleton c
accept (Alt p q) u = accept p u || accept q u
accept (Seq p q) u =
or [accept p u1 && accept q u2 | (u1, u2) <- splits u]
accept (Rep r) u =
or [and [accept r ui | ui <- ps] | ps <- parts u]

View File

@ -0,0 +1,9 @@
signature Str where
data Str
instance Eq Str
null :: Str -> Bool
singleton :: Char -> Str
splits :: Str -> [(Str, Str)]
parts :: Str -> [[Str]]

View File

@ -0,0 +1,7 @@
module Regex.Types where
data Reg = Eps
| Sym Char
| Alt Reg Reg
| Seq Reg Reg
| Rep Reg

View File

@ -0,0 +1,17 @@
module Str.ByteString(module Data.ByteString.Char8, module Str.ByteString) where
import Prelude hiding (length, null, splitAt)
import Data.ByteString.Char8
import Data.ByteString
type Str = ByteString
splits :: Str -> [(Str, Str)]
splits s = fmap (\n -> splitAt n s) [0..length s]
parts :: Str -> [[Str]]
parts s | null s = [[]]
| otherwise = do
n <- [1..length s]
let (l, r) = splitAt n s
fmap (l:) (parts r)

View File

@ -0,0 +1,21 @@
module Str.String where
import Prelude hiding (null)
import qualified Prelude as P
type Str = String
null :: Str -> Bool
null = P.null
singleton :: Char -> Str
singleton c = [c]
splits :: Str -> [(Str, Str)]
splits [] = [([], [])]
splits (c:cs) = ([], c:cs):[(c:s1,s2) | (s1,s2) <- splits cs]
parts :: Str -> [[Str]]
parts [] = [[]]
parts [c] = [[[c]]]
parts (c:cs) = concat [[(c:p):ps, [c]:p:ps] | p:ps <- parts cs]

View File

@ -0,0 +1,5 @@
module Main where
import Lib
main = print lib

View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View File

@ -0,0 +1,31 @@
name: exeintlib
version: 0
build-type: Simple
cabal-version: >=2.0
library
exposed-modules: Lib
hs-source-dirs: lib
build-depends: base, filepath, intlib
default-language: Haskell2010
library intlib
exposed-modules: IntLib
hs-source-dirs: intlib
build-depends: base, directory
default-language: Haskell2010
executable exe
main-is: Exe.hs
build-depends: base, exeintlib
default-language: Haskell2010
test-suite exe-test
type: exitcode-stdio-1.0
main-is: Exe.hs
build-depends: base, exeintlib
benchmark exe-bench
type: exitcode-stdio-1.0
main-is: Exe.hs
build-depends: base, exeintlib

View File

@ -0,0 +1,7 @@
module IntLib where
import System.Directory
directory = doesFileExist "Exe.hs"
intlib = 1

View File

@ -0,0 +1,8 @@
module Lib where
import System.FilePath
import IntLib
filepath = "a" </> "b"
lib = 1 + intlib

View File

@ -0,0 +1,5 @@
module Main where
import Lib
main = print foo

View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View File

@ -0,0 +1,25 @@
name: exelib
version: 0
build-type: Simple
cabal-version: >=1.10
library
exposed-modules: Lib
hs-source-dirs: lib
build-depends: base, filepath, directory
default-language: Haskell2010
executable exelib
main-is: Exe.hs
build-depends: base, exelib
default-language: Haskell2010
test-suite exe-test
type: exitcode-stdio-1.0
main-is: Exe.hs
build-depends: base, exelib
benchmark exe-bench
type: exitcode-stdio-1.0
main-is: Exe.hs
build-depends: base, exelib

View File

@ -0,0 +1,8 @@
module Lib where
import System.Directory
import System.FilePath
filepath = "a" </> "b"
directory = doesFileExist "Exe.hs"
foo = 1

View File

@ -0,0 +1,5 @@
module FLib where
import Lib
flib = print foo

View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View File

@ -0,0 +1,19 @@
name: fliblib
version: 0
build-type: Simple
cabal-version: >=1.10
library
exposed-modules: Lib
hs-source-dirs: lib
build-depends: base, filepath, directory
default-language: Haskell2010
foreign-library flib
other-modules: FLib
build-depends: base, fliblib
hs-source-dirs: .
type: native-shared
if os(Windows)
options: standalone
default-language: Haskell2010

View File

@ -0,0 +1,8 @@
module Lib where
import System.Directory
import System.FilePath
filepath = "a" </> "b"
directory = doesFileExist "Exe.hs"
foo = 1