diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,16 @@ +# Changelog + +Notable changes to `Smuggler2` + +`smuggler2` uses [PVP Versioning][1]. +The change log is available [on GitHub][2]. + +## [Unreleased] +- Nothing to report + +## [0.3.2.1]: -- 30 May 2020 +- Provisional version for Hackage + + +[1]: https://pvp.haskell.org +[2]: https://github.com/jrp2014/smuggler2/releases diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,373 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at http://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,28 @@ +# For convenience +# + +.PHONY: test clean accept doc hlint ghcid weed + +all: test doc + +test: + cabal test --test-show-details=streaming + +clean: + cabal clean + +accept: + cabal run smuggler2-test -- --accept + +doc: + cabal haddock + +hlint: + hlint src test/Test.hs + +ghcid: + ghcid + +weed: + cabal build + weeder diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,309 @@ +# smuggler2 + + + +[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/jrp2014/smuggler2/blob/master/LICENSE) +![Smuggler2](https://github.com/jrp2014/smuggler2/workflows/Smuggler2/badge.svg) +[![Build Status](https://travis-ci.com/jrp2014/smuggler2.svg?branch=master)](https://travis-ci.com/jrp2014/smuggler2) + +Smuggler2 is a Haskell GHC Source Plugin that rewrites module imports (to produce a +minimal set) and adds or replaces explicit exports automatically. + +This may make code easier to read because the provenance of imported +names is explcit. While writing code, it may be convenient to import a complete +module (by not specifiying what is to be imported from it) and then get +Smuggler2 to limit the import to include only the names that are used. + +By default, all values, types and classes defined in a module +are exported (excluding those that are imported). Smuggler2 can generate +the code for that maximalist export list, for hand pruning. (It does not check +whether an exported name is used.) Limiting exports may make it easier for +`ghc` to optimise some code. + +## How to use + +### Adding Smuggler2 to your dependencies + +Add `smuggler2` to the dependencies of your project and to your compiler +flags. For example, you could include in your project `cabal` file something +like + +```Cabal +flag smuggler2 + description: Rewrite sources to cleanp imports, and create explicit exports + exports + default: False + manual: True + +common smuggler-options + if flag(smuggler2) + ghc-options: -fplugin:Smuggler2.Plugin + build-depends: smuggler2 >= 0.3 +``` + +and the `import: smuggler-options` in the appropriate `library` or `executable` sections. + +The use of the flag allows you to build with or without source processing. Eg, + +```bash +$ cabal build -fsmuggler2 +``` + +using the example above. + +You might use this approach to refine your imports or get a starting point for your +exports, but not rewrite them every time you compile. The use of a flag means +that you can also exclude `smuggler2` dependencies from your final builds. + +### Alternatively, using a local version + +If you have installed `smuggler2` from a local copy of this repository, +you may only need to add `-package smuggler2` to your `ghc-options`. + +```Cabal +common smuggler-options + if flag(smuggler2) + ghc-options: -fplugin:Smuggler2.Plugin --package smuggler22 +``` + +(You may need to install from a local copy using `cabal v1-install` for `smuggler2` +to be recognised.) + +### Options + +`Smuggler2` has several (case-insensitive) options, which can be set by adding a +`-fplugin-opt=Smuggler2.Plugin:` to your `ghc-options` + +- `NoImportProcessing` - do no import processing +- `PreserveInstanceImports` - remove unused imports, but preserve a library import stub. + such as `import Mod ()`, to import only instances of typeclasses from it. (The default.) +- `MinimiseImports` - remove unused imports, including any that may be needed + only to import typeclass instances. This may, therefore, stop the module from compiling. + +- `NoExportProcessing` - do no export processing +- `AddExplicitExports` - add an explicit list of all available exports (excluding + those that are imported) if there is no existing export list. (The default.) + You may want to edit it to keep specific values, types or classes local to the module. + At present, a typeclass and its class methods are exported individually. You may want to + replace those exports with an abbreviation such as `C(..)`. +- `ReplaceExports` - replace any existing module export list with one containing all + available exports (which, again, you can, of course, then prune to your requirements). + +Any other option value is used to generate a source file with a new extension of +the option value (`new` in the following example) rather than replacing the original file. + +```Cabal + ghc-options: -fplugin:Smuggler2.Plugin -fplugin-opt=Smuggler2.Plugin:new +``` + +This will create output files with a `.new` suffix rather the overwriting the originals. + +Smuggler2 tries not to perform file changes when +there are no unused imports or exports to be added or replaced. +So you can just run `ghcid` as usual: + +```bash +ghcid --command='cabal repl' +``` + +If you add `-v` to your `ghc-options` + +## Caveats + +`Smugggler2` is robust -- it can chew through the +[agda](https://github.com/agda/agda) codebase of over 370 modules with complex +interdependencies and be tripped over by only +- a handful of pattern synonym imports, +- a couple of ambiguous exports (are we trying to export something +defined in the current module or something with the same name from an imported +module) +- and a couple of imports where both qualifed and unqualifed version of the + module are imported and there are references to both qualified and unqualifed + version of the same names + +But there are some caveats, most of which are either easy enough to work around +(and still benefit from a great reduction in keyboard work): +- `Smuggler2` rewrites the existing imports, rather than attempting to prune + them. (This is a more aggressive approach than `smuggler` which focuses on + removing redundant imports.) It has advantages and disadvantages. The + advantage is that a minimal set of imports is generated in a reproducable format. + The disdvantage is that imports may be reordered, comments and blankdropped, external + imports mixed with external, etc. + +- By default `Smuggler2` does not remove imports completely because an import may be being + used to only import instances of typeclasses, So it will leave stubs like + + ```haskell + import Mod () + ``` + + that you may want to remove manually. Alternatively use the `MinimiseImports` option to + remove them anyway, at the risk of producing code that fails to compile. + +- CPP files will not be processed correctly: the imports will be generated for + current CPP settings and any CPP annotations in the import block will be + discarded. This may be a particular problem if you are writing code for + several generations of `ghc` and `base` for example. + [retrie](https://github.com/facebookincubator/retrie/blob/master/Retrie/CPP.hs) + solves this problem generating all possible versions of the module + (exponential in the number of `#if` directives), operating on each version + individually, and splicing results back into the original file. A tour de + force! + +- `smuggler2` depends on the current `ghc` compiler and `base` library to check + whether an import is redundant. Earlier versions of the compiler may, of + course, need it. The [base library + changelog](https://hackage.haskell.org/package/base/changelog) provides some + details of what was made available when. + +- Multiple separate import lines referring to the same library are not + consolidated + +- Literate Haskell `lhs` files are not supported + +- `hiding` clauses may not be properly analysed. So hiding things that are not + used may not be spotted. + +- Certain syntax pattern imports may not be imported correctly (the `pattern` + keyword is missing) + +- The test suite does not seem to run reliably on Windows. This is probably + more of an issue with the way that the tests are run, than `Smuggler2` itself. + +- Currently `cabal` does not have a particular way of specifying plugins. + (See, eg, https://gitlab.haskell.org/ghc/ghc/issues/11244 and + https://github.com/haskell/cabal/issues/2965) which would allow cleaner + separation of user code and plugin-code + +## For contributors + +Requirements: + +- `ghc-8.6.5`, `ghc-8.8.3` and `ghc-8.10.1`: `Smuggler2` will not compile with earlier versions. +- The test golden values are for `ghc-8.10.1` and `ghc-8.8.3`. Some of them fail on `ghc-8.6.5` + because it seems to need to import `Data.Bool` whereas later versions of GHC don't. The results + compile on `ghc-8.6.5` and later anyway, but the imports are not as minimal + for later versions as they could be. +- `cabal >= 3.0` (ideally `3.2`) + +### How to build + +```shell +$ cabal update +$ cabal build +``` + +To build with debugging: + +```shell +$ cabal bulid -fdebug +``` + +Curently this just adds an `-fdump-minimal-imports` parameter to GHC +compilation. + +### How to run tests + +There is a `tasty-golden`-based test suite that can be run by + +```shell +$ cabal test smuggler-test --enable-tests +``` + +Further help can be found by + +```shell +$ cabal run smuggler-test -- --help +``` + +(note the extra `--`) + +For example, if you are running on `ghc-8.6.5` you can + +```shell +$ cabal run smuggler2-test -- --accept +``` + +to update the golden outputs to the current results of (failing) tests. + +It is sometimes necessary to run `cabal clean` before running tests to ensure +that old build artefacts do not lead to misleading results. + +`smuggler-test` uses `cabal exec ghc` internally to run a test. The `cabal` command +that is to be used to do that can be set using the `CABAL` environment variable. +This may be helpful for certain workflows where `cabal` is not in the current +path, or you want to add extra flags to the `cabal` command. + +The test suite does not run reliably on Windows + +## Implementation approach + +`smuggler2` uses the `ghc-exactprint` +[library](https://hackage.haskell.org/package/ghc-exactprint) to modiify the +source code. The documentation for the library is fairly spartan, and the +library is not widely used, so the use here can, no doubt, be optimised. + +The library is needed because the annotated AST that GHC generates does not have enough +information to reconstitute the original source. +Some parts of the renamed syntax tree (for example, imports) are +not found in the typechecked one. `ghc-exactprint` provides parsers that +preserve this information, which is stored in a separate +`Anns` `Map` used to generate properly formatted source text. + +To make manipulation of GHC's AST and `ghc-exactprint`'s `Anns` easier, +`ghc-exactprint` provides a set of Transform functions. These are intended to facilitate +making changes to the AST and adjusting the `Anns` to suit the changes. + +> These functions are [said to be under heavy development](https://hackage.haskell.org/package/ghc-exactprint-0.6.3/docs/Language-Haskell-GHC-ExactPrint-Transform.html). +> It is not entirely obvious how they are intended to be used or composed. The +> approach provided by [`retrie`](https://hackage.haskell.org/package/retrie) +> wraps an AST and `Anns` into a single type that seems to make AST +> transformations easier to compose and reduces the risk of the `Anns` and AST getting +> out of sync as it is being transformed, something with which the type system doesn't +> help you since the `Anns` are stored as a `Map`. + +### Imports + +`smuggler2` uses GHC to generate a set of minimal imports. It + +- parses the original file +- dumps the minimal exports that GHC generates and parses them back in (to pick + up the annotations needed for printing) +- drops implicit imports (such as Prelude) and, optionally, imports that are + for instances only +- replaces the original imports with minimal ones +- `exactPrint`s the result back over the original file (or one with a different + suffix, if that was specified as option to `smuggler2`) + +This round tripping is needed because the AST provided by GHC to `smuggler2` +is of a different type from the AST that `ghc-exactprint` uses. (It is the +product of the renaming phase of the compiler, while `ghc-exactprint` uses +a parse phase AST.) + +### Exports + +Exports are simpler to deal with as GHC's `exports_from_avail` does the work. + +## Other projects + +- Smuggler2 was is a rewrite of [`smuggler`](https://hackage.haskell.org/package/smuggler) +- `retrie` a [code modding tool](https://hackage.haskell.org/package/retrie) + that works with GHC 8.10.1 +- `refact-global-hse` an ambitious [import refactoring tool](https://github.com/ddssff/refact-global-hse). + This uses `haskell-src-exts` rather than `ghc-exactprint` and so may not work with current versions of GHC. +- These blog posts contain some fragments on the topic of using `ghc-exactprint` to manipulate import lists + [Terser import declarations](https://www.machinesung.com/scribbles/terser-import-declarations.html) and + [GHC API](https://www.machinesung.com/scribbles/ghc-api.html) (The site + doesn't always seem to be up.) + +## Acknowledgements + +Thanks to + +- Dmitrii Kovanikov and Veronika Romashkina who wrote [`smuggler`](https://hackage.haskell.org/package/smuggler) +- Alan Zimmerman and Matthew Pickering for + [`ghc-exactprint`](https://hackage.haskell.org/package/ghc-exactprint) +- The ghc authors who have made the compiler internals available through an API. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/TODO.md b/TODO.md new file mode 100644 --- /dev/null +++ b/TODO.md @@ -0,0 +1,14 @@ +# Things to be done + +- [ ] does hiding work? + +- [ ] does CPP work? (should do) + +- [ ] Script to generate new test (from template?) + +- [ ] get tasty-golden to delete successful results and update tests where + smuggler makes no changes + +- [ ] refactor the much more sophisticated https://github.com/ddssff/refact-global-hse + +- [ ] Do a better job of preserving comments diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,13 @@ +module Main ( + main ) where + +import Data.Bool ( bool ) +import Data.List () +import Data.Maybe ( fromMaybe ) + +main :: IO () +main = do + let foo = fromMaybe bool Nothing + print (foo undefined undefined undefined :: Int) + print True +-- main = parseFile diff --git a/smuggler2.cabal b/smuggler2.cabal new file mode 100644 --- /dev/null +++ b/smuggler2.cabal @@ -0,0 +1,145 @@ +cabal-version: 3.0 +name: smuggler2 +version: 0.3.2.1 +synopsis: + GHC Source Plugin that helps to minimise imports and generate explicit exports + +description: + == Usage + Add @smuggler2@ to the build dependencies of your project. + . + Then add the following to ghc-options: @-fplugin=Smuggler2.Plugin@ + +homepage: https://github.com/jrp2014/smuggler2 +bug-reports: https://github.com/jrp2014/smuggler2 +license: MPL-2.0 +license-file: LICENSE +author: jrp2014, Dmitrii Kovanikov, Veronika Romashkina +maintainer: jrp2014 +copyright: 2020 jrp2014, Dmitrii Kovanikov +category: Development, Refactoring, Compiler Plugin +build-type: Simple +extra-doc-files: + README.md + CHANGELOG.md + TODO.md + +extra-source-files: + test/tests/*.hs + Makefile + Setup.hs + weeder.dhall + +-- wildcards are allowed only in the basename +--test/tests/*.*-golden + +tested-with: GHC ==8.6.5 || ==8.8.3 || ==8.10.1 + +flag debug + description: Enable debugging support + default: False + manual: True + +flag threaded + description: Build with support for multithreaded execution + default: True + manual: True + +source-repository head + type: git + location: https://github.com/jrp2014/smuggler + +common common-options + -- test these bounds + build-depends: base >=4.9 && <4.16 + + -- -O2 gives a nearly 10% speed improvement + ghc-options: + -O2 -Wall -Wextra -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wcompat -Widentities + -Wredundant-constraints -fhide-source-paths + + if impl(ghc >=8.10.0) + ghc-options: -Wunused-packages -fwrite-ide-info + + if flag(debug) + ghc-options: -ddump-minimal-imports + cpp-options: -DDEBUG + + default-language: Haskell2010 + + -- Most of these are unnecessary + default-extensions: + DeriveGeneric + GeneralizedNewtypeDeriving + InstanceSigs + LambdaCase + OverloadedStrings + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TypeApplications + +common executable-options + ghc-options: -rtsopts + + if flag(debug) + ghc-options: -debug + + if flag(threaded) + ghc-options: -threaded -with-rtsopts=-N + +library + import: common-options + hs-source-dirs: src + exposed-modules: + Smuggler2.Options + Smuggler2.Anns + Smuggler2.Parser + Smuggler2.Plugin + + other-modules: + Paths_smuggler2 + + autogen-modules: Paths_smuggler2 + + build-depends: + , containers ^>=0.6.0 + , directory ^>=1.3.3 + , filepath ^>=1.4.2 + , ghc >=8.6.5 && <8.11 + , ghc-exactprint ^>=0.6.3 + , syb ^>=0.7.1 + + if flag(debug) + build-depends: text + +-- Currently doesn't do anything much +executable play-smuggler2 + import: common-options + import: executable-options + hs-source-dirs: app + main-is: Main.hs + + if flag(debug) + ghc-options: -fplugin=Smuggler2.Plugin + + build-depends: smuggler2 + +test-suite smuggler2-test + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: + , filepath + , ghc-paths + , smuggler2 + , tasty + , tasty-golden + , typed-process + + main-is: Test.hs + ghc-options: -rtsopts + + if flag(threaded) + ghc-options: -threaded -with-rtsopts=-N diff --git a/src/Smuggler2/Anns.hs b/src/Smuggler2/Anns.hs new file mode 100644 --- /dev/null +++ b/src/Smuggler2/Anns.hs @@ -0,0 +1,171 @@ +{-| + Description: Utility functions for transforming and manipulating 'ghc' AST elements + and their associated 'ghc-exactprint' 'Language.Haskell.GHC.ExactPrint.Anns' + -} +module Smuggler2.Anns + ( mkExportAnnT, + mkLoc, + mkParenT, + setAnnsForT, + swapEntryDPT, + ) +where + +import Avail (AvailInfo (..)) +import Data.Generics as SYB (Data) +import qualified Data.Map.Strict as Map (alter, fromList, insert, lookup, toList, union) +import Data.Maybe (fromMaybe) +import GHC + ( AnnKeywordId (AnnCloseP, AnnDotdot, AnnOpenP, AnnVal), + GhcPs, + IE (..), + IEWrappedName (..), + LIEWrappedName, + Name, + RdrName, + ) +import GhcPlugins (GenLocated (L), Located, getOccFS, getOccString, mkVarUnqual) +import Language.Haskell.GHC.ExactPrint + ( Annotation (annEntryDelta, annPriorComments, annsDP), + TransformT, + modifyAnnsT, + uniqueSrcSpanT, + ) +import Language.Haskell.GHC.ExactPrint.Types + ( DeltaPos (..), + KeywordId (G), + annNone, + mkAnnKey, + noExt, + ) +import Lexeme (isLexSym) + +-- Generates the annotations for a name, wrapping () around symbollic names +mkLIEName :: Monad m => Name -> TransformT m (LIEWrappedName RdrName) +mkLIEName name = do + let nameFS = getOccFS name + let ann = + if isLexSym nameFS -- infix type or data constructor / identifier + then [(G AnnOpenP, DP (0, 0)), (G AnnVal, DP (0, 0)), (G AnnCloseP, DP (0, 0))] + else [(G AnnVal, DP (0, 0))] + lname <- + mkLocWithAnns + (mkVarUnqual nameFS) + (DP (1, 2)) -- drop downn a line and indent 2 spaces + ann + mkLoc (IEName lname) + +-- | Uses 'AvailInfo' about an exportable thing to generate the corresponding +-- piece of (annotated) AST +mkExportAnnT :: Monad m => AvailInfo -> TransformT m (Located (IE GhcPs)) +-- Ordinary identifier +mkExportAnnT (Avail name) = do + liename <- mkLIEName name + mkLoc (IEVar noExt liename) + +-- A type or class. Since we expect @name@ to be in scope, it should be the head +-- of @names@ +mkExportAnnT (AvailTC name names fieldlabels) = do + liename <- mkLIEName name + + -- Could export pieces explicitly, but this becomes ugly; + -- operators need to be wrapped in (), etc, so just export things + -- with pieces by wildcard + let lienameWithWildcard = + mkLocWithAnns + (IEThingAll noExt liename) + (DP (0, 0)) + [(G AnnOpenP, DP (0, 0)), (G AnnDotdot, DP (0, 0)), (G AnnCloseP, DP (0, 0))] + + case (names, fieldlabels) of + -- This case implies that the type or class is not to be in scope + -- which should not happen as we should only be processing exportable things + -- Alternativey, could just: mkLoc (IEThingAbs noExt liename) + ([], _) -> + error $ + "smuggler: trying to export type class that is not to be in scope " + ++ getOccString name + -- A type class with no pieces + ([_typeclass], []) -> mkLoc (IEThingAbs noExt liename) + -- A type class with no pieces, but with field selectors. A record type? + ([_typeclass], _fl) -> lienameWithWildcard + -- A type class with pieces + (typeorclass : _pieces, _fl) -> + if name == typeorclass -- check AvailTC invariant + then + lienameWithWildcard + else + error $ + "smuggler: broken AvailTC invariant: " + ++ getOccString name + ++ "/=" + ++ getOccString typeorclass + + +------------------------------------------------------------------------------- +-- Inspired by retrie + +-- | Generates a unique location and wraps the given ast chunk with that location +-- Also adds a DP and an annotation at that location +mkLocWithAnns :: (Data e, Monad m) => e -> DeltaPos -> [(KeywordId, DeltaPos)] -> TransformT m (Located e) +mkLocWithAnns e dp anns = do + le <- L <$> uniqueSrcSpanT <*> pure e + setAnnsForT le dp anns + +-- | `mkLoc` generates a unique location and wraps the given ast chunk with that location +-- Also adds an empty annotation at that location +mkLoc :: (Data e, Monad m) => e -> TransformT m (Located e) +mkLoc e = mkLocWithAnns e (DP (0, 0)) [] + +-- | Add an open and close paren annotation to a located thing +mkParenT :: + (Data x, Monad m) => + (Located x -> x) -> + Located x -> + TransformT m (Located x) +mkParenT k e = do + pe <- mkLoc (k e) + _ <- setAnnsForT pe (DP (0, 0)) [(G GHC.AnnOpenP, DP (0, 1)), (G GHC.AnnCloseP, DP (0, 1))] + swapEntryDPT e pe + return pe + +-- | Set the `ghc-exactprint` annotations for a 'Located' thing +setAnnsForT :: + (Data e, Monad m) => + Located e -> + DeltaPos -> + [(KeywordId, DeltaPos)] -> + TransformT m (Located e) +setAnnsForT e dp anns = modifyAnnsT (Map.alter f (mkAnnKey e)) >> return e + where + f Nothing = Just annNone {annEntryDelta = dp, annsDP = anns} + f (Just a) = + Just + a + { annEntryDelta = dp, + annsDP = + Map.toList $ + Map.union (Map.fromList anns) (Map.fromList (annsDP a)) + } + +-- | Swap two 'Located' things' relative position tage ('DeltaPos') +swapEntryDPT :: + (Data a, Data b, Monad m) => Located a -> Located b -> TransformT m () +swapEntryDPT a b = modifyAnnsT $ \anns -> + let akey = mkAnnKey a + bkey = mkAnnKey b + aann = fromMaybe annNone $ Map.lookup akey anns + bann = fromMaybe annNone $ Map.lookup bkey anns + in Map.insert + akey + aann + { annEntryDelta = annEntryDelta bann, + annPriorComments = annPriorComments bann + } + $ Map.insert + bkey + bann + { annEntryDelta = annEntryDelta aann, + annPriorComments = annPriorComments aann + } + anns diff --git a/src/Smuggler2/Options.hs b/src/Smuggler2/Options.hs new file mode 100644 --- /dev/null +++ b/src/Smuggler2/Options.hs @@ -0,0 +1,50 @@ +{- | + Description: handling of command line options + + -} +module Smuggler2.Options + ( Options (..), + parseCommandLineOptions, + ImportAction (..), + ExportAction (..), + ) +where + +import Data.Char (toLower) +import Data.List (foldl') +import Plugins (CommandLineOption) + +-- | Ways of performing import processing +data ImportAction = NoImportProcessing | PreserveInstanceImports | MinimiseImports + deriving (Eq, Show) + +-- | Ways of performing emport processing +data ExportAction = NoExportProcessing | AddExplicitExports | ReplaceExports + deriving (Eq, Show) + +-- | Internal representation of the plugin's command line options +data Options = Options + { importAction :: ImportAction, + exportAction :: ExportAction, + newExtension :: Maybe String + } + deriving (Show) + +-- | The default is to retain instance-only imports (eg, Data.List () ) +-- and add explict exports only if they are not already present +defaultOptions :: Options +defaultOptions = Options PreserveInstanceImports AddExplicitExports Nothing + +-- | Simple command line option parser. Last occurrence wins. +parseCommandLineOptions :: [CommandLineOption] -> Options +parseCommandLineOptions = foldl' parseCommandLineOption defaultOptions + where + parseCommandLineOption :: Options -> CommandLineOption -> Options + parseCommandLineOption opts clo = case toLower <$> clo of + "noimportprocessing" -> opts {importAction = NoImportProcessing} + "preserveinstanceimports" -> opts {importAction = PreserveInstanceImports} + "minimiseimports" -> opts {importAction = MinimiseImports} + "noexportprocessing" -> opts {exportAction = NoExportProcessing} + "addexplicitexports" -> opts {exportAction = AddExplicitExports} + "replaceexports" -> opts {exportAction = ReplaceExports} + _ -> opts {newExtension = Just clo} diff --git a/src/Smuggler2/Parser.hs b/src/Smuggler2/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Smuggler2/Parser.hs @@ -0,0 +1,48 @@ +{-| + Description: provides a wrapper around the 'ghc-exactprint' parser + -} +{-# LANGUAGE CPP #-} + +module Smuggler2.Parser + ( runParser, + ) +where + +import Control.Monad.IO.Class (MonadIO (liftIO)) +import DynFlags (DynFlags, GeneralFlag (Opt_KeepRawTokenStream), gopt_set) +import GHC (ParsedSource) +import Language.Haskell.GHC.ExactPrint (Anns) +import Language.Haskell.GHC.ExactPrint.Parsers (parseModuleFromStringInternal) +#if MIN_VERSION_GLASGOW_HASKELL(8,10,1,0) +import ErrUtils (fatalErrorMsg, printBagOfErrors) +import Outputable (text) +#else +import ErrUtils (fatalErrorMsg) +import Outputable (ppr, showSDoc, text) +#endif +import TcRnTypes (RnM) + +-- | Wrapper around the 'ghc-exactprint' parser. Prints diagnostics for failed parses +-- (which should never happen). We need to use +-- 'Language.Haskell.GHC.ExactPrint.parseModuleFromStringInternal' +-- because 'Language.Haskell.GHC.ExactPrintparseModuleFromString' +-- doesn't pick up the correct 'DynFlags' in -- some cases. +runParser :: + DynFlags -> FilePath -> String -> RnM (Either () (Anns, ParsedSource)) +runParser dflags fileName fileContents = do + -- Withoout the following, comments are stripped (see #10942) + -- It would be more efficient, but less visible to apply this tweak at the + -- outset, in the main plugin function, but keep it here for visibility + let dflags' = dflags `gopt_set` Opt_KeepRawTokenStream + + case parseModuleFromStringInternal dflags' fileName fileContents of + Left msg -> liftIO $ do +#if MIN_VERSION_GLASGOW_HASKELL(8,10,1,0) + fatalErrorMsg dflags (text "smuggler parse failure:") + printBagOfErrors dflags msg +#else + fatalErrorMsg dflags (text $ "smuggler parse failure: " ++ + showSDoc dflags (ppr $ fst msg) ++ ": " ++ snd msg) +#endif + return $ Left () + Right x -> return $ Right x diff --git a/src/Smuggler2/Plugin.hs b/src/Smuggler2/Plugin.hs new file mode 100644 --- /dev/null +++ b/src/Smuggler2/Plugin.hs @@ -0,0 +1,300 @@ +{-| + Description: the core of 'smuggler2' + -} +{-# LANGUAGE LambdaCase #-} + +module Smuggler2.Plugin + ( plugin, + ) +where + +import Avail (AvailInfo, Avails) +import Control.Monad (unless) +import Data.Maybe (fromMaybe, isNothing) +import Data.Version (showVersion) +import DynFlags (DynFlags (dumpDir), HasDynFlags (getDynFlags)) +import ErrUtils (compilationProgressMsg, fatalErrorMsg) +import GHC + ( GenLocated (L), + GhcPs, + HsModule (hsmodExports, hsmodImports), + ImportDecl (ideclHiding, ideclImplicit), + LIE, + LImportDecl, + Located, + ModSummary (ms_hspp_buf, ms_hspp_file, ms_mod), + Module (moduleName), + ParsedSource, + moduleNameString, + unLoc, + ) +import GHC.IO.Encoding (setLocaleEncoding, utf8) +import IOEnv (MonadIO (liftIO), readMutVar) +import Language.Haskell.GHC.ExactPrint + ( Anns, + TransformT, + addTrailingCommaT, + exactPrint, + graftT, + runTransform, + setEntryDPT, + ) +import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP)) +import Outputable (Outputable (ppr), neverQualify, printForUser, text, vcat) +import Paths_smuggler2 (version) +import Plugins + ( CommandLineOption, + Plugin (pluginRecompile, typeCheckResultAction), + defaultPlugin, + purePlugin, + ) +import RnNames (ImportDeclUsage, findImportUsage, getMinimalImports) +import Smuggler2.Anns (mkExportAnnT, mkLoc, mkParenT) +import Smuggler2.Options + ( ExportAction (AddExplicitExports, NoExportProcessing, ReplaceExports), + ImportAction (MinimiseImports, NoImportProcessing), + Options (exportAction, importAction, newExtension), + parseCommandLineOptions, + ) +import Smuggler2.Parser (runParser) +import StringBuffer (StringBuffer (StringBuffer), lexemeToString) +import System.Directory (removeFile) +import System.FilePath ((-<.>), ()) +import System.IO (IOMode (WriteMode), withFile) +import TcRnExports (exports_from_avail) +import TcRnTypes + ( RnM, + TcGblEnv (tcg_exports, tcg_imports, tcg_mod, tcg_rdr_env, tcg_rn_exports, tcg_rn_imports, tcg_used_gres), + TcM, + ) + +-- | 'Plugin' interface to GHC +plugin :: Plugin +plugin = + defaultPlugin + { typeCheckResultAction = smugglerPlugin, + pluginRecompile = purePlugin -- Don't force recompilation. [Is this the right approach?] + } + +-- | The plugin itself +smugglerPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv +smugglerPlugin clopts modSummary tcEnv + -- short circuit, if nothing to do + | (importAction options == NoImportProcessing) + && (exportAction options == NoExportProcessing) = + return tcEnv + | otherwise = do + -- Get the imports and their usage + let imports = tcg_rn_imports tcEnv + uses <- readMutVar $ tcg_used_gres tcEnv + let usage = findImportUsage imports uses + + -- This ensures that the source file is not touched if there are no unused + -- imports, or exports already exist and we are not replacing them + let noUnusedImports = all (\(_decl, _used, unused) -> null unused) usage + let hasExplicitExports = case tcg_rn_exports tcEnv of + Nothing -> False -- There is not even a module header + (Just []) -> False + (Just _) -> True + -- ... so short circuit if: + -- - we are skipping import processing or there are no unused imports, and + -- - we are skipping export processing or there are explict exports and we are not replacing them + -- (This is not a complete check; ideally, that the new imp/exports are + -- different from the existing ones, etc) + if (importAction options == NoImportProcessing || noUnusedImports) && + ( exportAction options == NoExportProcessing + || (hasExplicitExports && exportAction options /= ReplaceExports) + ) + then return tcEnv + else do + dflags <- getDynFlags + liftIO $ compilationProgressMsg dflags ("smuggler: " ++ showVersion version) + + -- Dump GHC's view of what the minimal imports are for the current + -- module, so that they can be annotated when parsed back in + -- This is needed because 'getMinimalImports` returns a list of import + -- declarations that are `GhcRn` but `ghc-exactPrint` operates in + -- `GhcPs` + let minImpFilePath = mkMinimalImportsPath dflags (ms_mod modSummary) + printMinimalImports' dflags minImpFilePath usage + + -- Run smuggling only for its side effects + tcEnv <$ smuggling dflags minImpFilePath + + where + + -- Does all the work + smuggling :: DynFlags -> FilePath -> RnM () + smuggling dflags minImpFilePath = do + + let modulePath = ms_hspp_file modSummary + + -- Read files as UTF-8 strings (GHC accepts only ASCII or UTF-8) + liftIO $ setLocaleEncoding utf8 + + -- Get the pre-processed module source code + let modFileContents = case ms_hspp_buf modSummary of + -- Not clear under what circumstances this could happen + Nothing -> error $ "smuggler: missing source file: " ++ modulePath + Just contents -> strBufToStr contents + + -- Parse the whole module + runParser dflags modulePath modFileContents >>= \case + Left () -> return () -- do nothing if file is invalid Haskell + Right (annsHsMod, astHsMod) -> do + -- Read the dumped file of minimal imports + minImpFileContents <- liftIO $ readFile minImpFilePath + + -- Parse the minimal imports file -- gets the annnotations too + runParser dflags minImpFilePath minImpFileContents >>= \case + Left () -> + liftIO $ + fatalErrorMsg dflags (text $ "smuggler: failed to parse minimal imports from " ++ minImpFilePath) + Right (annsImpMod, L _ impMod) -> do + + -- The actual minimal imports themselves, as generated by GHC + let minImports = hsmodImports impMod + + -- What is exported by the module + exports <- + if exportAction options == ReplaceExports + then exportable + else return $ tcg_exports tcEnv -- what is currently exported + + -- Bringing it all together: generate a new ast and annotations for it + let (astHsMod', (annsHsMod', _locIndex), _log) = + runTransform annsHsMod $ + replaceImports annsImpMod minImports astHsMod + >>= addExplicitExports exports + + -- Print the result + let newContent = exactPrint astHsMod' annsHsMod' + liftIO $ case newExtension options of + Nothing -> writeFile modulePath newContent + Just ext -> writeFile (modulePath -<.> ext) newContent + + -- Clean up: delete the GHC-generated imports file + liftIO $ removeFile minImpFilePath + + where + + -- Generates the things that would be exportabe if there were no + -- explict export header, so suitable for replacing one + exportable :: RnM [AvailInfo] + exportable = do + let rdr_env = tcg_rdr_env tcEnv + let imports = tcg_imports tcEnv -- actually not needed for the Nothing case + let this_mod = tcg_mod tcEnv + exports <- exports_from_avail Nothing rdr_env imports this_mod + return (snd exports) + + -- | Replace a target module's imports + -- See + replaceImports :: + Monad m => + -- | annotations for the replacement imports + Anns -> + -- | the replacement imports + [LImportDecl GhcPs] -> + -- | target module + ParsedSource -> + TransformT m ParsedSource + replaceImports anns minImports t@(L l m) = + case importAction options of + NoImportProcessing -> return t + _ -> do + -- This does all the work + -- retrie has a neat `insertImports' function that also + -- deduplicates + imps <- graftT anns minImports + -- nudge down the imports list onto a new line + unless (null imps) $ setEntryDPT (head imps) (DP (2, 0)) + return $ L l m {hsmodImports = imps} + + -- | Add explict exports to the target module + addExplicitExports :: + Monad m => + -- | The list of exports to be added + Avails -> + -- | target module + ParsedSource -> + TransformT m ParsedSource + addExplicitExports exports t@(L astLoc hsMod) = + case exportAction options of + NoExportProcessing -> return t + AddExplicitExports -> + -- only add explicit exports if there are none + -- seems to work even if there is no explict module declaration + -- presumably because the annotations that we generate are just + -- unused by exactPrint + if isNothing currentExplicitExports then result else return t + ReplaceExports -> result + where + currentExplicitExports :: Maybe (Located [LIE GhcPs]) + currentExplicitExports = hsmodExports hsMod + + -- This does all the export replacement work + result :: Monad m => TransformT m ParsedSource + result + | null exports = return t -- there is nothing exportable + | otherwise = do + -- Generate the exports list + exportsList <- mapM mkExportAnnT exports + -- add commas in between and parens around + mapM_ addTrailingCommaT (init exportsList) + lExportsList <- mkLoc exportsList >>= mkParenT unLoc + + -- No need to do any graftTing here as we have been modifying the + -- annotations in the current transformation + return $ L astLoc hsMod {hsmodExports = Just lExportsList} + + -- | This version of the GHC function ignores implicit imports, as they + -- cannot be parsed back in. (There is an extraneous (implicit)) + -- It also provides for leaving out instance-only imports (eg, Data.List() ) + printMinimalImports' :: DynFlags -> FilePath -> [ImportDeclUsage] -> RnM () + printMinimalImports' dflags filename imports_w_usage = + do + imports' <- getMinimalImports imports_w_usage + liftIO $ + withFile + filename + WriteMode + ( \h -> + -- The neverQualify is important. We are printing Names + -- but they are in the context of an 'import' decl, and + -- we never qualify things inside there + -- E.g. import Blag( f, b ) + -- not import Blag( Blag.f, Blag.g )! + printForUser dflags h neverQualify (vcat (map ppr (filter (letThrough . unLoc) imports'))) + ) + where + notImplicit :: ImportDecl pass -> Bool + notImplicit = not . ideclImplicit + + notInstancesOnly :: ImportDecl pass -> Bool + notInstancesOnly i = case ideclHiding i of + Just (False, L _ []) -> False + _ -> True + + keepInstanceOnlyImports :: Bool + keepInstanceOnlyImports = importAction options /= MinimiseImports + + letThrough :: ImportDecl pass -> Bool + letThrough i = notImplicit i && (keepInstanceOnlyImports || notInstancesOnly i) + + -- Construct the path into which GHC's version of minimal imports is dumped + mkMinimalImportsPath :: DynFlags -> Module -> FilePath + mkMinimalImportsPath dflags this_mod + | Just d <- dumpDir dflags = d basefn + | otherwise = basefn + where + basefn = + "smuggler-" ++ moduleNameString (moduleName this_mod) ++ "." + ++ fromMaybe "smuggler" (newExtension options) + ++ ".imports" + + options :: Options + options = parseCommandLineOptions clopts + + strBufToStr :: StringBuffer -> String + strBufToStr sb@(StringBuffer _ len _) = lexemeToString sb len diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Data.Maybe (fromMaybe) +import GHC.Paths (ghc) +import Smuggler2.Options (ExportAction (..), ImportAction (..), Options (..)) +import System.Environment (lookupEnv) +import System.FilePath ((-<.>), (), takeBaseName) +import System.Process.Typed + ( ProcessConfig, + proc, + runProcess_, + setEnvInherit, + setWorkingDirInherit, + ) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.Golden (findByExtension, goldenVsFileDiff, writeBinaryFile) + +-- | Where the tests are, relative to the project level cabal file +testDir :: FilePath +testDir = "test" "tests" + +-- | Combinations of import and export action options to be tested +optionsList :: [Options] +optionsList = + [ mkOptions PreserveInstanceImports NoExportProcessing, + mkOptions MinimiseImports ReplaceExports, + mkOptions MinimiseImports NoExportProcessing, + mkOptions NoImportProcessing AddExplicitExports, + mkOptions NoImportProcessing NoExportProcessing, + mkOptions NoImportProcessing ReplaceExports + ] + where + mkOptions :: ImportAction -> ExportAction -> Options + mkOptions ia ea = Options ia ea (Just $ mkExt ia ea) + +-- | Make an extention for an output file +mkExt :: ImportAction -> ExportAction -> String +mkExt ia ea = show ia ++ show ea -- ++ "-" ++ takeFileName ghc + +-- | Generate test for a list of 'Options' each of which specify what action to +-- take on imports and exports +testOptions :: [Options] -> IO TestTree +testOptions opts = + testGroup "All" <$> sequenceA (goldenTests <$> opts) + +-- | Generate tests for a set of 'Options' (that specifies what to do to +-- imports and exports) +goldenTests :: Options -> IO TestTree +goldenTests opts = do + testFiles <- findByExtension [".hs"] testDir + return $ + testGroup + testName + [ goldenVsFileDiff + (takeBaseName testFile) -- test name + (\ref new -> ["git", "diff", "--no-index", ref, new]) -- how to display diffs + (testFile -<.> testName ++ "-golden") -- golden file + outputFilename + ( do + -- Write a default output file for those tests where smuggler + -- (deliberately) does not generate a new one + writeBinaryFile outputFilename "Source file was not touched\r\n" + compile testFile opts + ) + | testFile <- testFiles, + let outputFilename = testFile -<.> testName + ] + where + testName = fromMaybe "NoNewExtension" (newExtension opts) + +-- | Just run all the tests +main :: IO () +main = defaultMain =<< testOptions optionsList + +-- | Use `cabal exec` to run the compilation, so that the smuggler plugin is +-- picked up from the local database. GHC alone would use the global one. +compile :: FilePath -> Options -> IO () +compile testcase opts = do + cabalPath <- lookupEnv "CABAL" -- find, eg, @/opt/ghc/bin/cabal@ or @cabal -vnormal+nowrap@ + let cabalCmd = words $ fromMaybe "cabal" cabalPath -- default to @cabal@ if @CABAL@ is not set + let cabalConfig = + setWorkingDirInherit . setEnvInherit $ + proc (head cabalCmd) (tail cabalCmd ++ cabalArgs) :: ProcessConfig () () () + runProcess_ cabalConfig + where + cabalArgs :: [String] + cabalArgs = + -- - not sure why it is necessary to mention the smuggler2 package explicitly, + -- but it appears to be hidden otherwise. + -- - This puts the .imports files that smuggler generates somewhere they + -- can easily be found + [ "--with-compiler=" ++ ghc, + "exec", + ghc, + "--", + "-package smuggler2", + "-v0", + "-dumpdir=" ++ testDir, + "-fno-code", + "-fplugin=Smuggler2.Plugin" + ] + ++ map + ("-fplugin-opt=Smuggler2.Plugin:" ++) + ( let ia = importAction opts + ea = exportAction opts + p = [show ia, show ea] + in case newExtension opts of + Nothing -> mkExt ia ea : p -- provide a default extension + Just e -> e : p + ) + ++ [testcase] diff --git a/test/tests/Bare.hs b/test/tests/Bare.hs new file mode 100644 --- /dev/null +++ b/test/tests/Bare.hs @@ -0,0 +1,4 @@ + +import Data.List + +main = undefined diff --git a/test/tests/BareHello.hs b/test/tests/BareHello.hs new file mode 100644 --- /dev/null +++ b/test/tests/BareHello.hs @@ -0,0 +1,3 @@ +module BareHello where + +main = putStrLn "Hello, World" diff --git a/test/tests/BoolBoolUnused.hs b/test/tests/BoolBoolUnused.hs new file mode 100644 --- /dev/null +++ b/test/tests/BoolBoolUnused.hs @@ -0,0 +1,3 @@ +module Test.BoolBoolUnused where + +import Data.Bool (bool) diff --git a/test/tests/BoolBoolUsed.hs b/test/tests/BoolBoolUsed.hs new file mode 100644 --- /dev/null +++ b/test/tests/BoolBoolUsed.hs @@ -0,0 +1,5 @@ +module Test.BoolBoolUsed where + +import Data.Bool (bool) + +func = bool diff --git a/test/tests/BoolPartlyUsedFirst.hs b/test/tests/BoolPartlyUsedFirst.hs new file mode 100644 --- /dev/null +++ b/test/tests/BoolPartlyUsedFirst.hs @@ -0,0 +1,5 @@ +module Test.BoolPartlyUsedFirst where + +import Data.Bool (bool, not) + +foo = bool diff --git a/test/tests/BoolPartlyUsedLast.hs b/test/tests/BoolPartlyUsedLast.hs new file mode 100644 --- /dev/null +++ b/test/tests/BoolPartlyUsedLast.hs @@ -0,0 +1,5 @@ +module Test.BoolPartlyUsedLast where + +import Data.Bool (bool, not) + +foo = not diff --git a/test/tests/Class.hs b/test/tests/Class.hs new file mode 100644 --- /dev/null +++ b/test/tests/Class.hs @@ -0,0 +1,42 @@ +module Class where + + +data Record a = Record { aa :: a, b :: String } + +data Impossible + + = Impossible String Integer + -- ^ We reached a program point which should be unreachable. + + | Unreachable String Integer + -- ^ @Impossible@ with a different error message. + -- Used when we reach a program point which can in principle + -- be reached, but not for a certain run. + + | ImpMissingDefinitions [String] String + -- ^ We reached a program point without all the required + -- primitives or BUILTIN to proceed forward. + -- @ImpMissingDefinitions neededDefs forThis@ + + +class CatchImpossible m where + + -- | Catch any 'Impossible' exception. + catchImpossible :: m a -> (Impossible -> m a) -> m a + catchImpossible = catchImpossibleJust Just + + -- | Catch only 'Impossible' exceptions selected by the filter. + catchImpossibleJust :: (Impossible -> Maybe b) -> m a -> (b -> m a) -> m a + catchImpossibleJust = flip . handleImpossibleJust + + -- | Version of 'catchImpossible' with argument order suiting short handlers. + handleImpossible :: (Impossible -> m a) -> m a -> m a + handleImpossible = flip catchImpossible + + -- | Version of 'catchImpossibleJust' with argument order suiting short handlers. + handleImpossibleJust :: (Impossible -> Maybe b) -> (b -> m a) -> m a -> m a + handleImpossibleJust = flip . catchImpossibleJust + + {-# MINIMAL catchImpossibleJust | handleImpossibleJust #-} + + diff --git a/test/tests/ConstructorsUnused.hs b/test/tests/ConstructorsUnused.hs new file mode 100644 --- /dev/null +++ b/test/tests/ConstructorsUnused.hs @@ -0,0 +1,5 @@ +module Test.ConstructorsUnused where + +import Data.Bool (Bool (True, False), not) + +foo = not diff --git a/test/tests/Dummy.hs b/test/tests/Dummy.hs new file mode 100644 --- /dev/null +++ b/test/tests/Dummy.hs @@ -0,0 +1,4 @@ +module Test.Dummy where + +main :: IO () +main = pure () diff --git a/test/tests/Duplicated.hs b/test/tests/Duplicated.hs new file mode 100644 --- /dev/null +++ b/test/tests/Duplicated.hs @@ -0,0 +1,8 @@ +module Duplicated where + +import Data.Char (isDigit, isSpace) +import Data.Char (isPrint, isSpace) +import Data.Char (isLetter, isSpace) + + +test x = isDigit x || isLetter x diff --git a/test/tests/ExportExplicit.hs b/test/tests/ExportExplicit.hs new file mode 100644 --- /dev/null +++ b/test/tests/ExportExplicit.hs @@ -0,0 +1,10 @@ +module Test.ExportExplicit (isExported, anotherExport) where + +isExported = (+1) + +anotherExport = True + +andAnother = 27 + +main :: IO () +main = pure () diff --git a/test/tests/ExportImplicit.hs b/test/tests/ExportImplicit.hs new file mode 100644 --- /dev/null +++ b/test/tests/ExportImplicit.hs @@ -0,0 +1,10 @@ +module Test.ExportImplicit where + +import Data.Char + +isExported = (+1) + +alsoExported = map toLower "AbC" + +main :: IO () +main = print $ isExported 1 diff --git a/test/tests/ImplicitImportUnused.hs b/test/tests/ImplicitImportUnused.hs new file mode 100644 --- /dev/null +++ b/test/tests/ImplicitImportUnused.hs @@ -0,0 +1,9 @@ +module Test.ImplicitImportUnused where + +import Data.List +import Data.Bool (not, (&&)) +import Data.Maybe (fromMaybe, isJust, isNothing) + +foo = isJust + +bar = 27 diff --git a/test/tests/ImplicitImportUsed.hs b/test/tests/ImplicitImportUsed.hs new file mode 100644 --- /dev/null +++ b/test/tests/ImplicitImportUsed.hs @@ -0,0 +1,5 @@ +module Test.ImplicitImportUsed where + +import Data.List + +foo = intercalate "," diff --git a/test/tests/ImportEmpty.hs b/test/tests/ImportEmpty.hs new file mode 100644 --- /dev/null +++ b/test/tests/ImportEmpty.hs @@ -0,0 +1,3 @@ +module Test.ImportEmpty where + +import Data.Bool () diff --git a/test/tests/MoreExports.hs b/test/tests/MoreExports.hs new file mode 100644 --- /dev/null +++ b/test/tests/MoreExports.hs @@ -0,0 +1,20 @@ +module MoreExports where + +--Another comment +-- + +newtype N a = Int a + +data D a = A a | B | C a + +data R = R { a :: Int, b :: Bool } + +data H = I | J | K deriving Show + + +foo = (+1) + +-- A further Comment + +main :: IO () +main = print J diff --git a/test/tests/MultilineUnused.hs b/test/tests/MultilineUnused.hs new file mode 100644 --- /dev/null +++ b/test/tests/MultilineUnused.hs @@ -0,0 +1,10 @@ +module Test.MultilineUnused where + +import Data.Bool (bool) +import Data.List (break, cycle, drop, dropWhile, filter, genericDrop, genericLength, + genericReplicate, genericSplitAt, genericTake, group, inits, intercalate, + intersperse, isPrefixOf, iterate, map, permutations, repeat, replicate, reverse, + scanl, scanr, sort, sortBy, sortOn, splitAt, subsequences, tails, take, takeWhile, + transpose, unfoldr, unzip, unzip3, zip, zip3, zipWith, (++)) + +foo = bool diff --git a/test/tests/Operator.hs b/test/tests/Operator.hs new file mode 100644 --- /dev/null +++ b/test/tests/Operator.hs @@ -0,0 +1,8 @@ +module Operator where + +infixl 5 $+$ + +($+$) :: [a] -> [a] -> [a] +[] $+$ d = d +d $+$ [] = d +d $+$ d' = d ++ d' diff --git a/test/tests/QualUnqual.hs b/test/tests/QualUnqual.hs new file mode 100644 --- /dev/null +++ b/test/tests/QualUnqual.hs @@ -0,0 +1,6 @@ +module QualUnqual where + +import qualified Data.Char as C (isDigit, isLetter) +import Data.Char (isDigit, isLetter) + +test x = C.isDigit x || isDigit x diff --git a/test/tests/TypeConstructorUnused.hs b/test/tests/TypeConstructorUnused.hs new file mode 100644 --- /dev/null +++ b/test/tests/TypeConstructorUnused.hs @@ -0,0 +1,5 @@ +module Test.TypeConstructorUnused where + +import Data.Bool (Bool (False, True)) + +true = True diff --git a/test/tests/TypeConstructorUnusedComma.hs b/test/tests/TypeConstructorUnusedComma.hs new file mode 100644 --- /dev/null +++ b/test/tests/TypeConstructorUnusedComma.hs @@ -0,0 +1,5 @@ +module Test.TypeConstructorUnusedComma where + +import Data.Bool (Bool (False, True)) + +false = False diff --git a/test/tests/TypeConstructorUsed.hs b/test/tests/TypeConstructorUsed.hs new file mode 100644 --- /dev/null +++ b/test/tests/TypeConstructorUsed.hs @@ -0,0 +1,5 @@ +module Test.TypeConstructorUsed where + +import Data.Bool (Bool (True)) + +true = True diff --git a/test/tests/TypeUnused.hs b/test/tests/TypeUnused.hs new file mode 100644 --- /dev/null +++ b/test/tests/TypeUnused.hs @@ -0,0 +1,5 @@ +module Test.TypeUnused where + +import Data.Bool (Bool, not) + +foo = not diff --git a/test/tests/TypeUsed.hs b/test/tests/TypeUsed.hs new file mode 100644 --- /dev/null +++ b/test/tests/TypeUsed.hs @@ -0,0 +1,6 @@ +module Test.TypeUsed where + +import Data.Bool (Bool, not) + +foo :: Bool +foo = undefined diff --git a/test/tests/WildcardUnused.hs b/test/tests/WildcardUnused.hs new file mode 100644 --- /dev/null +++ b/test/tests/WildcardUnused.hs @@ -0,0 +1,5 @@ +module Test.WildcardUnused where + +import Data.Bool (Bool (..), not) + +foo = not diff --git a/test/tests/WildcardUsed.hs b/test/tests/WildcardUsed.hs new file mode 100644 --- /dev/null +++ b/test/tests/WildcardUsed.hs @@ -0,0 +1,5 @@ +module Test.WildcardUsed where + +import Data.Bool (Bool (..)) + +foo = False diff --git a/weeder.dhall b/weeder.dhall new file mode 100644 --- /dev/null +++ b/weeder.dhall @@ -0,0 +1,1 @@ +{ roots = [ "^Smuggler2.Plugin.plugin$", "^Main.main$", "^Paths_smuggler2" ], type-class-roots = True }